[ #266 ] Ocaml had problem with nested defined constructors

The transation to Ocaml syntax was missing some parentheses.

source/CHANGELOG.md

@@ -5,6 +5,7 @@ Andreas Abel <[email protected]> (unreleased)
 * Haskell: fixes in layout preprocessor [#343,#344,#345]
 * C: fixed a space leak when parsing from a string in memory [#347]
 * C: new methods `free*` to deallocate syntax trees [#348]
+* Ocaml: fixed translation of nested `define`d constructors
 
 # 2.9.1
 

source/src/BNFC/Backend/OCaml/CFtoOCamlAbs.hs

@@ -11,7 +11,7 @@ module BNFC.Backend.OCaml.CFtoOCamlAbs (cf2Abstract) where
 import Text.PrettyPrint
 
 import BNFC.CF
-import BNFC.Utils ( (+++), unless )
+import BNFC.Utils ( (+++), unless, parensIf )
 import Data.List ( intersperse )
 import BNFC.Backend.OCaml.OCamlUtil
 
@@ -38,12 +38,14 @@ cf2Abstract _ cf = unlines $ concat
 definedRules :: CF -> [String]
 definedRules cf = [ mkDef f xs e | FunDef f xs e <- cfgPragmas cf ]
  where
- mkDef f xs e = "let " ++ funName f ++ " " ++ mkTuple xs ++ " = " ++ ocamlExp e
+ mkDef f xs e = "let " ++ funName f ++ " " ++ mkTuple xs ++ " = " ++ ocamlExp False e
 
- ocamlExp :: Exp -> String
- ocamlExp = \case
+ ocamlExp :: Bool -> Exp -> String
+ ocamlExp p = \case
  Var s -> s
- App s es -> s ++ ' ' : mkTuple (map ocamlExp es)
+ App s [] -> s
+ App s [e] -> parensIf p $ s ++ ' ' : ocamlExp True e
+ App s es -> parensIf p $ s ++ ' ' : mkTuple (map (ocamlExp False) es)
  LitInt i -> show i
  LitDouble d -> show d
  LitChar c -> "\'" ++ c : "\'"

source/src/BNFC/Utils.hs

@@ -18,7 +18,7 @@ module BNFC.Utils
  , singleton, mapHead, spanEnd
  , duplicatesOn
  , hasNumericSuffix
- , (+++), (++++), (+-+), (+.+)
+ , (+++), (++++), (+-+), (+.+), parensIf
  , pad, table
  , mkName, mkNames, NameStyle(..)
  , lowerCase, upperCase, mixedCase
@@ -47,7 +47,7 @@ import qualified Data.List.NonEmpty as List1
 import System.IO (IOMode(ReadMode),hClose,hGetContents,openFile)
 import System.IO.Error (tryIOError)
 
-import BNFC.PrettyPrint hiding ((<>))
+import BNFC.PrettyPrint (Doc, text)
 
 type List1 = List1.NonEmpty
 
@@ -140,6 +140,12 @@ a +-+ b = a ++ "_" ++ b
 (+.+) :: String -> String -> String
 a +.+ b = a ++ "." ++ b
 
+-- | Wrap in parentheses if condition holds.
+parensIf :: Bool -> String -> String
+parensIf = \case
+ True -> ("(" ++) . (++ ")")
+ False -> id
+
 -- | Pad a string on the right by spaces to reach the desired length.
 pad :: Int -> String -> String
 pad n s = s ++ drop (length s) (replicate n ' ')

testing/regression-tests/266_define/good01.in

@@ -6,4 +6,4 @@ chars 'A' . 'a'
 chars 'B'
 chars 'C'
 
-expression 1.41421356237311 ** sqrt 2.71828182845905 ** 3.14159265358979
+expression 1.41421356237311 ** sqrt 2.71828182845905 ** sqrt4 3.14159265358979

testing/regression-tests/266_define/good01.out

@@ -3,8 +3,8 @@ Parse Successful!
 
 [Abstract Syntax]
 
-[SInts (ISnoc (ISnoc (ISnoc INil 1) 2) 3),SInts (ISnoc INil 4),SInts (ISnoc INil 5),SChars (CSnoc (CSnoc CNil (Dot ".") 'A') (Dot ".") 'a'),SChars (CSnoc CNil (Dot ".") 'B'),SChars (CSnoc CNil (Dot ".") 'C'),SExp (EPower (EDouble 1.41421356237311) (EPower (EPower (EDouble 2.71828182845905) EHalf) (EDouble 3.14159265358979)))]
+[SInts (ISnoc (ISnoc (ISnoc INil 1) 2) 3),SInts (ISnoc INil 4),SInts (ISnoc INil 5),SChars (CSnoc (CSnoc CNil (Dot ".") 'A') (Dot ".") 'a'),SChars (CSnoc CNil (Dot ".") 'B'),SChars (CSnoc CNil (Dot ".") 'C'),SExp (EPower (EDouble 1.41421356237311) (EPower (EPower (EDouble 2.71828182845905) EHalf) (EPower (EPower (EDouble 3.14159265358979) EHalf) EHalf)))]
 
 [Linearized tree]
 
-integers, 1, 2, 3 integers, 4 integers, 5 chars . 'A' . 'a' chars . 'B' chars . 'C' expression 1.41421356237311 ** (2.71828182845905 ** 1/2) ** 3.14159265358979
+integers, 1, 2, 3 integers, 4 integers, 5 chars . 'A' . 'a' chars . 'B' chars . 'C' expression 1.41421356237311 ** (2.71828182845905 ** 1/2) ** (3.14159265358979 ** 1/2) ** 1/2

testing/regression-tests/266_define/test.cf

@@ -1,32 +1,34 @@
 -- #266 "define" pragma
 
-terminator Stm "";
+terminator Stm "" ;
 
-SInts. Stm ::= "integers" Ints;
-SChars. Stm ::= "chars" Chars;
-SExp. Stm ::= "expression" Exp ;
+SInts. Stm ::= "integers" Ints ;
+SChars. Stm ::= "chars" Chars ;
+SExp. Stm ::= "expression" Exp  ;
 
-EHalf. Exp2 ::= "1/2" ;
-EDouble. Exp2 ::= Double ;
-eSqrt. Exp1 ::= "sqrt" Exp1 ;
-EPower. Exp ::= Exp1 "**" Exp ;
+EHalf. Exp2 ::= "1/2" ;
+EDouble. Exp2 ::= Double ;
+eSqrt. Exp1 ::= "sqrt" Exp1 ;
+eSqrt4. Exp1 ::= "sqrt4" Exp1 ;
+EPower. Exp ::= Exp1 "**" Exp ;
 
-coercions Exp 2 ;
+coercions Exp 2  ;
 
-define eSqrt e = EPower e EHalf ;
+define eSqrt e = EPower e EHalf ;
+define eSqrt4 e = eSqrt (eSqrt e) ;
 
 -- #285 "define" pragma involving token categories
 
-INil. Ints ::= ;
-iSg. Ints ::= Integer ;
-ISnoc. Ints ::= Ints "," Integer ;
+INil. Ints ::=  ;
+iSg. Ints ::= Integer  ;
+ISnoc. Ints ::= Ints "," Integer  ;
 
-define iSg i = ISnoc INil i ;
+define iSg i = ISnoc INil i  ;
 
-CNil. Chars ::= ;
-cSg. Chars ::= Char ;
-CSnoc. Chars ::= Chars Dot Char ;
+CNil. Chars ::=  ;
+cSg. Chars ::= Char  ;
+CSnoc. Chars ::= Chars Dot Char  ;
 
-define cSg c = CSnoc CNil (Dot ".") c;
+define cSg c = CSnoc CNil (Dot ".") c ;
 
-token Dot '.' ;
+token Dot '.'  ;