Fixed parsing of lambdas (cannot be recursive) in PascaLIGO.

Added more to the pretty-printing of PascaLIGO.
Improved pretty-printing of CameLIGO.

src/passes/01-parser/cameligo/AST.ml

@@ -228,7 +228,7 @@ and field_pattern = {
 and expr =
   ECase   of expr case reg
 | ECond   of cond_expr reg
-| EAnnot  of (expr * colon * type_expr) par reg
+| EAnnot  of annot_expr par reg
 | ELogic  of logic_expr
 | EArith  of arith_expr
 | EString of string_expr
@@ -247,6 +247,8 @@ and expr =
 | EFun    of fun_expr reg
 | ESeq    of expr injection reg
 
+and annot_expr = expr * colon * type_expr
+
 and 'a injection = {
   compound   : compound;
   elements   : ('a, semi) sepseq;

src/passes/01-parser/cameligo/Parser.mly

@@ -583,7 +583,10 @@ core_expr:
 | record_expr                         {                    ERecord $1 }
 | update_record                       {                    EUpdate $1 }
 | par(expr)                           {                       EPar $1 }
-| par(expr ":" type_expr {$1,$2,$3})  {                     EAnnot $1 }
+| par(annot_expr)                     {                     EAnnot $1 }
+
+annot_expr:
+  expr ":" type_expr { $1,$2,$3 }
 
 module_field:
   module_name "." module_fun {

src/passes/01-parser/cameligo/Pretty.ml

@@ -41,8 +41,9 @@ and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
 
 and pp_let_binding (binding : let_binding) =
   let {binders; lhs_type; let_rhs; _} = binding in
-  let patterns = Utils.nseq_to_list binders in
+  let head, tail = binders in
-  let patterns = group (separate_map (break 1) pp_pattern patterns) in
+  let patterns =
+    group (nest 2 (separate_map (break 1) pp_pattern (head::tail))) in
   let lhs =
     patterns ^^
     match lhs_type with
@@ -95,11 +96,11 @@ and pp_ppar p = pp_par pp_pattern p
 
 and pp_plist = function
   PListComp cmp -> pp_list_comp cmp
-| PCons cons -> pp_cons cons
+| PCons cons -> pp_pcons cons
 
 and pp_list_comp e = group (pp_injection pp_pattern e)
 
-and pp_cons {value; _} =
+and pp_pcons {value; _} =
   let patt1, _, patt2 = value in
   prefix 2 1 (pp_pattern patt1 ^^ string " ::") (pp_pattern patt2)
 
@@ -126,14 +127,15 @@ and pp_ptyped {value; _} =
 
 and pp_type_decl decl =
   let {name; type_expr; _} = decl.value in
+  let padding = match type_expr with TSum _ -> 0 | _ -> 2 in
   string "type " ^^ string name.value ^^ string " ="
-  ^^ group (nest 2 (break 1 ^^ pp_type_expr type_expr))
+  ^^ group (nest padding (break 1 ^^ pp_type_expr type_expr))
 
 and pp_expr = function
   ECase   e -> pp_case_expr e
 | ECond   e -> group (pp_cond_expr e)
 | EAnnot  e -> pp_annot_expr e
-| ELogic  e -> pp_logic_expr e
+| ELogic  e -> group (pp_logic_expr e)
 | EArith  e -> group (pp_arith_expr e)
 | EString e -> pp_string_expr e
 | EList   e -> group (pp_list_expr e)
@@ -166,15 +168,16 @@ and pp_cases {value; _} =
 
 and pp_clause {value; _} =
   let {pattern; rhs; _} = value in
-  prefix 4 1 (pp_pattern pattern ^^ string " ->") (pp_expr rhs)
+    pp_pattern pattern ^^ prefix 4 1 (string " ->") (pp_expr rhs)
 
 and pp_cond_expr {value; _} =
   let {test; ifso; kwd_else; ifnot; _} = value in
   let test = string "if " ^^ group (nest 3 (pp_expr test))
   and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso))
   and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
-  in if kwd_else#is_ghost then test ^/^ ifso
+  in if   kwd_else#is_ghost
-  else test ^/^ ifso ^/^ ifnot
+     then test ^/^ ifso
+     else test ^/^ ifso ^/^ ifnot
 
 and pp_annot_expr {value; _} =
   let expr, _, type_expr = value.inside in
@@ -420,7 +423,7 @@ and pp_field_decl {value; _} =
   in prefix 2 1 (name ^^ string " :") t_expr
 
 and pp_type_app {value = ctor, tuple; _} =
-  prefix 2 1 (pp_type_tuple tuple) (pp_type_constr ctor)
+  pp_type_tuple tuple ^^ group (nest 2 (break 1 ^^ pp_type_constr ctor))
 
 and pp_type_tuple {value; _} =
   let head, tail = value.inside in

src/passes/01-parser/pascaligo/AST.ml

@@ -206,7 +206,6 @@ and type_tuple = (type_expr, comma) nsepseq par reg
 (* Function and procedure declarations *)
 
 and fun_expr = {
-  kwd_recursive: kwd_recursive option;
   kwd_function : kwd_function;
   param        : parameters;
   colon        : colon;
@@ -448,7 +447,7 @@ and collection =
 and expr =
   ECase   of expr case reg
 | ECond   of cond_expr reg
-| EAnnot  of annot_expr reg
+| EAnnot  of annot_expr par reg
 | ELogic  of logic_expr
 | EArith  of arith_expr
 | EString of string_expr
@@ -467,7 +466,7 @@ and expr =
 | EPar    of expr par reg
 | EFun    of fun_expr reg
 
-and annot_expr = expr * type_expr
+and annot_expr = expr * colon * type_expr
 
 and set_expr =
   SetInj of expr injection reg

src/passes/01-parser/pascaligo/Parser.mly

@@ -239,16 +239,15 @@ field_decl:
 
 
 fun_expr:
-  ioption ("recursive") "function" parameters ":" type_expr "is" expr {
+  "function" parameters ":" type_expr "is" expr {
-    let stop   = expr_to_region $7 in
+    let stop   = expr_to_region $6 in
-    let region = cover $2 stop
+    let region = cover $1 stop
-    and value  = {kwd_recursive= $1;
+    and value  = {kwd_function = $1;
-                  kwd_function = $2;
+                  param        = $2;
-                  param        = $3;
+                  colon        = $3;
-                  colon        = $4;
+                  ret_type     = $4;
-                  ret_type     = $5;
+                  kwd_is       = $5;
-                  kwd_is       = $6;
+                  return       = $6}
-                  return       = $7}
     in {region; value} }
 
 (* Function declarations *)
@@ -849,7 +848,7 @@ core_expr:
 | "False"                       { ELogic (BoolExpr (False $1)) }
 | "True"                        { ELogic (BoolExpr (True  $1)) }
 | "Unit"                        { EUnit $1                     }
-| annot_expr                    { EAnnot $1                    }
+| par(annot_expr)               { EAnnot $1                    }
 | tuple_expr                    { ETuple $1                    }
 | list_expr                     { EList $1                     }
 | "None"                        { EConstr (NoneExpr $1)        }
@@ -891,12 +890,7 @@ fun_call_or_par_or_projection:
 | fun_call { ECall $1 }
 
 annot_expr:
-  "(" disj_expr ":" type_expr ")" {
+  disj_expr ":" type_expr { $1,$2,$3 }
-    let start  = expr_to_region $2
-    and stop   = type_expr_to_region $4 in
-    let region = cover start stop
-    and value  = $2, $4
-    in {region; value} }
 
 set_expr:
   injection("set",expr) { SetInj ($1 (fun region -> InjSet region)) }

src/passes/01-parser/pascaligo/ParserLog.ml

@@ -180,9 +180,9 @@ and print_type_app state {value; _} =
 
 and print_type_fun state {value; _} =
   let type_expr_a, arrow, type_expr_b = value in
-  print_type_expr  state type_expr_a;
+  print_type_expr state type_expr_a;
-  print_token      state arrow "->";
+  print_token     state arrow "->";
-  print_type_expr  state type_expr_b
+  print_type_expr state type_expr_b
 
 and print_par_type state {value; _} =
   let {lpar; inside; rpar} = value in
@@ -206,12 +206,12 @@ and print_fun_decl state {value; _} =
   let {kwd_function; fun_name; param; colon;
        ret_type; kwd_is; block_with;
        return; terminator; _} = value in
-  print_token       state kwd_function "function";
+  print_token      state kwd_function "function";
-  print_var         state fun_name;
+  print_var        state fun_name;
-  print_parameters  state param;
+  print_parameters state param;
-  print_token       state colon ":";
+  print_token      state colon ":";
-  print_type_expr   state ret_type;
+  print_type_expr  state ret_type;
-  print_token       state kwd_is "is";
+  print_token      state kwd_is "is";
   (match block_with with
     None -> ()
   | Some (block, kwd_with) ->
@@ -221,15 +221,14 @@ and print_fun_decl state {value; _} =
   print_terminator state terminator;
 
 and print_fun_expr state {value; _} =
-  let {kwd_recursive; kwd_function; param; colon;
+  let {kwd_function; param; colon;
        ret_type; kwd_is; return} : fun_expr = value in
-  print_token_opt   state kwd_recursive "recursive";
+  print_token      state kwd_function "function";
-  print_token       state kwd_function "function";
+  print_parameters state param;
-  print_parameters  state param;
+  print_token      state colon ":";
-  print_token       state colon ":";
+  print_type_expr  state ret_type;
-  print_type_expr   state ret_type;
+  print_token      state kwd_is "is";
-  print_token       state kwd_is "is";
+  print_expr       state return
-  print_expr        state return
 
 and print_parameters state {value; _} =
   let {lpar; inside; rpar} = value in
@@ -260,10 +259,10 @@ and print_block state block =
   match enclosing with
     Block (kwd_block, lbrace, rbrace) ->
       print_token      state kwd_block "block";
-      print_token      state lbrace    "{";
+      print_token      state lbrace "{";
       print_statements state statements;
       print_terminator state terminator;
-      print_token state rbrace  "}"
+      print_token      state rbrace "}"
   | BeginEnd (kwd_begin, kwd_end) ->
       print_token      state kwd_begin "begin";
       print_statements state statements;
@@ -464,7 +463,9 @@ and print_expr state = function
 | EPar    e -> print_par_expr state e
 | EFun    e -> print_fun_expr state e
 
-and print_annot_expr state (expr , type_expr) =
+and print_annot_expr state node =
+  let {inside; _} : annot_expr par = node in
+  let expr, _, type_expr = inside in
   print_expr state expr;
   print_type_expr state type_expr
 
@@ -1432,7 +1433,7 @@ and pp_expr state = function
     pp_cond_expr state value
 | EAnnot {value; region} ->
     pp_loc_node state "EAnnot" region;
-    pp_annotated state value
+    pp_annotated state value.inside
 | ELogic e_logic ->
     pp_node state "ELogic";
     pp_e_logic (state#pad 1 0) e_logic
@@ -1607,7 +1608,7 @@ and pp_string_expr state = function
     pp_node   state "Verbatim";
     pp_verbatim (state#pad 1 0) v
 
-and pp_annotated state (expr, t_expr) =
+and pp_annotated state (expr, _, t_expr) =
   pp_expr      (state#pad 2 0) expr;
   pp_type_expr (state#pad 2 1) t_expr
 

src/passes/01-parser/pascaligo/Pretty.ml

@@ -32,14 +32,14 @@ and pp_attr_decl decl = pp_ne_injection pp_string decl
 
 and pp_const_decl {value; _} =
   let {name; const_type; init; attributes; _} = value in
-  let start  = string ("const " ^ name.value ^ " :") in
+  let start = string ("const " ^ name.value) in
   let t_expr = pp_type_expr const_type in
   let attr   = match attributes with
                  None -> empty
-               | Some a -> hardline ^^ pp_attr_decl a
+               | Some a -> hardline ^^ pp_attr_decl a in
-  in prefix 2 1 start t_expr
+  group (start ^/^ nest 2 (string ": " ^^ t_expr))
-     ^/^ prefix 2 1 (string "=") (pp_expr init)
+  ^^ group (break 1 ^^ nest 2 (string "= " ^^ pp_expr init))
-     ^^ attr
+  ^^ attr
 
 (* Type declarations *)
 
@@ -117,32 +117,40 @@ and pp_type_tuple {value; _} =
 
 (* Function and procedure declarations *)
 
-and pp_fun_expr {value; _} = string "TODO:pp_fun_expr"
+and pp_fun_expr {value; _} =
+  let {param; ret_type; return; _} : fun_expr = value in
+  let start = string "function" in
+  let parameters = pp_par pp_parameters param in
+  let return_t = pp_type_expr ret_type in
+  let expr = pp_expr return in
+  group (start ^^ nest 2 (break 1 ^^ parameters))
+  ^^ group (break 1 ^^ nest 2 (string ": " ^^ return_t))
+  ^^ string " is" ^^ group (nest 4 (break 1 ^^ expr))
 
 and pp_fun_decl {value; _} =
   let {kwd_recursive; fun_name; param;
        ret_type; block_with; return; attributes; _} = value in
   let start =
     match kwd_recursive with
-      None   -> string "function"
+        None -> string "function"
     | Some _ -> string "recursive" ^/^ string "function" in
+  let start = start ^^ group (break 1 ^^ nest 2 (pp_ident fun_name)) in
   let parameters = pp_par pp_parameters param in
   let return_t = pp_type_expr ret_type in
-  let blk_opening, blk_in, blk_closing =
-    match block_with with
-      None -> empty, empty, empty
-    | Some (b,_) ->
-        hardline ^^ string "is block [", pp_block b, string "] with" in
   let expr = pp_expr return in
-  let attr = match attributes with
+  let body =
+    match block_with with
+            None -> group (nest 2 (break 1 ^^ expr))
+    | Some (b,_) -> hardline ^^ string "block ["
+                   ^^ nest 2 (hardline ^^ pp_block b)
+                   ^^ hardline
+                   ^^ group (string "] with" ^^ nest 4 (break 1 ^^ expr))
+  and attr = match attributes with
                None -> empty
-             | Some a -> hardline ^^ pp_attr_decl a
+             | Some a -> hardline ^^ pp_attr_decl a in
-  in group (start ^^ nest 2 (break 1 ^^ parameters))
+  prefix 2 1 start parameters
-     ^/^ string ": " ^^ nest 2 return_t
+  ^^ group (nest 2 (break 1 ^^ string ": " ^^ return_t ^^ string " is"))
-     ^^ blk_opening
+  ^^ body ^^ attr
-     ^^ nest 2 (break 0 ^^ blk_in)
-     ^/^ group (blk_closing ^^ nest 4 (break 1 ^^ expr))
-     ^^ attr
 
 and pp_parameters p = pp_nsepseq ";" pp_param_decl p
 
@@ -178,10 +186,10 @@ and pp_data_decl = function
 
 and pp_var_decl {value; _} =
   let {name; var_type; init; _} = value in
-  let start  = string ("var " ^ name.value ^ " :") in
+  let start = string ("var " ^ name.value) in
-  let t_expr = pp_type_expr var_type
+  let t_expr = pp_type_expr var_type in
-  in prefix 2 1 start
+  group (start ^/^ nest 2 (string ": " ^^ t_expr))
-                (t_expr ^/^ prefix 2 1 (string ":=") (pp_expr init))
+  ^^ group (break 1 ^^ nest 2 (string ":= " ^^ pp_expr init))
 
 and pp_instruction = function
   Cond        i -> group (pp_conditional i)
@@ -196,41 +204,52 @@ and pp_instruction = function
 | MapRemove   i -> pp_map_remove i
 | SetRemove   i -> pp_set_remove i
 
-and pp_set_remove {value; _} = string "TODO:pp_set_remove"
+and pp_set_remove {value; _} =
+  let {element; set; _} : set_remove = value in
+  string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr element))
+  ^/^ string "from set" ^^ group (nest 2 (break 1 ^^ pp_path set))
 
-and pp_map_remove {value; _} = string "TODO:pp_map_remove"
+and pp_map_remove {value; _} =
+  let {key; map; _} = value in
+  string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr key))
+  ^/^ string "from map" ^^ group (nest 2 (break 1 ^^ pp_path map))
 
 and pp_set_patch {value; _} = string "TODO:pp_set_patch"
 
 and pp_map_patch {value; _} = string "TODO:pp_map_patch"
 
-and pp_binding b = string "TODO:pp_binding"
+and pp_binding {value; _} =
+  let {source; image; _} = value in
+  pp_expr source ^^ string " ->"
+  ^^ group (nest 2 (break 1 ^^ pp_expr image))
 
 and pp_record_patch {value; _} = string "TODO:pp_record_patch"
 
-and pp_cond_expr {value; _} = string "TODO:pp_cond_expr"
+and pp_cond_expr {value; _} =
+  let {test; ifso; kwd_else; ifnot; _} : cond_expr = value in
+  let test = string "if " ^^ group (nest 3 (pp_expr test))
+  and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso))
+  and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot))
+  in test ^/^ ifso ^/^ ifnot
 
 and pp_conditional {value; _} =
   let {test; ifso; ifnot; _} : conditional = value in
   let test  = string "if "  ^^ group (nest 3 (pp_expr test))
   and ifso  = string "then" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifso))
-  and ifnot =
+  and ifnot = match ifnot with
-    if is_clause_block ifnot then
+                ClauseInstr i ->
-      string "else {"
+                  string "else"
-      ^^ group (nest 2 (hardline ^^ pp_if_clause ifnot))
+                  ^^ group (nest 2 (break 1 ^^ pp_instruction i))
-      ^^ hardline ^^ string "}"
+              | ClauseBlock b ->
-    else
+                  string "else {"
-      string "else" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot))
+                  ^^ group (nest 2 (hardline ^^ pp_clause_block b))
+                  ^^ hardline ^^ string "}"
   in test ^/^ ifso ^/^ ifnot
 
 and pp_if_clause = function
   ClauseInstr i -> pp_instruction i
 | ClauseBlock b -> pp_clause_block b
 
-and is_clause_block = function
-  ClauseInstr _ -> false
-| ClauseBlock _ -> true
-
 and pp_clause_block = function
   LongBlock b  -> pp_block b
 | ShortBlock {value; _} -> Utils.(pp_statements <@ fst) value.inside
@@ -251,7 +270,7 @@ and pp_cases :
   fun printer {value; _} ->
     let head, tail = value in
     let head       = pp_case_clause printer head in
-    let head       = if tail = [] then head else blank 2 ^^ head in
+    let head       = blank 2 ^^ head in
     let rest       = List.map snd tail in
     let app clause = break 1 ^^ string "| " ^^ pp_case_clause printer clause
     in  head ^^ concat_map app rest
@@ -260,8 +279,7 @@ and pp_case_clause :
   'a.('a -> document) -> 'a case_clause Region.reg -> document =
   fun printer {value; _} ->
     let {pattern; rhs; _} = value in
-    prefix 4 1 (pp_pattern pattern ^^ string " ->") (printer rhs)
+    pp_pattern pattern ^^ prefix 4 1 (string " ->") (printer rhs)
-
 
 and pp_assignment {value; _} =
   let {lhs; rhs; _} = value in
@@ -298,7 +316,7 @@ and pp_expr = function
   ECase   e -> pp_case pp_expr e
 | ECond   e -> group (pp_cond_expr e)
 | EAnnot  e -> pp_annot_expr e
-| ELogic  e -> pp_logic_expr e
+| ELogic  e -> group (pp_logic_expr e)
 | EArith  e -> group (pp_arith_expr e)
 | EString e -> pp_string_expr e
 | EList   e -> group (pp_list_expr e)
@@ -316,7 +334,10 @@ and pp_expr = function
 | EPar    e -> pp_par pp_expr e
 | EFun    e -> pp_fun_expr e
 
-and pp_annot_expr {value; _} = string "TODO:pp_annot_expr"
+and pp_annot_expr {value; _} =
+  let expr, _, type_expr = value.inside in
+    group (string "(" ^^ nest 1 (pp_expr expr ^/^ string ": "
+    ^^ pp_type_expr type_expr ^^ string ")"))
 
 and pp_set_expr = function
   SetInj inj -> string "TODO:pp_set_expr:SetInj"
@@ -324,11 +345,11 @@ and pp_set_expr = function
 
 and pp_map_expr = function
   MapLookUp fetch -> pp_map_lookup fetch
-| MapInj inj      -> pp_injection pp_binding inj
+| MapInj inj      -> group (pp_injection pp_binding inj)
-| BigMapInj inj   -> pp_injection pp_binding inj
+| BigMapInj inj   -> group (pp_injection pp_binding inj)
 
 and pp_map_lookup {value; _} =
-  pp_path value.path ^^ blank 1 ^^ pp_brackets pp_expr value.index
+  prefix 2 1 (pp_path value.path) (pp_brackets pp_expr value.index)
 
 and pp_path = function
   Name v -> pp_ident v
@@ -451,7 +472,8 @@ and pp_injection :
     let kwd      = pp_injection_kwd kind in
     let offset   = String.length kwd + 2 in
     string (kwd ^ " [")
-    ^^ group (nest 2 (break 0 ^^ elements ^^ string "]"))
+    ^^ group (nest 2 (break 0 ^^ elements))
+    ^^ break 0 ^^ string "]"
 
 and pp_injection_kwd = function
   InjSet    _ -> "set"
@@ -467,7 +489,8 @@ and pp_ne_injection :
     let kwd      = pp_ne_injection_kwd kind in
     let offset   = String.length kwd + 2 in
     string (kwd ^ " [")
-    ^^ group (nest 2 (break 0 ^^ elements ^^ string "]"))
+    ^^ group (nest 2 (break 0 ^^ elements ))
+    ^^ break 0 ^^ string "]"
 
 and pp_ne_injection_kwd = function
   NEInjAttr   _ -> "attributes"
@@ -526,9 +549,9 @@ and pp_list_pattern = function
   PListComp cmp -> pp_list_comp cmp
 | PNil _        -> string "nil"
 | PParCons p    -> pp_ppar_cons p
-| PCons p       -> pp_nsepseq "#" pp_pattern p.value
+| PCons p       -> nest 4 (pp_nsepseq " #" pp_pattern p.value)
 
-and pp_list_comp {value; _} = string "TODO:pp_list_comp"
+and pp_list_comp e = group (pp_injection pp_pattern e)
 
 and pp_ppar_cons {value; _} = string "TODO:pp_ppar_cons"