Merge branch 'rinderknecht@pprint' into 'dev'

Adding a pretty-printer for CameLIGO source files

See merge request ligolang/ligo!599

src/bin/cli.ml

@@ -159,10 +159,22 @@ let preprocess =
   let doc = "Subcommand: Preprocess the source file.\nWarning: Intended for development of LIGO and can break at any time." in
   (Term.ret term, Term.info ~doc cmdname)
 
+let pretty_print =
+  let f source_file syntax display_format = (
+    toplevel ~display_format @@
+      let%bind pp =
+        Compile.Of_source.pretty_print source_file (Syntax_name syntax) in
+      ok @@ Buffer.contents pp
+  ) in
+  let term = Term.(const f $ source_file 0 $ syntax $ display_format) in
+  let cmdname = "pretty-print" in
+  let doc = "Subcommand: Pretty-print the source file."
+  in (Term.ret term, Term.info ~doc cmdname)
+
 let print_cst =
   let f source_file syntax display_format = (
     toplevel ~display_format @@
-    let%bind pp = Compile.Of_source.pretty_print source_file (Syntax_name syntax) in
+    let%bind pp = Compile.Of_source.pretty_print_cst source_file (Syntax_name syntax) in
     ok @@ Format.asprintf "%s \n" (Buffer.contents pp)
   )
   in
@@ -489,5 +501,6 @@ let run ?argv () =
     print_ast_typed ;
     print_mini_c ;
     list_declarations ;
-    preprocess
+    preprocess;
+    pretty_print
   ]

src/bin/expect_tests/help_tests.ml

@@ -57,6 +57,9 @@ let%expect_test _ =
                Subcommand: Preprocess the source file. Warning: Intended for
                development of LIGO and can break at any time.
 
+           pretty-print
+               Subcommand: Pretty-print the source file.
+
            print-ast
                Subcommand: Print the AST. Warning: Intended for development of
                LIGO and can break at any time.
@@ -148,6 +151,9 @@ let%expect_test _ =
                Subcommand: Preprocess the source file. Warning: Intended for
                development of LIGO and can break at any time.
 
+           pretty-print
+               Subcommand: Pretty-print the source file.
+
            print-ast
                Subcommand: Print the AST. Warning: Intended for development of
                LIGO and can break at any time.

src/bin/expect_tests/literals.ml

@@ -7,7 +7,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad ["interpret" ; "(\"thisisnotasignature\":signature)" ; "--syntax=pascaligo"] ;
   [%expect {|
-    ligo: in file "", line 0, characters 1-32. Badly formatted literal: Signature thisisnotasignature {"location":"in file \"\", line 0, characters 1-32"}
+    ligo: in file "", line 0, characters 0-33. Badly formatted literal: Signature thisisnotasignature {"location":"in file \"\", line 0, characters 0-33"}
 
 
      If you're not sure how to fix this error, you can
@@ -25,7 +25,7 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_bad ["interpret" ; "(\"thisisnotapublickey\":key)" ; "--syntax=pascaligo"] ;
   [%expect {|
-    ligo: in file "", line 0, characters 1-26. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 1-26"}
+    ligo: in file "", line 0, characters 0-27. Badly formatted literal: key thisisnotapublickey {"location":"in file \"\", line 0, characters 0-27"}
 
 
      If you're not sure how to fix this error, you can

src/main/compile/helpers.ml

@@ -129,7 +129,7 @@ let parsify_string syntax source =
   let%bind applied = Self_ast_imperative.all_program parsified
   in ok applied
 
-let pretty_print_pascaligo source =
+let pretty_print_pascaligo_cst source =
   let%bind ast = Parser.Pascaligo.parse_file source in
   let buffer = Buffer.create 59 in
   let state =
@@ -137,10 +137,10 @@ let pretty_print_pascaligo source =
       ~offsets:true
       ~mode:`Byte
       ~buffer in
-  Parser_pascaligo.ParserLog.pp_ast state ast;
+  Parser_pascaligo.ParserLog.pp_cst state ast;
   ok buffer
 
-let pretty_print_cameligo source =
+let pretty_print_cameligo_cst source =
   let%bind ast = Parser.Cameligo.parse_file source in
   let buffer = Buffer.create 59 in
   let state = (* TODO: Should flow from the CLI *)
@@ -148,10 +148,10 @@ let pretty_print_cameligo source =
       ~offsets:true
       ~mode:`Point
       ~buffer in
-  Parser_cameligo.ParserLog.pp_ast state ast;
+  Parser_cameligo.ParserLog.pp_cst state ast;
   ok buffer
 
-let pretty_print_reasonligo source =
+let pretty_print_reasonligo_cst source =
   let%bind ast = Parser.Reasonligo.parse_file source in
   let buffer = Buffer.create 59 in
   let state = (* TODO: Should flow from the CLI *)
@@ -159,16 +159,16 @@ let pretty_print_reasonligo source =
       ~offsets:true
       ~mode:`Point
       ~buffer in
-  Parser_cameligo.ParserLog.pp_ast state ast;
+  Parser_cameligo.ParserLog.pp_cst state ast;
   ok buffer
 
-let pretty_print syntax source =
+let pretty_print_cst syntax source =
   let%bind v_syntax =
     syntax_to_variant syntax (Some source) in
   match v_syntax with
-    PascaLIGO  -> pretty_print_pascaligo  source
+    PascaLIGO  -> pretty_print_pascaligo_cst  source
-  | CameLIGO   -> pretty_print_cameligo   source
+  | CameLIGO   -> pretty_print_cameligo_cst   source
-  | ReasonLIGO -> pretty_print_reasonligo source
+  | ReasonLIGO -> pretty_print_reasonligo_cst source
 
 let preprocess_pascaligo = Parser.Pascaligo.preprocess
 
@@ -183,3 +183,44 @@ let preprocess syntax source =
     PascaLIGO  -> preprocess_pascaligo  source
   | CameLIGO   -> preprocess_cameligo   source
   | ReasonLIGO -> preprocess_reasonligo source
+
+let pretty_print_pascaligo source =
+  let%bind ast = Parser.Pascaligo.parse_file source in
+  let doc    = Parser_pascaligo.Pretty.print ast in
+  let buffer = Buffer.create 131 in
+  let width  =
+    match Terminal_size.get_columns () with
+      None -> 60
+    | Some c -> c in
+  let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+  in Trace.ok buffer
+
+let pretty_print_cameligo source =
+  let%bind ast = Parser.Cameligo.parse_file source in
+  let doc    = Parser_cameligo.Pretty.print ast in
+  let buffer = Buffer.create 131 in
+  let width  =
+    match Terminal_size.get_columns () with
+      None -> 60
+    | Some c -> c in
+  let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+  in Trace.ok buffer
+
+let pretty_print_reasonligo source =
+  let%bind ast = Parser.Reasonligo.parse_file source in
+  let doc    = Parser_reasonligo.Pretty.print ast in
+  let buffer = Buffer.create 131 in
+  let width  =
+    match Terminal_size.get_columns () with
+      None -> 60
+    | Some c -> c in
+  let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+  in Trace.ok buffer
+
+let pretty_print syntax source =
+  let%bind v_syntax =
+    syntax_to_variant syntax (Some source) in
+  match v_syntax with
+    PascaLIGO  -> pretty_print_pascaligo  source
+  | CameLIGO   -> pretty_print_cameligo   source
+  | ReasonLIGO -> pretty_print_reasonligo source

src/main/compile/of_source.ml

@@ -19,8 +19,11 @@ let compile_contract_input : string -> string -> v_syntax -> Ast_imperative.expr
   let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in
   ok @@ Ast_imperative.e_pair storage parameter
 
-let pretty_print source_filename syntax =
+let pretty_print_cst source_filename syntax =
-  Helpers.pretty_print syntax source_filename
+  Helpers.pretty_print_cst syntax source_filename
 
 let preprocess source_filename syntax =
   Helpers.preprocess syntax source_filename
+
+let pretty_print source_filename syntax =
+  Helpers.pretty_print syntax source_filename

src/passes/01-parser/cameligo.ml

@@ -5,6 +5,7 @@ module Scoping  = Parser_cameligo.Scoping
 module Region   = Simple_utils.Region
 module ParErr   = Parser_cameligo.ParErr
 module SSet     = Set.Make (String)
+module Pretty   = Parser_cameligo.Pretty
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
@@ -19,7 +20,8 @@ module SubIO =
       ext     : string;   (* ".mligo" *)
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -34,6 +36,7 @@ module SubIO =
            method mode    = `Point
            method cmd     = EvalOpt.Quiet
            method mono    = false
+           method pretty  = false
          end
 
     let make =
@@ -46,6 +49,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#mono
   end
 
 module Parser =
@@ -146,3 +150,18 @@ let parse_expression source = apply (fun () -> Unit.expr_in_string source)
 (* Preprocessing a contract in a file *)
 
 let preprocess source = apply (fun () -> Unit.preprocess source)
+
+(* Pretty-print a file (after parsing it). *)
+
+let pretty_print source =
+  match parse_file source with
+    Stdlib.Error _ as e -> e
+  | Ok ast ->
+      let doc    = Pretty.print (fst ast) in
+      let buffer = Buffer.create 131 in
+      let width  =
+        match Terminal_size.get_columns () with
+          None -> 60
+        | Some c -> c in
+      let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+      in Trace.ok buffer

src/passes/01-parser/cameligo.mli

@@ -19,3 +19,6 @@ val parse_expression : string -> AST.expr Trace.result
 
 (** Preprocess a given CameLIGO file and preprocess it. *)
 val preprocess : string -> Buffer.t Trace.result
+
+(** Pretty-print a given CameLIGO file (after parsing it). *)
+val pretty_print : string -> Buffer.t Trace.result

src/passes/01-parser/cameligo/.links

@@ -19,5 +19,3 @@ $HOME/git/OCaml-build/Makefile
 ../shared/LexerUnit.ml
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
-
-$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml

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

@@ -137,11 +137,14 @@ and ast = t
 and attributes = attribute list
 
 and declaration =
-  Let      of (kwd_let * kwd_rec option * let_binding * attributes) reg
+  Let      of let_decl
 | TypeDecl of type_decl reg
 
 (* Non-recursive values *)
 
+and let_decl =
+  (kwd_let * kwd_rec option * let_binding * attributes) reg
+
 and let_binding = {
   binders  : pattern nseq;
   lhs_type : (colon * type_expr) option;
@@ -225,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
@@ -244,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;
@@ -339,15 +344,16 @@ and update = {
   lbrace   : lbrace;
   record   : path;
   kwd_with : kwd_with;
-  updates : field_path_assign reg ne_injection reg;
+  updates  : field_path_assignment reg ne_injection reg;
-  rbrace : rbrace;
+  rbrace   : rbrace
 }
 
-and field_path_assign = {
+and field_path_assignment = {
-  field_path  : (selection, dot) nsepseq;
+  field_path : path;
   assignment : equal;
   field_expr : expr
 }
+
 and path =
   Name of variable
 | Path of projection reg

src/passes/01-parser/cameligo/LexToken.mll

@@ -431,7 +431,7 @@ type nat_err =
 | Non_canonical_zero_nat
 
 let mk_nat lexeme region =
-  match (String.index_opt lexeme 'n') with
+  match String.index_opt lexeme 'n' with
       None -> Error Invalid_natural
   | Some _ -> let z =
                 Str.(global_replace (regexp "_") "" lexeme) |>
@@ -442,8 +442,7 @@ let mk_nat lexeme region =
              else Ok (Nat Region.{region; value = lexeme,z})
 
 let mk_mutez lexeme region =
-  let z =
+  let z = Str.(global_replace (regexp "_") "" lexeme) |>
-    Str.(global_replace (regexp "_") "" lexeme) |>
             Str.(global_replace (regexp "mutez") "") |>
             Z.of_string in
   if   Z.equal z Z.zero && lexeme <> "0mutez"

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

@@ -236,10 +236,7 @@ type_annotation:
 irrefutable:
   sub_irrefutable { $1 }
 | tuple(sub_irrefutable) {
-    let hd, tl = $1 in
+    let region = nsepseq_to_region pattern_to_region $1
-    let start  = pattern_to_region hd in
-    let stop   = last fst tl in
-    let region = cover start stop
     in PTuple {region; value=$1} }
 
 sub_irrefutable:
@@ -276,9 +273,7 @@ pattern:
     PList (PCons {region; value=$1,$2,$3})
   }
 | tuple(sub_pattern) {
-    let start  = pattern_to_region (fst $1) in
+    let region = nsepseq_to_region pattern_to_region $1
-    let stop   = last fst (snd $1) in
-    let region = cover start stop
     in PTuple {region; value=$1} }
 
 sub_pattern:
@@ -333,10 +328,7 @@ constr_pattern:
 
 ptuple:
   tuple(tail) {
-    let hd, tl = $1 in
+    let region = nsepseq_to_region pattern_to_region $1
-    let start  = pattern_to_region hd in
-    let stop   = last fst tl in
-    let region = cover start stop
     in PTuple {region; value=$1} }
 
 unit:
@@ -372,9 +364,7 @@ base_expr(right_expr):
 
 tuple_expr:
   tuple(disj_expr_level) {
-    let start  = expr_to_region (fst $1) in
+    let region = nsepseq_to_region expr_to_region $1
-    let stop   = last fst (snd $1) in
-    let region = cover start stop
     in ETuple {region; value=$1} }
 
 conditional(right_expr):
@@ -534,8 +524,7 @@ mult_expr_level:
 | unary_expr_level                                 {               $1 }
 
 unary_expr_level:
-  call_expr_level { $1 }
+  "-" call_expr_level {
-| "-" call_expr_level {
     let start = $1 in
     let stop = expr_to_region $2 in
     let region = cover start stop
@@ -547,7 +536,9 @@ unary_expr_level:
     let stop = expr_to_region $2 in
     let region = cover start stop
     and value  = {op=$1; arg=$2} in
-    ELogic (BoolExpr (Not ({region; value}))) }
+    ELogic (BoolExpr (Not ({region; value})))
+  }
+| call_expr_level { $1 }
 
 call_expr_level:
   call_expr | constr_expr | core_expr { $1 }
@@ -593,7 +584,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 {
@@ -642,7 +636,7 @@ update_record:
       lbrace   = $1;
       record   = $2;
       kwd_with = $3;
-      updates  = {value = {compound = Braces($1,$5);
+      updates  = {value = {compound = Braces (ghost, ghost);
                            ne_elements;
                            terminator};
                   region = cover $3 $5};
@@ -650,20 +644,15 @@ update_record:
     in {region; value} }
 
 field_path_assignment :
-  nsepseq(selection,".") "=" expr {
+  path "=" expr {
-    let start  = nsepseq_to_region selection_to_region $1 in
+    let region = cover (path_to_region $1) (expr_to_region $3)
-    let region = cover start (expr_to_region $3) in
+    and value  = {field_path=$1; assignment=$2; field_expr=$3}
-    let value  = {field_path = $1;
-                  assignment = $2;
-                  field_expr = $3}
     in {region; value} }
 
 field_assignment:
   field_name "=" expr {
-    let start  = $1.region in
+    let region = cover $1.region (expr_to_region $3)
-    let stop   = expr_to_region $3 in
+    and value  = {field_name = $1;
-    let region = cover start stop in
-    let value  = {field_name = $1;
                   assignment = $2;
                   field_expr = $3}
     in {region; value} }

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

@@ -136,11 +136,10 @@ let rec print_tokens state {decl;eof} =
   print_token state eof "EOF"
 
 and print_attributes state attributes =
-  List.iter (
+  let apply {value = attribute; region} =
-    fun ({value = attribute; region}) ->
     let attribute_formatted = sprintf "[@@%s]" attribute in
     print_token state region attribute_formatted
-   ) attributes
+  in List.iter apply attributes
 
 and print_statement state = function
   Let {value=kwd_let, kwd_rec, let_binding, attributes; _} ->
@@ -527,7 +526,7 @@ and print_field_assign state {value; _} =
 
 and print_field_path_assign state {value; _} =
   let {field_path; assignment; field_expr} = value in
-  print_nsepseq state "." print_selection field_path;
+  print_path  state field_path;
   print_token state assignment "=";
   print_expr  state field_expr
 
@@ -616,12 +615,20 @@ let pp_node state name =
   let node = sprintf "%s%s\n" state#pad_path name
   in Buffer.add_string state#buffer node
 
-let pp_string state = pp_ident state
+let pp_string state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s%S (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
+
+let pp_verbatim state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s{|%s|} (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
 
 let pp_loc_node state name region =
   pp_ident state {value=name; region}
 
-let rec pp_ast state {decl; _} =
+let rec pp_cst state {decl; _} =
   let apply len rank =
     pp_declaration (state#pad len rank) in
   let decls = Utils.nseq_to_list decl in
@@ -704,7 +711,7 @@ and pp_pattern state = function
     pp_string (state#pad 1 0) s
 | PVerbatim v ->
     pp_node   state "PVerbatim";
-    pp_string (state#pad 1 0) v
+    pp_verbatim (state#pad 1 0) v
 | PUnit {region; _} ->
     pp_loc_node state "PUnit" region
 | PFalse region ->
@@ -938,7 +945,7 @@ and pp_projection state proj =
   List.iteri (apply len) selections
 
 and pp_update state update =
-  pp_path state update.record;
+  pp_path (state#pad 2 0) update.record;
   pp_ne_injection pp_field_path_assign state update.updates.value
 
 and pp_path state = function
@@ -963,10 +970,10 @@ and pp_field_assign state {value; _} =
   pp_expr  (state#pad 2 1) value.field_expr
 
 and pp_field_path_assign state {value; _} =
-  pp_node  state "<field path for update>";
+  let {field_path; field_expr; _} = value in
-  let path = Utils.nsepseq_to_list value.field_path in
+  pp_node state "<update>";
-  List.iter (pp_selection (state#pad 2 0)) path;
+  pp_path (state#pad 2 0) field_path;
-  pp_expr  (state#pad 2 1) value.field_expr
+  pp_expr (state#pad 2 1) field_expr
 
 and pp_constr_expr state = function
   ENone region ->
@@ -987,11 +994,11 @@ and pp_constr_app_expr state (constr, expr_opt) =
 
 and pp_list_expr state = function
   ECons {value; region} ->
-    pp_loc_node state "Cons" region;
+    pp_loc_node state "ECons" region;
     pp_expr (state#pad 2 0) value.arg1;
     pp_expr (state#pad 2 1) value.arg2
 | EListComp {value; region} ->
-    pp_loc_node state "List" region;
+    pp_loc_node state "EListComp" region;
     if   value.elements = None
     then pp_node (state#pad 1 0) "<nil>"
     else pp_injection pp_expr state value

src/passes/01-parser/cameligo/ParserLog.mli

@@ -27,5 +27,5 @@ val expr_to_string :
 
 (** {1 Pretty-printing of AST nodes} *)
 
-val pp_ast  : state -> AST.t -> unit
+val pp_cst  : state -> AST.t -> unit
 val pp_expr : state -> AST.expr -> unit

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

@@ -22,7 +22,8 @@ module SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -36,6 +37,7 @@ module SubIO =
         method mode    = IO.options#mode
         method cmd     = IO.options#cmd
         method mono    = IO.options#mono
+        method pretty  = IO.options#pretty
       end
 
     let make =
@@ -48,6 +50,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -67,14 +70,28 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 
 let wrap = function
-  Stdlib.Ok _ -> flush_all ()
+  Stdlib.Ok ast ->
+    if IO.options#pretty then
+      begin
+        let doc = Pretty.print ast in
+        let width =
+          match Terminal_size.get_columns () with
+            None -> 60
+          | Some c -> c in
+        PPrint.ToChannel.pretty 1.0 width stdout doc;
+        print_newline ()
+      end;
+    flush_all ()
 | Error msg ->
-    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
+    begin
+      flush_all ();
+      Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value
+    end
 
 let () =
   match IO.options#input with

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

@@ -0,0 +1,442 @@
+[@@@warning "-42"]
+
+open AST
+module Region = Simple_utils.Region
+open! Region
+open! PPrint
+
+let pp_par printer {value; _} =
+  string "(" ^^ nest 1 (printer value.inside ^^ string ")")
+
+let rec print ast =
+  let app decl = group (pp_declaration decl) in
+  let decl = Utils.nseq_to_list ast.decl in
+  separate_map (hardline ^^ hardline) app decl
+
+and pp_declaration = function
+  Let decl -> pp_let_decl decl
+| TypeDecl decl -> pp_type_decl decl
+
+and pp_let_decl {value; _} =
+  let _, rec_opt, binding, attr = value in
+  let let_str =
+    match rec_opt with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let binding = pp_let_binding binding
+  and attr    = pp_attributes attr
+  in string let_str ^^ binding ^^ attr
+
+and pp_attributes = function
+    [] -> empty
+| attr ->
+    let make s = string "[@@" ^^ string s.value ^^ string "]" in
+    group (nest 2 (break 1 ^^ separate_map (break 0) make attr))
+
+and pp_ident {value; _} = string value
+
+and pp_string s = string "\"" ^^ pp_ident s ^^ string "\""
+
+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 head, tail = binders in
+  let patterns =
+    group (nest 2 (separate_map (break 1) pp_pattern (head::tail))) in
+  let lhs =
+    patterns ^^
+    match lhs_type with
+            None -> empty
+    | Some (_,e) -> group (break 1 ^^ string ": " ^^ pp_type_expr e)
+  in prefix 2 1 (lhs ^^ string " =") (pp_expr let_rhs)
+
+and pp_pattern = function
+  PConstr p -> pp_pconstr p
+| PUnit   _ -> string "()"
+| PFalse  _ -> string "false"
+| PTrue   _ -> string "true"
+| PVar    v -> pp_ident v
+| PInt    i -> pp_int i
+| PNat    n -> pp_nat n
+| PBytes  b -> pp_bytes b
+| PString s -> pp_string s
+| PVerbatim s -> pp_verbatim s
+| PWild   _ -> string "_"
+| PList   l -> pp_plist l
+| PTuple  t -> pp_ptuple t
+| PPar    p -> pp_ppar p
+| PRecord r -> pp_precord r
+| PTyped  t -> pp_ptyped t
+
+and pp_pconstr = function
+  PNone      _ -> string "None"
+| PSomeApp   p -> pp_patt_some p
+| PConstrApp a -> pp_pconstr_app a
+
+and pp_pconstr_app {value; _} =
+  match value with
+    constr, None -> pp_ident constr
+  | constr, Some pat ->
+      prefix 4 1 (pp_ident constr) (pp_pattern pat)
+
+and pp_patt_some {value; _} =
+  prefix 4 1 (string "Some") (pp_pattern (snd value))
+
+and pp_int {value; _} =
+  string (Z.to_string (snd value))
+
+and pp_nat {value; _} =
+  string (Z.to_string (snd value) ^ "n")
+
+and pp_bytes {value; _} =
+  string ("0x" ^ Hex.show (snd value))
+
+and pp_ppar p = pp_par pp_pattern p
+
+and pp_plist = function
+  PListComp cmp -> pp_list_comp cmp
+| PCons cons -> pp_pcons cons
+
+and pp_list_comp e = group (pp_injection pp_pattern e)
+
+and pp_pcons {value; _} =
+  let patt1, _, patt2 = value in
+  prefix 2 1 (pp_pattern patt1 ^^ string " ::") (pp_pattern patt2)
+
+and pp_ptuple {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [p] -> group (break 1 ^^ pp_pattern p)
+  | p::items ->
+      group (break 1 ^^ pp_pattern p ^^ string ",") ^^ app items
+  in if tail = []
+     then pp_pattern head
+     else pp_pattern head ^^ string "," ^^ app (List.map snd tail)
+
+and pp_precord fields = pp_ne_injection pp_field_pattern fields
+
+and pp_field_pattern {value; _} =
+  let {field_name; pattern; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_pattern pattern)
+
+and pp_ptyped {value; _} =
+  let {pattern; type_expr; _} = value in
+  group (pp_pattern pattern ^^ string " :" ^/^ pp_type_expr type_expr)
+
+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 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 -> 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)
+| EConstr e -> pp_constr_expr e
+| ERecord e -> pp_record_expr e
+| EProj   e -> pp_projection e
+| EUpdate e -> pp_update e
+| EVar    v -> pp_ident v
+| ECall   e -> pp_call_expr e
+| EBytes  e -> pp_bytes e
+| EUnit   _ -> string "()"
+| ETuple  e -> pp_tuple_expr e
+| EPar    e -> pp_par_expr e
+| ELetIn  e -> pp_let_in e
+| EFun    e -> pp_fun e
+| ESeq    e -> pp_seq e
+
+and pp_case_expr {value; _} =
+  let {expr; cases; _} = value in
+  group (string "match " ^^ nest 6 (pp_expr expr) ^/^ string "with")
+  ^^ hardline ^^ pp_cases cases
+
+and pp_cases {value; _} =
+  let head, tail = value in
+  let head       = pp_clause head in
+  let head       = if tail = [] then head else blank 2 ^^ head in
+  let rest       = List.map snd tail in
+  let app clause = break 1 ^^ string "| " ^^ pp_clause clause
+  in  head ^^ concat_map app rest
+
+and pp_clause {value; _} =
+  let {pattern; rhs; _} = value in
+    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
+     else test ^/^ ifso ^/^ ifnot
+
+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_logic_expr = function
+  BoolExpr e -> pp_bool_expr e
+| CompExpr e -> pp_comp_expr e
+
+and pp_bool_expr = function
+  Or   e  -> pp_bin_op "||" e
+| And  e  -> pp_bin_op "&&" e
+| Not  e  -> pp_un_op "not" e
+| True  _ -> string "true"
+| False _ -> string "false"
+
+and pp_bin_op op {value; _} =
+  let {arg1; arg2; _} = value
+  and length = String.length op + 1 in
+  pp_expr arg1 ^/^ string (op ^ " ") ^^ nest length (pp_expr arg2)
+
+and pp_un_op op {value; _} =
+  string (op ^ " ") ^^ pp_expr value.arg
+
+and pp_comp_expr = function
+  Lt    e -> pp_bin_op "<"  e
+| Leq   e -> pp_bin_op "<=" e
+| Gt    e -> pp_bin_op ">"  e
+| Geq   e -> pp_bin_op ">=" e
+| Equal e -> pp_bin_op "="  e
+| Neq   e -> pp_bin_op "<>" e
+
+and pp_arith_expr = function
+  Add   e -> pp_bin_op "+" e
+| Sub   e -> pp_bin_op "-" e
+| Mult  e -> pp_bin_op "*" e
+| Div   e -> pp_bin_op "/" e
+| Mod   e -> pp_bin_op "mod" e
+| Neg   e -> string "-" ^^ pp_expr e.value.arg
+| Int   e -> pp_int e
+| Nat   e -> pp_nat e
+| Mutez e -> pp_mutez e
+
+and pp_mutez {value; _} =
+  Z.to_string (snd value) ^ "mutez" |> string
+
+and pp_string_expr = function
+     Cat e -> pp_bin_op "^" e
+| String e -> pp_string e
+| Verbatim e -> pp_verbatim e
+
+and pp_list_expr = function
+      ECons e -> pp_bin_op "::" e
+| EListComp e -> group (pp_injection pp_expr e)
+
+and pp_injection :
+  'a.('a -> document) -> 'a injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; elements; _} = value in
+    let sep = string ";" ^^ break 1 in
+    let elements = Utils.sepseq_to_list elements in
+    let elements = separate_map sep printer elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 1 elements ^^ string closing
+
+and pp_compound = function
+  BeginEnd (start, _) ->
+    if start#is_ghost then None else Some ("begin","end")
+| Braces (start, _) ->
+    if start#is_ghost then None else Some ("{","}")
+| Brackets (start, _) ->
+    if start#is_ghost then None else Some ("[","]")
+
+and pp_constr_expr = function
+  ENone      _ -> string "None"
+| ESomeApp   a -> pp_some a
+| EConstrApp a -> pp_constr_app a
+
+and pp_some {value=_, e; _} =
+  prefix 4 1 (string "Some") (pp_expr e)
+
+and pp_constr_app {value; _} =
+  let constr, arg = value in
+  let constr = string constr.value in
+  match arg with
+      None -> constr
+  | Some e -> prefix 2 1 constr (pp_expr e)
+
+and pp_record_expr ne_inj = group (pp_ne_injection pp_field_assign ne_inj)
+
+and pp_field_assign {value; _} =
+  let {field_name; field_expr; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_expr field_expr)
+
+and pp_ne_injection :
+  'a.('a -> document) -> 'a ne_injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; ne_elements; _} = value in
+    let elements = pp_nsepseq ";" printer ne_elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 1 elements ^^ string closing
+
+and pp_nsepseq :
+  'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
+  fun sep printer elements ->
+    let elems = Utils.nsepseq_to_list elements
+    and sep   = string sep ^^ break 1
+    in separate_map sep printer elems
+
+and pp_nseq : 'a.('a -> document) -> 'a Utils.nseq -> document =
+  fun printer (head, tail) -> separate_map (break 1) printer (head::tail)
+
+and pp_projection {value; _} =
+  let {struct_name; field_path; _} = value in
+  let fields = Utils.nsepseq_to_list field_path
+  and sep    = string "." ^^ break 0 in
+  let fields = separate_map sep pp_selection fields in
+  group (pp_ident struct_name ^^ string "." ^^ break 0 ^^ fields)
+
+and pp_selection = function
+  FieldName v   -> string v.value
+| Component cmp -> cmp.value |> snd |> Z.to_string |> string
+
+and pp_update {value; _} =
+  let {record; updates; _} = value in
+  let updates = group (pp_ne_injection pp_field_path_assign updates)
+  and record  = pp_path record in
+  string "{" ^^ record ^^ string " with"
+  ^^ nest 2 (break 1 ^^ updates ^^ string "}")
+
+and pp_field_path_assign {value; _} =
+  let {field_path; field_expr; _} = value in
+  let path = pp_path field_path in
+  prefix 2 1 (path ^^ string " =") (pp_expr field_expr)
+
+and pp_path = function
+  Name v -> pp_ident v
+| Path p -> pp_projection p
+
+and pp_call_expr {value; _} =
+  let lambda, arguments = value in
+  let arguments = pp_nseq pp_expr arguments in
+  group (pp_expr lambda ^^ nest 2 (break 1 ^^ arguments))
+
+and pp_tuple_expr {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_expr e ^^ string ",") ^^ app items
+  in if tail = []
+     then pp_expr head
+     else pp_expr head ^^ string "," ^^ app (List.map snd tail)
+
+and pp_par_expr e = pp_par pp_expr e
+
+and pp_let_in {value; _} =
+  let {binding; kwd_rec; body; attributes; _} = value in
+  let let_str =
+    match kwd_rec with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let binding = pp_let_binding binding
+  and attr    = pp_attributes attributes
+  in string let_str ^^ binding ^^ attr
+     ^^ hardline ^^ group (string "in " ^^ nest 3 (pp_expr body))
+
+and pp_fun {value; _} =
+  let {binders; lhs_type; body; _} = value in
+  let binders = pp_nseq pp_pattern binders
+  and annot   =
+    match lhs_type with
+      None -> empty
+    | Some (_,e) ->
+        group (break 1 ^^ string ": " ^^ nest 2 (break 1 ^^ pp_type_expr e))
+  in group (string "fun " ^^ nest 4 binders ^^ annot
+     ^^ string " ->" ^^ nest 2 (break 1 ^^ pp_expr body))
+
+and pp_seq {value; _} =
+  let {compound; elements; _} = value in
+  let sep = string ";" ^^ hardline in
+  let elements = Utils.sepseq_to_list elements in
+  let elements = separate_map sep pp_expr elements in
+  match pp_compound compound with
+    None -> elements
+  | Some (opening, closing) ->
+     string opening
+     ^^ nest 2 (hardline ^^ elements) ^^ hardline
+     ^^ string closing
+
+and pp_type_expr = function
+  TProd t   -> pp_cartesian t
+| TSum t    -> pp_variants t
+| TRecord t -> pp_fields t
+| TApp t    -> pp_type_app t
+| TFun t    -> pp_fun_type t
+| TPar t    -> pp_type_par t
+| TVar t    -> pp_ident t
+| TString s -> pp_string s
+
+and pp_cartesian {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string " *") ^^ app items
+  in pp_type_expr head ^^ string " *" ^^ app (List.map snd tail)
+
+and pp_variants {value; _} =
+  let head, tail = value in
+  let head = pp_variant head in
+  let head = if tail = [] then head else ifflat head (blank 2 ^^ head) in
+  let rest = List.map snd tail in
+  let app variant = break 1 ^^ string "| " ^^ pp_variant variant
+  in head ^^ concat_map app rest
+
+and pp_variant {value; _} =
+  let {constr; arg} = value in
+  match arg with
+    None -> pp_ident constr
+  | Some (_, e) ->
+      prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr e)
+
+and pp_fields fields = group (pp_ne_injection pp_field_decl fields)
+
+and pp_field_decl {value; _} =
+  let {field_name; field_type; _} = value in
+  let name = pp_ident field_name in
+  let t_expr = pp_type_expr field_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_type_app {value = ctor, tuple; _} =
+  pp_type_tuple tuple ^^ group (nest 2 (break 1 ^^ pp_type_constr ctor))
+
+and pp_type_tuple {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items in
+  if tail = []
+  then pp_type_expr head
+  else
+    let components =
+      pp_type_expr head ^^ string "," ^^ app (List.map snd tail)
+    in string "(" ^^ nest 1 (components ^^ string ")")
+
+and pp_type_constr ctor = string ctor.value
+
+and pp_fun_type {value; _} =
+  let lhs, _, rhs = value in
+  group (pp_type_expr lhs ^^ string " ->" ^/^ pp_type_expr rhs)
+
+and pp_type_par t = pp_par pp_type_expr t

src/passes/01-parser/cameligo/Tests/pp.mligo

@@ -1,29 +1,54 @@
-type q = {a: int; b: {c: string}}
+let patch_ (m : foobar) : foobar = Map.literal [(0, 5); (1, 6); (2, 7)]
-type r = int list
-type s = (int, address) map
-type t = int
-type u = {a: int; b: t * char}
-type v = int * (string * address)
-type w = timestamp * nat -> (string, address) map
-type x = A | B of t * int | C of int -> (string -> int)
 
-let x = 4
+let (greet_num : int), (greeting : string), one_more_component =
-let y : t = (if true then -3 + f x x else 0) - 1
+  different_types of_many_things + ffffff 124312
-let f (x: int) y = (x : int)
+
+type storage = int * int
+
+let main (n : int * storage)
+  : operation list * storage =
+  let x : int * int =
+    let x : int = 7
+    in x + n.0.asdasdasd.4, n.1.0 + n.1.1.1111111.aaaa.ddddddd.eeeeeee
+  in ([] : operation list), x
+
+let y : t =
+  if true then ffffffffff (-30000 * 10000 - 100000 + f x x y y y y - ((x / 4000) * -5), 103+5) else (10000 + 100000) / 10000000000
+type return = operation list * (storage * fsdgsdgf * sdfsdfsdf * ssdf)
+let xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx =
+  ttttttttttttt <= (aaaaaaaaaaaaaaaaaaaaaaaa - bbbbbbbbbbbbbbbbbbbb)
+let x = tttt * ((fffffffff /55555555) - 3455 * 5135664) - 134 * (-4)
+type x = AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA | B
+let or_true (b : bool) : bool = bbbbbbbbbbbbb || true && cccccccccccccccccc
+type x = A | B of t * int | CCC of int -> (string -> int) -> (string, address, timestamp, int) map
+let c = CCCCCCCCCCCC (aaaaa, BBBBBBBBB aaaaaaaaaaaa)
+let e = Some (a, B b)
+type w = timestamp * nat -> (string, address) map -> t
+type v = int * (a_long_type_name * (another_long_one * address * and_so_on) * more_of_a_very_long_type)
+
+type r = int list
+type t = int
+type s = (int,address,a_long_type_name, more_of_a_very_long_type * foo_bar_baz) t
+type q = {a: int; b: {c: string}; c: timestamp * (address, string) big_map -> longer_type_name}
+type u = {a: int; b: t * char; c: int * (a_long_type_name * (another_long_one * address * and_so_on) * more_of_a_very_long_type)}
+let f xxxxxxxxxxxxxxxxxxxxxx yyyyyyyyyyyyyyyyyyyyy zzzzzzzzzzz ttttt : type_annotation_which_is_very_verbose = this_too_short_a_variable
+let g : type_annotation_which_is_very_verbose = fun x y z t -> this_too_short_a_variable [@@inline]
+let yyyyyyyyyyy : a_very_long_and_specific_type_of_string = "foo and bar"
+let rec x (_, (yyyyyyyyyyyyyyyy: tttttttttttttttttttttttt), very_long_variable_to_trigger_a_break) = 4
+let y {xxxxxxxxx=(_,yyyyyyyy,more_components,another_one); zzzzzzz=34444444; ttttttt=3n} = xxxxxx
 let z : (t) = y
-let w =
+let f (xxxxxxxxxxx: tttttttttttttt) y = (xxxxxxxxxxxx : tttttttttttttttttt)
-  match f 3 with
-    None -> []
-  | Some (1::[2;3]) -> [4;5]::[]
 let n : nat = 0n
 let a = A
 let b = B a
-let c = C (a, B (a))
 let d = None
-let e = Some (a, B b)
+let z = let v = "hello" ^ "world" ^ "!" in v
-let z = z.1.2
+let r = { field = 0; another = 11111111111111111; and_another_one = "dddddd"}
-let v = "hello" ^ "world" ^ "!"
+let r = { r with field = 42; another = 11111111111111111; and_another_one = "dddddddddddddddddddddd"}
-let w = Map.literal [(1,"1"); (2,"2")]
+let w = Map.literal [(11111111111111,"11111111111111"); (22222222222,"22222222222222222"); (1234567890,"1234567890")]
-
+let z = z.1.a.0.4.c.6.7.8.9.cccccccccccc.ccccccccccccccccc.ddddddddddddddddd.0.1.2
-let r = { field = 0}
+let y : t = (if true then -30000000000000 + f x x y y y y else 10000000000000000000) - 1
-let r = { r with field = 42}
+let w =
+  match f 3 with
+    None -> []
+  | Some (1::[2;3;4;5;6]) -> [4;5]::[]

src/passes/01-parser/cameligo/dune

@@ -15,8 +15,10 @@
   (name parser_cameligo)
   (public_name ligo.parser.cameligo)
   (modules
-     Scoping AST cameligo Parser ParserLog LexToken ParErr)
+     Scoping AST cameligo Parser ParserLog LexToken ParErr Pretty)
   (libraries
+     pprint
+     terminal_size
      menhirLib
      parser_shared
      str
@@ -26,8 +28,8 @@
     (pps bisect_ppx --conditional))
   (flags (:standard -open Parser_shared -open Simple_utils)))
 
-;; Build of the unlexer (for covering the
+;; Build of the unlexer (for covering the error states of the LR
-;; error states of the LR automaton)
+;; automaton)
 
 (executable
   (name Unlexer)

src/passes/01-parser/cameligo/error.messages.checked-in

@@ -1948,7 +1948,7 @@ interactive_expr: LBRACE Constr DOT Ident With
 ##
 ## Ends in an error in state: 523.
 ##
-## projection -> Constr DOT Ident . DOT nsepseq(selection,DOT) [ With ]
+## projection -> Constr DOT Ident . DOT nsepseq(selection,DOT) [ With EQ ]
 ##
 ## The known suffix of the stack is as follows:
 ## Constr DOT Ident
@@ -1960,7 +1960,7 @@ interactive_expr: LBRACE Constr DOT With
 ##
 ## Ends in an error in state: 522.
 ##
-## projection -> Constr DOT . Ident DOT nsepseq(selection,DOT) [ With ]
+## projection -> Constr DOT . Ident DOT nsepseq(selection,DOT) [ With EQ ]
 ##
 ## The known suffix of the stack is as follows:
 ## Constr DOT
@@ -1972,7 +1972,7 @@ interactive_expr: LBRACE Constr With
 ##
 ## Ends in an error in state: 521.
 ##
-## projection -> Constr . DOT Ident DOT nsepseq(selection,DOT) [ With ]
+## projection -> Constr . DOT Ident DOT nsepseq(selection,DOT) [ With EQ ]
 ##
 ## The known suffix of the stack is as follows:
 ## Constr
@@ -2002,7 +2002,7 @@ interactive_expr: LBRACE Ident DOT Ident Verbatim
 
 interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes SEMI With
 ##
-## Ends in an error in state: 551.
+## Ends in an error in state: 552.
 ##
 ## nsepseq(field_assignment,SEMI) -> field_assignment SEMI . nsepseq(field_assignment,SEMI) [ RBRACE ]
 ## seq(__anonymous_0(field_assignment,SEMI)) -> field_assignment SEMI . seq(__anonymous_0(field_assignment,SEMI)) [ RBRACE ]
@@ -2015,7 +2015,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes SEMI With
 
 interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes With
 ##
-## Ends in an error in state: 550.
+## Ends in an error in state: 551.
 ##
 ## nsepseq(field_assignment,SEMI) -> field_assignment . [ RBRACE ]
 ## nsepseq(field_assignment,SEMI) -> field_assignment . SEMI nsepseq(field_assignment,SEMI) [ RBRACE ]
@@ -2047,7 +2047,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI Ident EQ Bytes With
 
 interactive_expr: LBRACE Ident EQ Bytes SEMI Ident With
 ##
-## Ends in an error in state: 547.
+## Ends in an error in state: 548.
 ##
 ## field_assignment -> Ident . EQ expr [ SEMI RBRACE ]
 ##
@@ -2059,7 +2059,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI Ident With
 
 interactive_expr: LBRACE Ident EQ Bytes SEMI With
 ##
-## Ends in an error in state: 546.
+## Ends in an error in state: 547.
 ##
 ## nsepseq(field_assignment,SEMI) -> field_assignment SEMI . nsepseq(field_assignment,SEMI) [ RBRACE ]
 ## nseq(__anonymous_0(field_assignment,SEMI)) -> field_assignment SEMI . seq(__anonymous_0(field_assignment,SEMI)) [ RBRACE ]
@@ -2072,7 +2072,7 @@ interactive_expr: LBRACE Ident EQ Bytes SEMI With
 
 interactive_expr: LBRACE Ident EQ Bytes With
 ##
-## Ends in an error in state: 545.
+## Ends in an error in state: 546.
 ##
 ## nsepseq(field_assignment,SEMI) -> field_assignment . [ RBRACE ]
 ## nsepseq(field_assignment,SEMI) -> field_assignment . SEMI nsepseq(field_assignment,SEMI) [ RBRACE ]
@@ -2128,9 +2128,9 @@ interactive_expr: LBRACE Ident WILD
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes SEMI With
+interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes SEMI Ident DOT Ident EQ Bytes SEMI With
 ##
-## Ends in an error in state: 541.
+## Ends in an error in state: 542.
 ##
 ## nsepseq(field_path_assignment,SEMI) -> field_path_assignment SEMI . nsepseq(field_path_assignment,SEMI) [ RBRACE ]
 ## seq(__anonymous_0(field_path_assignment,SEMI)) -> field_path_assignment SEMI . seq(__anonymous_0(field_path_assignment,SEMI)) [ RBRACE ]
@@ -2141,9 +2141,9 @@ interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes SEMI With
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes With
+interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes SEMI Ident DOT Ident EQ Bytes With
 ##
-## Ends in an error in state: 540.
+## Ends in an error in state: 541.
 ##
 ## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . [ RBRACE ]
 ## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . SEMI nsepseq(field_path_assignment,SEMI) [ RBRACE ]
@@ -2168,14 +2168,14 @@ interactive_expr: LBRACE Ident With Int EQ Bytes SEMI Int EQ Bytes With
 ## In state 368, spurious reduction of production base_expr(expr) -> disj_expr_level 
 ## In state 370, spurious reduction of production base_cond__open(expr) -> base_expr(expr) 
 ## In state 371, spurious reduction of production expr -> base_cond__open(expr) 
-## In state 534, spurious reduction of production field_path_assignment -> nsepseq(selection,DOT) EQ expr 
+## In state 534, spurious reduction of production field_path_assignment -> path EQ expr 
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: LBRACE Ident With Int EQ Bytes SEMI With
+interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes SEMI With
 ##
-## Ends in an error in state: 537.
+## Ends in an error in state: 538.
 ##
 ## nsepseq(field_path_assignment,SEMI) -> field_path_assignment SEMI . nsepseq(field_path_assignment,SEMI) [ RBRACE ]
 ## nseq(__anonymous_0(field_path_assignment,SEMI)) -> field_path_assignment SEMI . seq(__anonymous_0(field_path_assignment,SEMI)) [ RBRACE ]
@@ -2186,9 +2186,9 @@ interactive_expr: LBRACE Ident With Int EQ Bytes SEMI With
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: LBRACE Ident With Int EQ Bytes With
+interactive_expr: LBRACE Ident With Ident DOT Ident EQ Bytes With
 ##
-## Ends in an error in state: 536.
+## Ends in an error in state: 537.
 ##
 ## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . [ RBRACE ]
 ## nsepseq(field_path_assignment,SEMI) -> field_path_assignment . SEMI nsepseq(field_path_assignment,SEMI) [ RBRACE ]
@@ -2213,37 +2213,52 @@ interactive_expr: LBRACE Ident With Int EQ Bytes With
 ## In state 368, spurious reduction of production base_expr(expr) -> disj_expr_level 
 ## In state 370, spurious reduction of production base_cond__open(expr) -> base_expr(expr) 
 ## In state 371, spurious reduction of production expr -> base_cond__open(expr) 
-## In state 534, spurious reduction of production field_path_assignment -> nsepseq(selection,DOT) EQ expr 
+## In state 534, spurious reduction of production field_path_assignment -> path EQ expr 
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: LBRACE Ident With Int EQ With
+interactive_expr: LBRACE Ident With Ident DOT Ident EQ With
 ##
 ## Ends in an error in state: 533.
 ##
-## field_path_assignment -> nsepseq(selection,DOT) EQ . expr [ SEMI RBRACE ]
+## field_path_assignment -> path EQ . expr [ SEMI RBRACE ]
 ##
 ## The known suffix of the stack is as follows:
-## nsepseq(selection,DOT) EQ
+## path EQ
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: LBRACE Ident With Int With
+interactive_expr: LBRACE Ident With Ident DOT Ident With
 ##
 ## Ends in an error in state: 532.
 ##
-## field_path_assignment -> nsepseq(selection,DOT) . EQ expr [ SEMI RBRACE ]
+## field_path_assignment -> path . EQ expr [ SEMI RBRACE ]
 ##
 ## The known suffix of the stack is as follows:
-## nsepseq(selection,DOT)
+## path
 ##
 ## WARNING: This example involves spurious reductions.
 ## This implies that, although the LR(1) items shown above provide an
 ## accurate view of the past (what has been recognized so far), they
 ## may provide an INCOMPLETE view of the future (what was expected next).
 ## In state 187, spurious reduction of production nsepseq(selection,DOT) -> selection 
+## In state 190, spurious reduction of production projection -> Ident DOT nsepseq(selection,DOT) 
+## In state 526, spurious reduction of production path -> projection 
+##
+
+<YOUR SYNTAX ERROR MESSAGE HERE>
+
+interactive_expr: LBRACE Ident With Ident With
+##
+## Ends in an error in state: 529.
+##
+## path -> Ident . [ EQ ]
+## projection -> Ident . DOT nsepseq(selection,DOT) [ EQ ]
+##
+## The known suffix of the stack is as follows:
+## Ident
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
@@ -2275,7 +2290,7 @@ interactive_expr: LBRACE With
 
 interactive_expr: LBRACKET Verbatim SEMI Verbatim SEMI With
 ##
-## Ends in an error in state: 566.
+## Ends in an error in state: 567.
 ##
 ## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ]
 ## seq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(expr,SEMI)) [ RBRACKET ]
@@ -2288,7 +2303,7 @@ interactive_expr: LBRACKET Verbatim SEMI Verbatim SEMI With
 
 interactive_expr: LBRACKET Verbatim SEMI Verbatim With
 ##
-## Ends in an error in state: 565.
+## Ends in an error in state: 566.
 ##
 ## nsepseq(expr,SEMI) -> expr . [ RBRACKET ]
 ## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ RBRACKET ]
@@ -2319,7 +2334,7 @@ interactive_expr: LBRACKET Verbatim SEMI Verbatim With
 
 interactive_expr: LBRACKET Verbatim SEMI With
 ##
-## Ends in an error in state: 562.
+## Ends in an error in state: 563.
 ##
 ## nsepseq(expr,SEMI) -> expr SEMI . nsepseq(expr,SEMI) [ RBRACKET ]
 ## nseq(__anonymous_0(expr,SEMI)) -> expr SEMI . seq(__anonymous_0(expr,SEMI)) [ RBRACKET ]
@@ -2332,7 +2347,7 @@ interactive_expr: LBRACKET Verbatim SEMI With
 
 interactive_expr: LBRACKET Verbatim With
 ##
-## Ends in an error in state: 561.
+## Ends in an error in state: 562.
 ##
 ## nsepseq(expr,SEMI) -> expr . [ RBRACKET ]
 ## nsepseq(expr,SEMI) -> expr . SEMI nsepseq(expr,SEMI) [ RBRACKET ]
@@ -2373,14 +2388,14 @@ interactive_expr: LBRACKET With
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: LPAR Verbatim COLON String VBAR
+interactive_expr: LPAR Verbatim COLON Ident VBAR
 ##
-## Ends in an error in state: 579.
+## Ends in an error in state: 581.
 ##
-## par(__anonymous_1) -> LPAR expr COLON type_expr . RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
+## par(annot_expr) -> LPAR annot_expr . RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
 ##
 ## The known suffix of the stack is as follows:
-## LPAR expr COLON type_expr
+## LPAR annot_expr
 ##
 ## WARNING: This example involves spurious reductions.
 ## This implies that, although the LR(1) items shown above provide an
@@ -2389,27 +2404,28 @@ interactive_expr: LPAR Verbatim COLON String VBAR
 ## In state 28, spurious reduction of production cartesian -> core_type 
 ## In state 36, spurious reduction of production fun_type -> cartesian 
 ## In state 27, spurious reduction of production type_expr -> fun_type 
+## In state 580, spurious reduction of production annot_expr -> expr COLON type_expr 
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
 interactive_expr: LPAR Verbatim COLON With
 ##
-## Ends in an error in state: 578.
+## Ends in an error in state: 579.
 ##
-## par(__anonymous_1) -> LPAR expr COLON . type_expr RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
+## annot_expr -> expr COLON . type_expr [ RPAR ]
 ##
 ## The known suffix of the stack is as follows:
-## LPAR expr COLON
+## expr COLON
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
 interactive_expr: LPAR Verbatim With
 ##
-## Ends in an error in state: 576.
+## Ends in an error in state: 577.
 ##
-## par(__anonymous_1) -> LPAR expr . COLON type_expr RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
+## annot_expr -> expr . COLON type_expr [ RPAR ]
 ## par(expr) -> LPAR expr . RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
 ##
 ## The known suffix of the stack is as follows:
@@ -2439,7 +2455,7 @@ interactive_expr: LPAR With
 ##
 ## Ends in an error in state: 167.
 ##
-## par(__anonymous_1) -> LPAR . expr COLON type_expr RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
+## par(annot_expr) -> LPAR . annot_expr RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
 ## par(expr) -> LPAR . expr RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
 ## unit -> LPAR . RPAR [ With Verbatim VBAR Type True Then TIMES String SLASH SEMI RPAR RBRACKET RBRACE PLUS Or Nat NE Mutez Mod MINUS Let LT LPAR LE LBRACKET LBRACE Int In Ident GT GE False End Else EQ EOF Constr CONS COMMA COLON CAT Bytes Begin BOOL_OR BOOL_AND Attr ]
 ##
@@ -2524,7 +2540,7 @@ interactive_expr: Let Rec With
 
 interactive_expr: Let WILD EQ Bytes Attr Type
 ##
-## Ends in an error in state: 554.
+## Ends in an error in state: 555.
 ##
 ## let_expr(expr) -> Let let_binding seq(Attr) . In expr [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -2543,7 +2559,7 @@ interactive_expr: Let WILD EQ Bytes Attr Type
 
 interactive_expr: Let WILD EQ Bytes In With
 ##
-## Ends in an error in state: 555.
+## Ends in an error in state: 556.
 ##
 ## let_expr(expr) -> Let let_binding seq(Attr) In . expr [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -2555,7 +2571,7 @@ interactive_expr: Let WILD EQ Bytes In With
 
 interactive_expr: Let WILD EQ Bytes With
 ##
-## Ends in an error in state: 553.
+## Ends in an error in state: 554.
 ##
 ## let_expr(expr) -> Let let_binding . seq(Attr) In expr [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -2610,7 +2626,7 @@ interactive_expr: MINUS With
 
 interactive_expr: Match Verbatim Type
 ##
-## Ends in an error in state: 569.
+## Ends in an error in state: 570.
 ##
 ## match_expr(base_cond) -> Match expr . With option(VBAR) cases(base_cond) [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -2652,7 +2668,7 @@ interactive_expr: Match Verbatim With LPAR Bytes RPAR With
 
 interactive_expr: Match Verbatim With VBAR Begin
 ##
-## Ends in an error in state: 571.
+## Ends in an error in state: 572.
 ##
 ## match_expr(base_cond) -> Match expr With option(VBAR) . cases(base_cond) [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -2664,7 +2680,7 @@ interactive_expr: Match Verbatim With VBAR Begin
 
 interactive_expr: Match Verbatim With WILD ARROW Bytes VBAR With
 ##
-## Ends in an error in state: 575.
+## Ends in an error in state: 576.
 ##
 ## cases(base_cond) -> cases(base_cond) VBAR . case_clause(base_cond) [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -3199,7 +3215,7 @@ interactive_expr: Match Verbatim With WILD ARROW Let With
 
 interactive_expr: Match Verbatim With WILD ARROW Verbatim COMMA Bytes Else
 ##
-## Ends in an error in state: 574.
+## Ends in an error in state: 575.
 ##
 ## cases(base_cond) -> cases(base_cond) . VBAR case_clause(base_cond) [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ## match_expr(base_cond) -> Match expr With option(VBAR) cases(base_cond) . [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
@@ -3263,7 +3279,7 @@ interactive_expr: Match Verbatim With WILD ARROW Verbatim End
 
 interactive_expr: Match Verbatim With WILD ARROW With
 ##
-## Ends in an error in state: 573.
+## Ends in an error in state: 574.
 ##
 ## case_clause(base_cond) -> pattern ARROW . base_cond [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -3312,7 +3328,7 @@ interactive_expr: Match Verbatim With WILD COMMA With
 
 interactive_expr: Match Verbatim With WILD CONS Bytes SEMI
 ##
-## Ends in an error in state: 572.
+## Ends in an error in state: 573.
 ##
 ## case_clause(base_cond) -> pattern . ARROW base_cond [ With VBAR Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -3356,7 +3372,7 @@ interactive_expr: Match Verbatim With WILD With
 
 interactive_expr: Match Verbatim With With
 ##
-## Ends in an error in state: 570.
+## Ends in an error in state: 571.
 ##
 ## match_expr(base_cond) -> Match expr With . option(VBAR) cases(base_cond) [ With Type Then SEMI RPAR RBRACKET RBRACE Let In EOF COLON Attr ]
 ##
@@ -3746,7 +3762,7 @@ interactive_expr: Verbatim WILD
 
 interactive_expr: Verbatim With
 ##
-## Ends in an error in state: 596.
+## Ends in an error in state: 598.
 ##
 ## interactive_expr -> expr . EOF [ # ]
 ##
@@ -3775,7 +3791,7 @@ interactive_expr: Verbatim With
 
 interactive_expr: With
 ##
-## Ends in an error in state: 594.
+## Ends in an error in state: 596.
 ##
 ## interactive_expr' -> . interactive_expr [ # ]
 ##
@@ -4221,7 +4237,7 @@ contract: Let LPAR With
 
 contract: Let Rec WILD EQ Bytes With
 ##
-## Ends in an error in state: 583.
+## Ends in an error in state: 585.
 ##
 ## let_declaration -> Let Rec let_binding . seq(Attr) [ Type Let EOF ]
 ##
@@ -4346,7 +4362,7 @@ contract: Let WILD EQ Bytes Attr With
 
 contract: Let WILD EQ Bytes With
 ##
-## Ends in an error in state: 585.
+## Ends in an error in state: 587.
 ##
 ## let_declaration -> Let let_binding . seq(Attr) [ Type Let EOF ]
 ##
@@ -4482,7 +4498,7 @@ contract: Type Ident EQ Constr With
 
 contract: Type Ident EQ Ident VBAR
 ##
-## Ends in an error in state: 591.
+## Ends in an error in state: 593.
 ##
 ## declarations -> declaration . [ EOF ]
 ## declarations -> declaration . declarations [ EOF ]
@@ -4498,7 +4514,7 @@ contract: Type Ident EQ Ident VBAR
 ## In state 36, spurious reduction of production fun_type -> cartesian 
 ## In state 27, spurious reduction of production type_expr -> fun_type 
 ## In state 61, spurious reduction of production type_decl -> Type Ident EQ type_expr 
-## In state 587, spurious reduction of production declaration -> type_decl 
+## In state 589, spurious reduction of production declaration -> type_decl 
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>

src/passes/01-parser/pascaligo.ml

@@ -19,7 +19,8 @@ module SubIO =
       ext     : string;   (* ".ligo" *)
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -34,6 +35,7 @@ module SubIO =
            method mode    = `Point
            method cmd     = EvalOpt.Quiet
            method mono    = false
+           method pretty  = false
          end
 
     let make =
@@ -46,6 +48,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =

src/passes/01-parser/pascaligo/.links

@@ -21,5 +21,3 @@ $HOME/git/OCaml-build/Makefile
 ../shared/ParserUnit.mli
 ../shared/ParserUnit.ml
 ../shared/LexerLib.ml
-
-$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml

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

@@ -109,6 +109,7 @@ type eof = Region.t
 type variable    = string reg
 type fun_name    = string reg
 type type_name   = string reg
+type type_constr = string reg
 type field_name  = string reg
 type map_name    = string reg
 type set_name    = string reg
@@ -181,11 +182,11 @@ and type_expr =
   TProd   of cartesian
 | TSum    of (variant reg, vbar) nsepseq reg
 | TRecord of field_decl reg ne_injection reg
-| TApp    of (type_name * type_tuple) reg
+| TApp    of (type_constr * type_tuple) reg
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
 | TVar    of variable
-| TStringLiteral of Lexer.lexeme reg
+| TString of Lexer.lexeme reg
 
 and cartesian = (type_expr, times) nsepseq reg
 
@@ -205,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;
@@ -249,19 +249,14 @@ and param_var = {
 }
 
 and block = {
-  opening    : block_opening;
+  enclosing  : block_enclosing;
   statements : statements;
-  terminator : semi option;
+  terminator : semi option
-  closing    : block_closing
 }
 
-and block_opening =
+and block_enclosing =
-  Block of kwd_block * lbrace
+  Block    of kwd_block * lbrace * rbrace
-| Begin of kwd_begin
+| BeginEnd of kwd_begin * kwd_end
-
-and block_closing =
-  Block of rbrace
-| End   of kwd_end
 
 and statements = (statement, semi) nsepseq
 
@@ -378,10 +373,10 @@ and set_membership = {
 and 'a case = {
   kwd_case  : kwd_case;
   expr      : expr;
-  opening   : opening;
+  kwd_of    : kwd_of;
+  enclosing : enclosing;
   lead_vbar : vbar option;
-  cases     : ('a case_clause reg, vbar) nsepseq reg;
+  cases     : ('a case_clause reg, vbar) nsepseq reg
-  closing   : closing
 }
 
 and 'a case_clause = {
@@ -421,8 +416,7 @@ and for_int = {
   assign  : var_assign reg;
   kwd_to  : kwd_to;
   bound   : expr;
-  kwd_step : kwd_step option;
+  step    : (kwd_step * expr) option;
-  step     : expr option;
   block   : block reg
 }
 
@@ -452,7 +446,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
@@ -471,34 +465,12 @@ 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
 | SetMem of set_membership reg
 
-and 'a injection = {
-  opening    : opening;
-  elements   : ('a, semi) sepseq;
-  terminator : semi option;
-  closing    : closing
-}
-
-and 'a ne_injection = {
-  opening     : opening;
-  ne_elements : ('a, semi) nsepseq;
-  terminator  : semi option;
-  closing     : closing
-}
-
-and opening =
-  Kwd        of keyword
-| KwdBracket of keyword * lbracket
-
-and closing =
-  End       of kwd_end
-| RBracket  of rbracket
-
 and map_expr =
   MapLookUp of map_lookup reg
 | MapInj    of binding reg injection reg
@@ -569,13 +541,13 @@ and constr_expr =
 | NoneExpr  of c_None
 | ConstrApp of (constr * arguments option) reg
 
-and field_assign = {
+and field_assignment = {
   field_name : field_name;
-  equal      : equal;
+  assignment : equal;
   field_expr : expr
 }
 
-and record = field_assign reg ne_injection
+and record = field_assignment reg ne_injection
 
 and projection = {
   struct_name : variable;
@@ -586,12 +558,12 @@ and projection = {
 and update = {
   record   : path;
   kwd_with : kwd_with;
-  updates : field_path_assign reg ne_injection reg
+  updates  : field_path_assignment reg ne_injection reg
 }
 
-and field_path_assign = {
+and field_path_assignment = {
-  field_path  : (selection, dot) nsepseq;
+  field_path : path;
-  equal : equal;
+  assignment : equal;
   field_expr : expr
 }
 
@@ -605,6 +577,38 @@ and fun_call = (expr * arguments) reg
 
 and arguments = tuple_expr
 
+(* Injections *)
+
+and 'a injection = {
+  kind       : injection_kwd;
+  enclosing  : enclosing;
+  elements   : ('a, semi) sepseq;
+  terminator : semi option
+}
+
+and injection_kwd =
+  InjSet    of keyword
+| InjMap    of keyword
+| InjBigMap of keyword
+| InjList   of keyword
+
+and enclosing =
+  Brackets of lbracket * rbracket
+| End      of kwd_end
+
+and 'a ne_injection = {
+  kind        : ne_injection_kwd;
+  enclosing   : enclosing;
+  ne_elements : ('a, semi) nsepseq;
+  terminator  : semi option
+}
+
+and ne_injection_kwd =
+  NEInjAttr   of keyword
+| NEInjSet    of keyword
+| NEInjMap    of keyword
+| NEInjRecord of keyword
+
 (* Patterns *)
 
 and pattern =
@@ -635,7 +639,7 @@ and list_pattern =
 | PCons     of (pattern, cons) nsepseq reg
 
 
-(* Projecting regions *)
+(* PROJECTING REGIONS *)
 
 let rec last to_region = function
     [] -> Region.ghost
@@ -660,7 +664,7 @@ let type_expr_to_region = function
 | TApp    {region; _}
 | TFun    {region; _}
 | TPar    {region; _}
-| TStringLiteral {region; _}
+| TString {region; _}
 | TVar    {region; _} -> region
 
 let rec expr_to_region = function

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

@@ -122,7 +122,8 @@ attr_decl:
   open_attr_decl ";"? { $1 }
 
 open_attr_decl:
-  ne_injection("attributes","<string>") { $1 }
+  ne_injection("attributes","<string>") {
+    $1 (fun region -> NEInjAttr region) }
 
 (* Type declarations *)
 
@@ -161,7 +162,7 @@ cartesian:
 
 core_type:
   type_name      { TVar    $1 }
-| "<string>"     { TStringLiteral $1 }
+| "<string>"     { TString $1 }
 | par(type_expr) { TPar    $1 }
 | type_name type_tuple {
     let region = cover $1.region $2.region
@@ -214,19 +215,19 @@ record_type:
     let () = Utils.nsepseq_to_list ne_elements
              |> Scoping.check_fields in
     let region = cover $1 $3
-    and value  = {opening = Kwd $1;
+    and value  = {kind      = NEInjRecord $1;
+                  enclosing = End $3;
                   ne_elements;
-                  terminator;
+                  terminator}
-                  closing = End $3}
     in TRecord {region; value}
   }
 | "record" "[" sep_or_term_list(field_decl,";") "]" {
    let ne_elements, terminator = $3 in
    let region = cover $1 $4
-   and value  = {opening = KwdBracket ($1,$2);
+   and value  = {kind      = NEInjRecord $1;
+                 enclosing = Brackets ($2,$4);
                  ne_elements;
-                 terminator;
+                 terminator}
-                 closing = RBracket $4}
    in TRecord {region; value} }
 
 field_decl:
@@ -238,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 *)
@@ -271,7 +271,8 @@ open_fun_decl:
                   attributes   = None}
     in {region; value}
   }
-| ioption ("recursive") "function" fun_name parameters ":" type_expr "is" expr {
+| ioption ("recursive") "function" fun_name parameters ":" type_expr "is"
+  expr {
     Scoping.check_reserved_name $3;
     let stop   = expr_to_region $8 in
     let region = cover $2 stop
@@ -326,19 +327,17 @@ block:
   "begin" sep_or_term_list(statement,";") "end" {
      let statements, terminator = $2 in
      let region = cover $1 $3
-     and value  = {opening = Begin $1;
+     and value  = {enclosing = BeginEnd ($1,$3);
                    statements;
-                   terminator;
+                   terminator}
-                   closing = End $3}
      in {region; value}
   }
 | "block" "{" sep_or_term_list(statement,";") "}" {
      let statements, terminator = $3 in
      let region = cover $1 $4
-     and value  = {opening = Block ($1,$2);
+     and value  = {enclosing = Block ($1,$2,$4);
                    statements;
-                   terminator;
+                   terminator}
-                   closing = Block $4}
      in {region; value} }
 
 statement:
@@ -404,8 +403,7 @@ instruction:
 set_remove:
   "remove" expr "from" "set" path {
     let region = cover $1 (path_to_region $5) in
-    let value  = {
+    let value  = {kwd_remove = $1;
-      kwd_remove = $1;
                   element    = $2;
                   kwd_from   = $3;
                   kwd_set    = $4;
@@ -415,8 +413,7 @@ set_remove:
 map_remove:
   "remove" expr "from" "map" path {
     let region = cover $1 (path_to_region $5) in
-    let value  = {
+    let value  = {kwd_remove = $1;
-      kwd_remove = $1;
                   key        = $2;
                   kwd_from   = $3;
                   kwd_map    = $4;
@@ -425,82 +422,83 @@ map_remove:
 
 set_patch:
   "patch" path "with" ne_injection("set",expr) {
-    let region = cover $1 $4.region in
+    let set_inj = $4 (fun region -> NEInjSet region) in
-    let value  = {
+    let region = cover $1 set_inj.region in
-      kwd_patch = $1;
+    let value  = {kwd_patch = $1;
                   path      = $2;
                   kwd_with  = $3;
-      set_inj   = $4}
+                  set_inj}
     in {region; value} }
 
 map_patch:
   "patch" path "with" ne_injection("map",binding) {
-    let region = cover $1 $4.region in
+    let map_inj = $4 (fun region -> NEInjMap region) in
-    let value  = {
+    let region  = cover $1 map_inj.region in
-      kwd_patch = $1;
+    let value   = {kwd_patch = $1;
                    path      = $2;
                    kwd_with  = $3;
-      map_inj   = $4}
+                   map_inj}
     in {region; value} }
 
 injection(Kind,element):
   Kind sep_or_term_list(element,";") "end" {
+    fun mk_kwd ->
       let elements, terminator = $2 in
       let region = cover $1 $3
       and value  = {
-      opening  = Kwd $1;
+        kind      = mk_kwd $1;
+        enclosing = End $3;
         elements  = Some elements;
-      terminator;
+        terminator}
-      closing = End $3}
       in {region; value}
   }
 | Kind "end" {
+    fun mk_kwd ->
       let region = cover $1 $2
-    and value = {
+      and value  = {kind       = mk_kwd $1;
-      opening    = Kwd $1;
+                    enclosing  = End $2;
                     elements   = None;
-      terminator = None;
+                    terminator = None}
-      closing    = End $2}
       in {region; value}
   }
 | Kind "[" sep_or_term_list(element,";") "]" {
+    fun mk_kwd ->
       let elements, terminator = $3 in
       let region = cover $1 $4
-    and value = {
+      and value  = {kind      = mk_kwd $1;
-      opening  = KwdBracket ($1,$2);
+                    enclosing = Brackets ($2,$4);
                     elements  = Some elements;
-      terminator;
+                    terminator}
-      closing = RBracket $4}
       in {region; value}
   }
 | Kind "[" "]" {
+    fun mk_kwd ->
       let region = cover $1 $3
-    and value = {
+      and value  = {kind       = mk_kwd $1;
-      opening    = KwdBracket ($1,$2);
+                    enclosing  = Brackets ($2,$3);
                     elements   = None;
-      terminator = None;
+                    terminator = None}
-      closing    = RBracket $3}
       in {region; value} }
 
 ne_injection(Kind,element):
   Kind sep_or_term_list(element,";") "end" {
+    fun mk_kwd ->
       let ne_elements, terminator = $2 in
       let region = cover $1 $3
-    and value = {
+      and value  = {kind      = mk_kwd $1;
-      opening  = Kwd $1;
+                    enclosing = End $3;
                     ne_elements;
-      terminator;
+                    terminator}
-      closing = End $3}
       in {region; value}
   }
 | Kind "[" sep_or_term_list(element,";") "]" {
+    fun mk_kwd ->
       let ne_elements, terminator = $3 in
       let region = cover $1 $4
-    and value = {
+      and value = {kind      = mk_kwd $1;
-      opening  = KwdBracket ($1,$2);
+                   enclosing = Brackets ($2,$4);
                    ne_elements;
-      terminator;
+                   terminator}
-      closing = RBracket $4}
       in {region; value} }
 
 binding:
@@ -508,20 +506,19 @@ binding:
     let start  = expr_to_region $1
     and stop   = expr_to_region $3 in
     let region = cover start stop
-    and value  = {
+    and value  = {source = $1;
-      source = $1;
                   arrow  = $2;
                   image  = $3}
     in {region; value} }
 
 record_patch:
   "patch" path "with" ne_injection("record",field_assignment) {
-    let region = cover $1 $4.region in
+    let record_inj = $4 (fun region -> NEInjRecord region) in
-    let value  = {
+    let region = cover $1 record_inj.region in
-      kwd_patch  = $1;
+    let value  = {kwd_patch = $1;
                   path      = $2;
                   kwd_with  = $3;
-      record_inj = $4}
+                  record_inj}
     in {region; value} }
 
 proc_call:
@@ -547,12 +544,9 @@ if_clause:
 clause_block:
   block { LongBlock $1 }
 | "{" sep_or_term_list(statement,";") "}" {
-    let statements, terminator = $2 in
     let region = cover $1 $3 in
-    let value  = {lbrace = $1;
+    let value  = {lbrace=$1; inside=$2; rbrace=$3}
-                  inside = statements, terminator;
+    in ShortBlock {value; region} }
-                  rbrace = $3} in
-    ShortBlock {value; region} }
 
 case_instr:
   case(if_clause) { $1 if_clause_to_region }
@@ -563,10 +557,10 @@ case(rhs):
       let region = cover $1 $6 in
       let value  = {kwd_case  = $1;
                     expr      = $2;
-                    opening   = Kwd $3;
+                    kwd_of    = $3;
+                    enclosing = End $6;
                     lead_vbar = $4;
-                    cases     = $5 rhs_to_region;
+                    cases     = $5 rhs_to_region}
-                    closing   = End $6}
       in {region; value}
   }
 | "case" expr "of" "[" "|"? cases(rhs) "]" {
@@ -574,10 +568,10 @@ case(rhs):
       let region = cover $1 $7 in
       let value  = {kwd_case  = $1;
                     expr      = $2;
-                    opening   = KwdBracket ($3,$4);
+                    kwd_of    = $3;
+                    enclosing = Brackets ($4,$7);
                     lead_vbar = $5;
-                    cases     = $6 rhs_to_region;
+                    cases     = $6 rhs_to_region}
-                    closing   = RBracket $7}
       in {region; value} }
 
 cases(rhs):
@@ -628,7 +622,6 @@ for_loop:
                   assign   = $2;
                   kwd_to   = $3;
                   bound    = $4;
-                  kwd_step = None;
                   step     = None;
                   block    = $5}
     in For (ForInt {region; value})
@@ -639,8 +632,7 @@ for_loop:
                   assign   = $2;
                   kwd_to   = $3;
                   bound    = $4;
-                  kwd_step = Some $5;
+                  step     = Some ($5, $6);
-                  step     = Some $6;
                   block    = $7}
     in For (ForInt {region; value})
   }
@@ -854,7 +846,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)        }
@@ -896,20 +888,20 @@ 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 }
+  injection("set",expr) { SetInj ($1 (fun region -> InjSet region)) }
 
 map_expr:
-  map_lookup                   { MapLookUp $1 }
+  map_lookup {
-| injection("map",binding)     {    MapInj $1 }
+    MapLookUp $1
-| injection("big_map",binding) { BigMapInj $1 }
+  }
+| injection("map",binding) {
+    MapInj ($1 (fun region -> InjMap region))
+  }
+| injection("big_map",binding) {
+    BigMapInj ($1 (fun region -> InjBigMap region)) }
 
 map_lookup:
   path brackets(expr) {
@@ -957,41 +949,40 @@ record_expr:
   "record" sep_or_term_list(field_assignment,";") "end" {
     let ne_elements, terminator = $2 in
     let region = cover $1 $3
-    and value : field_assign AST.reg ne_injection = {
+    and value : field_assignment AST.reg ne_injection = {
-      opening = Kwd $1;
+      kind      = NEInjRecord $1;
+      enclosing = End $3;
       ne_elements;
-      terminator;
+      terminator}
-      closing = End $3}
     in {region; value}
   }
 | "record" "[" sep_or_term_list(field_assignment,";") "]" {
     let ne_elements, terminator = $3 in
     let region = cover $1 $4
-   and value : field_assign AST.reg ne_injection = {
+    and value : field_assignment AST.reg ne_injection = {
-     opening = KwdBracket ($1,$2);
+      kind      = NEInjRecord $1;
+      enclosing = Brackets ($2,$4);
       ne_elements;
-     terminator;
+      terminator}
-     closing = RBracket $4}
     in {region; value} }
 
 update_record:
   path "with" ne_injection("record",field_path_assignment) {
-    let region = cover (path_to_region $1) $3.region in
+    let updates = $3 (fun region -> NEInjRecord region) in
-    let value  = {record=$1; kwd_with=$2; updates=$3}
+    let region  = cover (path_to_region $1) updates.region in
+    let value   = {record=$1; kwd_with=$2; updates}
     in {region; value} }
 
 field_assignment:
   field_name "=" expr {
     let region = cover $1.region (expr_to_region $3)
-    and value  = {field_name=$1; equal=$2; field_expr=$3}
+    and value  = {field_name=$1; assignment=$2; field_expr=$3}
     in {region; value} }
 
 field_path_assignment:
-  nsepseq(selection,".") "=" expr {
+  path "=" expr {
-    let start  = nsepseq_to_region selection_to_region $1
+    let region = cover (path_to_region $1) (expr_to_region $3)
-    and stop   = expr_to_region $3 in
+    and value  = {field_path=$1; assignment=$2; field_expr=$3}
-    let region = cover start stop
-    and value  = {field_path=$1; equal=$2; field_expr=$3}
     in {region; value} }
 
 fun_call:
@@ -1010,7 +1001,7 @@ arguments:
   par(nsepseq(expr,",")) { $1 }
 
 list_expr:
-  injection("list",expr) { EListComp $1 }
+  injection("list",expr) { EListComp ($1 (fun region -> InjList region)) }
 | "nil"                  { ENil $1                                     }
 
 (* Patterns *)
@@ -1034,9 +1025,10 @@ core_pattern:
 | constr_pattern           { PConstr $1 }
 
 list_pattern:
-  injection("list",core_pattern) { PListComp $1 }
+  "nil"                          {      PNil $1 }
-| "nil"                          {      PNil $1 }
 | par(cons_pattern)              {  PParCons $1 }
+| injection("list",core_pattern) {
+    PListComp ($1 (fun region -> InjList region)) }
 
 cons_pattern:
   core_pattern "#" pattern { $1,$2,$3 }

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

@@ -27,7 +27,7 @@ let mk_state ~offsets ~mode ~buffer =
     val pad_node    = ""
     method pad_node = pad_node
 
-    (** The method [pad] updates the current padding, which is
+    (* The method [pad] updates the current padding, which is
        comprised of two components: the padding to reach the new node
        (space before reaching a subtree, then a vertical bar for it)
        and the padding for the new node itself (Is it the last child
@@ -44,7 +44,7 @@ let mk_state ~offsets ~mode ~buffer =
 let compact state (region: Region.t) =
   region#compact ~offsets:state#offsets state#mode
 
-(** {1 Printing the tokens with their source regions} *)
+(* Printing the tokens with their source regions *)
 
 let print_nsepseq :
   state -> string -> (state -> 'a -> unit) ->
@@ -117,7 +117,7 @@ let rec print_tokens state ast =
   print_token state eof "EOF"
 
 and print_attr_decl state =
-  print_ne_injection state "attributes" print_string
+  print_ne_injection state print_string
 
 and print_decl state = function
   TypeDecl  decl -> print_type_decl  state decl
@@ -153,7 +153,7 @@ and print_type_expr state = function
 | TFun    type_fun    -> print_type_fun    state type_fun
 | TPar    par_type    -> print_par_type    state par_type
 | TVar    type_var    -> print_var         state type_var
-| TStringLiteral s -> print_string state s
+| TString str         -> print_string      state str
 
 and print_cartesian state {value; _} =
   print_nsepseq state "*" print_type_expr value
@@ -170,8 +170,8 @@ and print_variant state ({value; _}: variant reg) =
 and print_sum_type state {value; _} =
   print_nsepseq state "|" print_variant value
 
-and print_record_type state record_type =
+and print_record_type state =
-  print_ne_injection state "record" print_field_decl record_type
+  print_ne_injection state print_field_decl
 
 and print_type_app state {value; _} =
   let type_name, type_tuple = value in
@@ -221,9 +221,8 @@ 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_parameters state param;
   print_token      state colon ":";
@@ -256,22 +255,19 @@ and print_param_var state {value; _} =
   print_type_expr state param_type
 
 and print_block state block =
-  let {opening; statements; terminator; closing} = block.value in
+  let {enclosing; statements; terminator} = block.value in
-  print_block_opening state opening;
+  match enclosing with
+    Block (kwd_block, lbrace, rbrace) ->
+      print_token      state kwd_block "block";
+      print_token      state lbrace "{";
       print_statements state statements;
       print_terminator state terminator;
-  print_block_closing state closing
+      print_token      state rbrace "}"
-
+  | BeginEnd (kwd_begin, kwd_end) ->
-and print_block_opening state = function
+      print_token      state kwd_begin "begin";
-  Block (kwd_block, lbrace) ->
+      print_statements state statements;
-    print_token state kwd_block "block";
+      print_terminator state terminator;
-    print_token state lbrace    "{"
+      print_token      state kwd_end "end"
-| Begin kwd_begin ->
-    print_token state kwd_begin "begin"
-
-and print_block_closing state = function
-  Block rbrace -> print_token state rbrace  "}"
-| End kwd_end  -> print_token state kwd_end "end"
 
 and print_data_decl state = function
   LocalConst decl -> print_const_decl state decl
@@ -344,14 +340,20 @@ and print_clause_block state = function
     print_token      state rbrace "}"
 
 and print_case_instr state (node : if_clause case) =
-  let {kwd_case; expr; opening;
+  let {kwd_case; expr; kwd_of; enclosing; lead_vbar; cases} = node in
-       lead_vbar; cases; closing} = node in
   print_token       state kwd_case "case";
   print_expr        state expr;
-  print_opening     state "of" opening;
+  print_token       state kwd_of "of";
+  match enclosing with
+    Brackets (lbracket, rbracket) ->
+      print_token       state lbracket "[";
       print_token_opt   state lead_vbar "|";
       print_cases_instr state cases;
-  print_closing     state closing
+      print_token       state rbracket "]"
+  | End kwd_end ->
+      print_token_opt   state lead_vbar "|";
+      print_cases_instr state cases;
+      print_token       state kwd_end "end"
 
 and print_token_opt state = function
          None -> fun _ -> ()
@@ -393,19 +395,16 @@ and print_for_loop state = function
 | ForCollect for_collect -> print_for_collect state for_collect
 
 and print_for_int state ({value; _} : for_int reg) =
-  let {kwd_for; assign; kwd_to; bound; kwd_step; step; block} = value in
+  let {kwd_for; assign; kwd_to; bound; step; block} = value in
   print_token      state kwd_for "for";
   print_var_assign state assign;
   print_token      state kwd_to "to";
   print_expr       state bound;
-  match kwd_step with 
+  (match step with
-  | None -> ();
+     None -> ();
-  | Some kwd_step -> 
+   | Some (kwd_step, expr) ->
        print_token  state kwd_step "step";
-  match step with
+       print_expr   state expr);
-  | None -> ();
-  | Some step ->
-  print_expr       state step;
   print_block      state block
 
 and print_var_assign state {value; _} =
@@ -461,19 +460,27 @@ 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
 
 and print_case_expr state (node : expr case) =
-  let {kwd_case; expr; opening;
+  let {kwd_case; expr; kwd_of; enclosing; lead_vbar; cases} = node in
-       lead_vbar; cases; closing} = node in
   print_token      state kwd_case "case";
   print_expr       state expr;
-  print_opening    state "of" opening;
+  print_token       state kwd_of "of";
+  match enclosing with
+    Brackets (lbracket, rbracket) ->
+      print_token      state lbracket "[";
       print_token_opt  state lead_vbar "|";
       print_cases_expr state cases;
-  print_closing    state closing
+      print_token      state rbracket "]"
+  | End kwd_end ->
+      print_token_opt  state lead_vbar "|";
+      print_cases_expr state cases;
+      print_token      state kwd_end "end"
 
 and print_cases_expr state {value; _} =
   print_nsepseq state "|" print_case_clause_expr value
@@ -486,11 +493,11 @@ and print_case_clause_expr state {value; _} =
 
 and print_map_expr state = function
   MapLookUp {value; _} -> print_map_lookup state value
-| MapInj inj           -> print_injection  state "map" print_binding inj
+| MapInj inj           -> print_injection  state print_binding inj
-| BigMapInj inj        -> print_injection  state "big_map" print_binding inj
+| BigMapInj inj        -> print_injection  state print_binding inj
 
 and print_set_expr state = function
-  SetInj inj -> print_injection state "set" print_expr inj
+  SetInj inj -> print_injection state print_expr inj
 | SetMem mem -> print_set_membership state mem
 
 and print_set_membership state {value; _} =
@@ -600,7 +607,7 @@ and print_list_expr state = function
     print_expr  state arg1;
     print_token state op "#";
     print_expr  state arg2
-| EListComp e -> print_injection state "list" print_expr e
+| EListComp e -> print_injection state print_expr e
 | ENil e -> print_nil state e
 
 and print_constr_expr state = function
@@ -608,27 +615,26 @@ and print_constr_expr state = function
 | NoneExpr e  -> print_none_expr  state e
 | ConstrApp e -> print_constr_app state e
 
-and print_record_expr state e =
+and print_record_expr state =
-  print_ne_injection state "record" print_field_assign e
+  print_ne_injection state print_field_assignment
 
-and print_field_assign state {value; _} =
+and print_field_assignment state {value; _} =
-  let {field_name; equal; field_expr} = value in
+  let {field_name; assignment; field_expr} = value in
   print_var   state field_name;
-  print_token state equal "=";
+  print_token state assignment "=";
   print_expr  state field_expr
 
-and print_field_path_assign state {value; _} =
+and print_field_path_assignment state {value; _} =
-  let {field_path; equal; field_expr} = value in
+  let {field_path; assignment; field_expr} = value in
-  print_nsepseq state "field_path" print_selection field_path;
+  print_path  state field_path;
-  print_token state equal "=";
+  print_token state assignment "=";
   print_expr  state field_expr
 
 and print_update_expr state {value; _} =
   let {record; kwd_with; updates} = value in
   print_path state record;
   print_token state kwd_with "with";
-  print_ne_injection state "updates field" print_field_path_assign updates
+  print_ne_injection state print_field_path_assignment updates
-
 
 and print_projection state {value; _} =
   let {struct_name; selector; field_path} = value in
@@ -648,21 +654,21 @@ and print_record_patch state node =
   print_token        state kwd_patch "patch";
   print_path         state path;
   print_token        state kwd_with "with";
-  print_ne_injection state "record" print_field_assign record_inj
+  print_ne_injection state print_field_assignment record_inj
 
 and print_set_patch state node =
   let {kwd_patch; path; kwd_with; set_inj} = node in
   print_token        state kwd_patch "patch";
   print_path         state path;
   print_token        state kwd_with "with";
-  print_ne_injection state "set" print_expr set_inj
+  print_ne_injection state print_expr set_inj
 
 and print_map_patch state node =
   let {kwd_patch; path; kwd_with; map_inj} = node in
   print_token        state kwd_patch "patch";
   print_path         state path;
   print_token        state kwd_with "with";
-  print_ne_injection state "map" print_binding map_inj
+  print_ne_injection state print_binding map_inj
 
 and print_map_remove state node =
   let {kwd_remove; key; kwd_from; kwd_map; map} = node in
@@ -681,35 +687,48 @@ and print_set_remove state node =
   print_path  state set
 
 and print_injection :
-  'a.state -> string -> (state -> 'a -> unit) ->
+  'a.state -> (state -> 'a -> unit) -> 'a injection reg -> unit =
-  'a injection reg -> unit =
+  fun state print {value; _} ->
-  fun state kwd print {value; _} ->
+    let {kind; enclosing; elements; terminator} = value in
-    let {opening; elements; terminator; closing} = value in
+    print_injection_kwd state kind;
-    print_opening    state kwd opening;
+    match enclosing with
+      Brackets (lbracket, rbracket) ->
+        print_token      state lbracket "[";
         print_sepseq     state ";" print elements;
         print_terminator state terminator;
-    print_closing    state closing
+        print_token      state rbracket "]"
+    | End kwd_end ->
+        print_sepseq     state ";" print elements;
+        print_terminator state terminator;
+        print_token      state kwd_end "end"
+
+and print_injection_kwd state = function
+  InjSet    kwd_set     -> print_token state kwd_set "set"
+| InjMap    kwd_map     -> print_token state kwd_map "map"
+| InjBigMap kwd_big_map -> print_token state kwd_big_map "big_map"
+| InjList   kwd_list    -> print_token state kwd_list "list"
 
 and print_ne_injection :
-  'a.state -> string -> (state -> 'a -> unit) ->
+  'a.state -> (state -> 'a -> unit) -> 'a ne_injection reg -> unit =
-  'a ne_injection reg -> unit =
+  fun state print {value; _} ->
-  fun state kwd print {value; _} ->
+    let {kind; enclosing; ne_elements; terminator} = value in
-    let {opening; ne_elements; terminator; closing} = value in
+    print_ne_injection_kwd state kind;
-    print_opening    state kwd opening;
+    match enclosing with
+      Brackets (lbracket, rbracket) ->
+        print_token      state lbracket "[";
         print_nsepseq     state ";" print ne_elements;
         print_terminator state terminator;
-    print_closing    state closing
+        print_token      state rbracket "]"
+    | End kwd_end ->
+        print_nsepseq     state ";" print ne_elements;
+        print_terminator state terminator;
+        print_token      state kwd_end "end"
 
-and print_opening state lexeme = function
+and print_ne_injection_kwd state = function
-  Kwd kwd ->
+  NEInjAttr   kwd_attributes -> print_token state kwd_attributes "attributes"
-    print_token state kwd lexeme
+| NEInjSet    kwd_set        -> print_token state kwd_set "set"
-| KwdBracket (kwd, lbracket) ->
+| NEInjMap    kwd_map        -> print_token state kwd_map "map"
-    print_token state kwd lexeme;
+| NEInjRecord kwd_record     -> print_token state kwd_record "record"
-    print_token state lbracket "["
-
-and print_closing state = function
-  RBracket rbracket -> print_token state rbracket "]"
-| End kwd_end       -> print_token state kwd_end "end"
 
 and print_binding state {value; _} =
   let {source; arrow; image} = value in
@@ -787,7 +806,7 @@ and print_patterns state {value; _} =
 
 and print_list_pattern state = function
   PListComp comp ->
-   print_injection state "list" print_pattern comp
+   print_injection state print_pattern comp
 | PNil kwd_nil ->
     print_token state kwd_nil "nil"
 | PParCons cons ->
@@ -831,7 +850,7 @@ let pattern_to_string ~offsets ~mode =
 let instruction_to_string ~offsets ~mode =
   to_string ~offsets ~mode print_instruction
 
-(** {1 Pretty-printing the AST} *)
+(* Pretty-printing the AST *)
 
 let pp_ident state {value=name; region} =
   let reg  = compact state region in
@@ -842,12 +861,20 @@ let pp_node state name =
   let node = sprintf "%s%s\n" state#pad_path name
   in Buffer.add_string state#buffer node
 
-let pp_string state = pp_ident state
+let pp_string state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s%S (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
+
+let pp_verbatim state {value=name; region} =
+  let reg  = compact state region in
+  let node = sprintf "%s{|%s|} (%s)\n" state#pad_path name reg
+  in Buffer.add_string state#buffer node
 
 let pp_loc_node state name region =
   pp_ident state {value=name; region}
 
-let rec pp_ast state {decl; _} =
+let rec pp_cst state {decl; _} =
   let apply len rank =
     pp_declaration (state#pad len rank) in
   let decls = Utils.nseq_to_list decl in
@@ -943,8 +970,8 @@ and pp_type_expr state = function
                     field_decl.value in
     let fields = Utils.nsepseq_to_list value.ne_elements in
     List.iteri (List.length fields |> apply) fields
-| TStringLiteral s ->
+| TString s ->
-  pp_node   state "String";
+    pp_node   state "TString";
     pp_string (state#pad 1 0) s
 
 and pp_cartesian state {value; _} =
@@ -1244,8 +1271,8 @@ and pp_projection state proj =
   List.iteri (apply len) selections
 
 and pp_update state update =
-  pp_path state update.record;
+  pp_path (state#pad 2 0) update.record;
-  pp_ne_injection pp_field_path_assign state update.updates.value
+  pp_ne_injection pp_field_path_assignment state update.updates.value
 
 and pp_selection state = function
   FieldName name ->
@@ -1285,17 +1312,27 @@ and pp_for_loop state = function
     pp_for_collect state value
 
 and pp_for_int state for_int =
+  let {assign; bound; step; block; _} = for_int in
+  let arity =
+    match step with None -> 3 | Some _ -> 4 in
   let () =
-    let state = state#pad 3 0 in
+    let state = state#pad arity 0 in
     pp_node state "<init>";
-    pp_var_assign state for_int.assign.value in
+    pp_var_assign state assign.value in
   let () =
-    let state = state#pad 3 1 in
+    let state = state#pad arity 1 in
     pp_node state "<bound>";
-    pp_expr (state#pad 1 0) for_int.bound in
+    pp_expr (state#pad 1 0) bound in
   let () =
-    let state = state#pad 3 2 in
+    match step with
-    let statements = for_int.block.value.statements in
+      None -> ()
+    | Some (_, expr) ->
+        let state = state#pad arity 2 in
+        pp_node state "<step>";
+        pp_expr (state#pad 1 0) expr in
+  let () =
+    let state = state#pad arity (arity-1) in
+    let statements = block.value.statements in
     pp_node state "<statements>";
     pp_statements state statements
   in ()
@@ -1343,18 +1380,18 @@ and pp_fun_call state (expr, args) =
 
 and pp_record_patch state patch =
   pp_path (state#pad 2 0) patch.path;
-  pp_ne_injection pp_field_assign state patch.record_inj.value
+  pp_ne_injection pp_field_assignment state patch.record_inj.value
 
-and pp_field_assign state {value; _} =
+and pp_field_assignment state {value; _} =
   pp_node  state "<field assignment>";
   pp_ident (state#pad 2 0) value.field_name;
   pp_expr  (state#pad 2 1) value.field_expr
 
-and pp_field_path_assign state {value; _} =
+and pp_field_path_assignment state {value; _} =
-  pp_node  state "<field path for update>";
+  let {field_path; field_expr; _} = value in
-  let path = Utils.nsepseq_to_list value.field_path in
+  pp_node state "<update>";
-  List.iter (pp_selection (state#pad 2 0)) path;
+  pp_path (state#pad 2 0) field_path;
-  pp_expr  (state#pad 2 1) value.field_expr
+  pp_expr (state#pad 2 1) field_expr
 
 and pp_map_patch state patch =
   pp_path (state#pad 2 0) patch.path;
@@ -1403,7 +1440,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
@@ -1424,7 +1461,7 @@ and pp_expr state = function
     pp_constr_expr (state#pad 1 0) e_constr
 | ERecord {value; region} ->
     pp_loc_node state "ERecord" region;
-    pp_ne_injection pp_field_assign state value
+    pp_ne_injection pp_field_assignment state value
 | EProj {value; region} ->
     pp_loc_node state "EProj" region;
     pp_projection state value
@@ -1576,9 +1613,9 @@ and pp_string_expr state = function
     pp_string (state#pad 1 0) s
 | Verbatim v ->
     pp_node   state "Verbatim";
-    pp_string (state#pad 1 0) v
+    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/ParserLog.mli

@@ -33,5 +33,5 @@ val instruction_to_string :
 
 (** {1 Pretty-printing of AST nodes} *)
 
-val pp_ast  : state -> AST.t -> unit
+val pp_cst  : state -> AST.t -> unit
 val pp_expr : state -> AST.expr -> unit

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

@@ -22,7 +22,8 @@ module SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -36,6 +37,7 @@ module SubIO =
         method mode    = IO.options#mode
         method cmd     = IO.options#cmd
         method mono    = IO.options#mono
+        method pretty  = IO.options#pretty
       end
 
     let make =
@@ -48,6 +50,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -67,14 +70,28 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 
 let wrap = function
-  Stdlib.Ok _ -> flush_all ()
+  Stdlib.Ok ast ->
+    if IO.options#pretty then
+      begin
+        let doc = Pretty.print ast in
+        let width =
+          match Terminal_size.get_columns () with
+            None -> 60
+          | Some c -> c in
+        PPrint.ToChannel.pretty 1.0 width stdout doc;
+        print_newline ()
+      end;
+    flush_all ()
 | Error msg ->
-    (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
+    begin
+      flush_all ();
+      Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value
+    end
 
 let () =
   match IO.options#input with

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

@@ -0,0 +1,632 @@
+[@@@warning "-42"]
+[@@@warning "-27"]
+[@@@warning "-26"]
+
+open AST
+module Region = Simple_utils.Region
+open! Region
+open! PPrint
+
+let pp_par : ('a -> document) -> 'a par reg -> document =
+  fun printer {value; _} ->
+    string "(" ^^ nest 1 (printer value.inside ^^ string ")")
+
+let pp_brackets : ('a -> document) -> 'a brackets reg -> document =
+  fun printer {value; _} ->
+    string "[" ^^ nest 1 (printer value.inside ^^ string "]")
+
+let pp_braces : ('a -> document) -> 'a braces reg -> document =
+  fun printer {value; _} ->
+    string "{" ^^ nest 1 (printer value.inside ^^ string "}")
+
+let rec print ast =
+  let app decl = group (pp_declaration decl) in
+  let decl = Utils.nseq_to_list ast.decl in
+  separate_map (hardline ^^ hardline) app decl
+
+and pp_declaration = function
+  TypeDecl  d -> pp_type_decl  d
+| ConstDecl d -> pp_const_decl d
+| FunDecl   d -> pp_fun_decl   d
+| AttrDecl  d -> pp_attr_decl  d
+
+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 t_expr = pp_type_expr const_type in
+  let attr   = match attributes with
+                 None -> empty
+               | Some a -> hardline ^^ pp_attr_decl a in
+  group (start ^/^ nest 2 (string ": " ^^ t_expr))
+  ^^ group (break 1 ^^ nest 2 (string "= " ^^ pp_expr init))
+  ^^ attr
+
+(* Type declarations *)
+
+and pp_type_decl decl =
+  let {name; type_expr; _} = decl.value in
+  string "type " ^^ string name.value ^^ string " is"
+  ^^ group (nest 2 (break 1 ^^ pp_type_expr type_expr))
+
+and pp_type_expr = function
+  TProd t   -> pp_cartesian t
+| TSum t    -> pp_variants t
+| TRecord t -> pp_fields t
+| TApp t    -> pp_type_app t
+| TFun t    -> pp_fun_type t
+| TPar t    -> pp_type_par t
+| TVar t    -> pp_ident t
+| TString s -> pp_string s
+
+and pp_cartesian {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string " *") ^^ app items
+  in pp_type_expr head ^^ string " *" ^^ app (List.map snd tail)
+
+and pp_variants {value; _} =
+  let head, tail = value in
+  let head = pp_variant head in
+  let head = if tail = [] then head
+             else ifflat head (string "  " ^^ head) in
+  let rest = List.map snd tail in
+  let app variant = break 1 ^^ string "| " ^^ pp_variant variant
+  in head ^^ concat_map app rest
+
+and pp_variant {value; _} =
+  let {constr; arg} = value in
+  match arg with
+    None -> pp_ident constr
+  | Some (_, e) ->
+      prefix 4 1 (pp_ident constr ^^ string " of") (pp_type_expr e)
+
+and pp_fields fields = pp_ne_injection pp_field_decl fields
+
+and pp_field_decl {value; _} =
+  let {field_name; field_type; _} = value in
+  let name   = pp_ident field_name in
+  let t_expr = pp_type_expr field_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_fun_type {value; _} =
+  let lhs, _, rhs = value in
+  group (pp_type_expr lhs ^^ string " ->" ^/^ pp_type_expr rhs)
+
+and pp_type_par t = pp_par pp_type_expr t
+
+and pp_type_app {value = ctor, tuple; _} =
+  prefix 2 1 (pp_type_constr ctor) (pp_type_tuple tuple)
+
+and pp_type_constr ctor = string ctor.value
+
+and pp_type_tuple {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items in
+  let components =
+    if tail = []
+    then pp_type_expr head
+    else pp_type_expr head ^^ string "," ^^ app (List.map snd tail)
+  in string "(" ^^ nest 1 (components ^^ string ")")
+
+(* Function and procedure declarations *)
+
+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"
+    | 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 expr = pp_expr return in
+  let body =
+    match block_with with
+            None -> group (nest 2 (break 1 ^^ expr))
+    | Some (b,_) -> hardline ^^ pp_block b ^^ string " with"
+                   ^^ group (nest 4 (break 1 ^^ expr))
+  and attr =
+    match attributes with
+        None -> empty
+    | Some a -> hardline ^^ pp_attr_decl a in
+  prefix 2 1 start parameters
+  ^^ group (nest 2 (break 1 ^^ string ": " ^^ nest 2 return_t ^^ string " is"))
+  ^^ body ^^ attr
+
+and pp_parameters p = pp_nsepseq ";" pp_param_decl p
+
+and pp_param_decl = function
+  ParamConst c -> pp_param_const c
+| ParamVar   v -> pp_param_var v
+
+and pp_param_const {value; _} =
+  let {var; param_type; _} : param_const = value in
+  let name   = string ("const " ^ var.value) in
+  let t_expr = pp_type_expr param_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_param_var {value; _} =
+  let {var; param_type; _} : param_var = value in
+  let name   = string ("var " ^ var.value) in
+  let t_expr = pp_type_expr param_type
+  in prefix 2 1 (name ^^ string " :") t_expr
+
+and pp_block {value; _} =
+  string "block {"
+  ^^ nest 2 (hardline ^^ pp_statements value.statements)
+  ^^ hardline ^^ string "}"
+
+and pp_statements s = pp_nsepseq ";" pp_statement s
+
+and pp_statement = function
+  Instr s -> pp_instruction s
+| Data  s -> pp_data_decl   s
+| Attr  s -> pp_attr_decl   s
+
+and pp_data_decl = function
+  LocalConst d -> pp_const_decl d
+| LocalVar   d -> pp_var_decl   d
+| LocalFun   d -> pp_fun_decl   d
+
+and pp_var_decl {value; _} =
+  let {name; var_type; init; _} = value in
+  let start = string ("var " ^ name.value) in
+  let t_expr = pp_type_expr var_type in
+  group (start ^/^ nest 2 (string ": " ^^ t_expr))
+  ^^ group (break 1 ^^ nest 2 (string ":= " ^^ pp_expr init))
+
+and pp_instruction = function
+  Cond        i -> group (pp_conditional i)
+| CaseInstr   i -> pp_case pp_if_clause i
+| Assign      i -> pp_assignment i
+| Loop        i -> pp_loop i
+| ProcCall    i -> pp_fun_call i
+| Skip        _ -> string "skip"
+| RecordPatch i -> pp_record_patch i
+| MapPatch    i -> pp_map_patch i
+| SetPatch    i -> pp_set_patch i
+| MapRemove   i -> pp_map_remove i
+| SetRemove   i -> pp_set_remove i
+
+and pp_set_remove {value; _} =
+  let {element; set; _} : set_remove = value in
+  string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr element))
+  ^^ group (break 1 ^^ prefix 2 1 (string "from set") (pp_path set))
+
+and pp_map_remove {value; _} =
+  let {key; map; _} = value in
+  string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr key))
+  ^^ group (break 1 ^^ prefix 2 1 (string "from map") (pp_path map))
+
+and pp_set_patch {value; _} =
+  let {path; set_inj; _} = value in
+  let inj = pp_ne_injection pp_expr set_inj in
+  string "patch"
+  ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
+  ^^ group (nest 2 (break 1 ^^ inj))
+
+and pp_map_patch {value; _} =
+  let {path; map_inj; _} = value in
+  let inj = pp_ne_injection pp_binding map_inj in
+  string "patch"
+  ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
+  ^^ group (nest 2 (break 1 ^^ inj))
+
+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; _} =
+  let {path; record_inj; _} = value in
+  let inj = pp_record record_inj in
+  string "patch"
+  ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with")
+  ^^ group (nest 2 (break 1 ^^ inj))
+
+and pp_cond_expr {value; _} =
+  let {test; ifso; 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  = match ifso with
+                ClauseInstr _ | ClauseBlock LongBlock _ ->
+                  string "then"
+                  ^^ group (nest 2 (break 1 ^^ pp_if_clause ifso))
+              | ClauseBlock ShortBlock _ ->
+                  string "then {"
+                  ^^ group (nest 2 (hardline ^^ pp_if_clause ifso))
+                  ^^ hardline ^^ string "}"
+  and ifnot = match ifnot with
+                ClauseInstr _ | ClauseBlock LongBlock _ ->
+                  string "else"
+                  ^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot))
+              | ClauseBlock ShortBlock _ ->
+                  string "else {"
+                  ^^ group (nest 2 (hardline ^^ pp_if_clause ifnot))
+                  ^^ hardline ^^ string "}"
+  in test ^/^ ifso ^/^ ifnot
+
+and pp_if_clause = function
+  ClauseInstr i -> pp_instruction i
+| ClauseBlock b -> pp_clause_block b
+
+and pp_clause_block = function
+  LongBlock b  -> pp_block b
+| ShortBlock b -> Utils.(pp_statements <@ fst) b.value.inside
+
+and pp_set_membership {value; _} =
+  let {set; element; _} : set_membership = value in
+  group (pp_expr set ^/^ string "contains" ^/^ pp_expr element)
+
+and pp_case : 'a.('a -> document) -> 'a case Region.reg -> document =
+  fun printer {value; _} ->
+    let {expr; cases; _} = value in
+    group (string "case " ^^ nest 5 (pp_expr expr) ^/^ string "of [")
+    ^^ hardline ^^ pp_cases printer cases
+    ^^ hardline ^^ string "]"
+
+and pp_cases :
+  'a.('a -> document) ->
+    ('a case_clause reg, vbar) Utils.nsepseq Region.reg ->
+    document =
+  fun printer {value; _} ->
+    let head, tail = value in
+    let head       = pp_case_clause printer 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
+
+and pp_case_clause :
+  'a.('a -> document) -> 'a case_clause Region.reg -> document =
+  fun printer {value; _} ->
+    let {pattern; rhs; _} = value in
+    pp_pattern pattern ^^ prefix 4 1 (string " ->") (printer rhs)
+
+and pp_assignment {value; _} =
+  let {lhs; rhs; _} = value in
+  prefix 2 1 (pp_lhs lhs ^^ string " :=") (pp_expr rhs)
+
+and pp_lhs : lhs -> document = function
+  Path p    -> pp_path p
+| MapPath p -> pp_map_lookup p
+
+and pp_loop = function
+  While l -> pp_while_loop l
+| For f   -> pp_for_loop f
+
+and pp_while_loop {value; _} =
+  let {cond; block; _} = value in
+  prefix 2 1 (string "while") (pp_expr cond) ^^ hardline ^^ pp_block block
+
+and pp_for_loop = function
+  ForInt l     -> pp_for_int l
+| ForCollect l -> pp_for_collect l
+
+and pp_for_int {value; _} =
+  let {assign; bound; step; block; _} = value in
+  let step =
+    match step with
+      None -> empty
+    | Some (_, e) -> prefix 2 1 (string " step") (pp_expr e) in
+  prefix 2 1 (string "for") (pp_var_assign assign)
+  ^^ prefix 2 1 (string " to") (pp_expr bound)
+  ^^ step ^^ hardline ^^ pp_block block
+
+and pp_var_assign {value; _} =
+  let {name; expr; _} = value in
+  prefix 2 1 (pp_ident name ^^ string " :=") (pp_expr expr)
+
+and pp_for_collect {value; _} =
+  let {var; bind_to; collection; expr; block; _} = value in
+  let binding =
+    match bind_to with
+      None -> pp_ident var
+    | Some (_, dest) -> pp_ident var ^^ string " -> " ^^ pp_ident dest in
+  prefix 2 1 (string "for") binding
+  ^^ prefix 2 1 (string " in") (pp_collection collection ^/^ pp_expr expr)
+  ^^ hardline ^^ pp_block block
+
+and pp_collection = function
+  Map  _ -> string "map"
+| Set  _ -> string "set"
+| List _ -> string "list"
+
+(* Expressions *)
+
+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 -> 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)
+| ESet    e -> pp_set_expr e
+| EConstr e -> pp_constr_expr e
+| ERecord e -> pp_record e
+| EProj   e -> pp_projection e
+| EUpdate e -> pp_update e
+| EMap    e -> pp_map_expr e
+| EVar    e -> pp_ident e
+| ECall   e -> pp_fun_call e
+| EBytes  e -> pp_bytes e
+| EUnit   _ -> string "Unit"
+| ETuple  e -> pp_tuple_expr e
+| EPar    e -> pp_par pp_expr e
+| EFun    e -> pp_fun_expr e
+
+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 -> pp_injection pp_expr inj
+| SetMem mem -> pp_set_membership mem
+
+and pp_map_expr = function
+  MapLookUp fetch -> pp_map_lookup fetch
+| MapInj inj      -> pp_injection pp_binding inj
+| BigMapInj inj   -> pp_injection pp_binding inj
+
+and pp_map_lookup {value; _} =
+  prefix 2 1 (pp_path value.path) (pp_brackets pp_expr value.index)
+
+and pp_path = function
+  Name v -> pp_ident v
+| Path p -> pp_projection p
+
+and pp_logic_expr = function
+  BoolExpr e -> pp_bool_expr e
+| CompExpr e -> pp_comp_expr e
+
+and pp_bool_expr = function
+  Or   e  -> pp_bin_op "or" e
+| And  e  -> pp_bin_op "and" e
+| Not  e  -> pp_un_op "not" e
+| True  _ -> string "True"
+| False _ -> string "False"
+
+and pp_bin_op op {value; _} =
+  let {arg1; arg2; _} = value
+  and length = String.length op + 1 in
+  pp_expr arg1 ^/^ string (op ^ " ") ^^ nest length (pp_expr arg2)
+
+and pp_un_op op {value; _} =
+  string (op ^ " ") ^^ pp_expr value.arg
+
+and pp_comp_expr = function
+  Lt    e -> pp_bin_op "<"  e
+| Leq   e -> pp_bin_op "<=" e
+| Gt    e -> pp_bin_op ">"  e
+| Geq   e -> pp_bin_op ">=" e
+| Equal e -> pp_bin_op "="  e
+| Neq   e -> pp_bin_op "=/=" e
+
+and pp_arith_expr = function
+  Add   e -> pp_bin_op "+" e
+| Sub   e -> pp_bin_op "-" e
+| Mult  e -> pp_bin_op "*" e
+| Div   e -> pp_bin_op "/" e
+| Mod   e -> pp_bin_op "mod" e
+| Neg   e -> string "-" ^^ pp_expr e.value.arg
+| Int   e -> pp_int e
+| Nat   e -> pp_nat e
+| Mutez e -> pp_mutez e
+
+and pp_mutez {value; _} =
+  Z.to_string (snd value) ^ "mutez" |> string
+
+and pp_string_expr = function
+  Cat      e -> pp_bin_op "^" e
+| String   e -> pp_string e
+| Verbatim e -> pp_verbatim e
+
+and pp_ident {value; _} = string value
+
+and pp_string s = string "\"" ^^ pp_ident s ^^ string "\""
+
+and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
+
+and pp_list_expr = function
+  ECons     e -> pp_bin_op "#" e
+| EListComp e -> pp_injection pp_expr e
+| ENil      _ -> string "nil"
+
+and pp_constr_expr = function
+  SomeApp   a -> pp_some_app a
+| NoneExpr  _ -> string "None"
+| ConstrApp a -> pp_constr_app a
+
+and pp_some_app {value; _} =
+  prefix 4 1 (string "Some") (pp_arguments (snd value))
+
+and pp_constr_app {value; _} =
+  let constr, args = value in
+  let constr = string constr.value in
+  match args with
+          None -> constr
+  | Some tuple -> prefix 2 1 constr (pp_tuple_expr tuple)
+
+
+and pp_field_assign {value; _} =
+  let {field_name; field_expr; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_expr field_expr)
+
+and pp_record ne_inj = group (pp_ne_injection pp_field_assign ne_inj)
+
+and pp_projection {value; _} =
+  let {struct_name; field_path; _} = value in
+  let fields = Utils.nsepseq_to_list field_path
+  and sep    = string "." ^^ break 0 in
+  let fields = separate_map sep pp_selection fields in
+  group (pp_ident struct_name ^^ string "." ^^ break 0 ^^ fields)
+
+and pp_update {value; _} =
+  let {record; updates; _} = value in
+  let updates = group (pp_ne_injection pp_field_path_assign updates)
+  and record  = pp_path record in
+  record ^^ string " with" ^^ nest 2 (break 1 ^^ updates)
+
+and pp_field_path_assign {value; _} =
+  let {field_path; field_expr; _} = value in
+  let path = pp_path field_path in
+  prefix 2 1 (path ^^ string " =") (pp_expr field_expr)
+
+and pp_selection = function
+  FieldName v   -> string v.value
+| Component cmp -> cmp.value |> snd |> Z.to_string |> string
+
+and pp_tuple_expr {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_expr e ^^ string ",") ^^ app items in
+  let components =
+    if tail = []
+    then pp_expr head
+    else pp_expr head ^^ string "," ^^ app (List.map snd tail)
+  in string "(" ^^ nest 1 (components ^^ string ")")
+
+and pp_fun_call {value; _} =
+  let lambda, arguments = value in
+  let arguments = pp_tuple_expr arguments in
+  group (pp_expr lambda ^^ nest 2 (break 1 ^^ arguments))
+
+and pp_arguments v = pp_tuple_expr v
+
+(* Injections *)
+
+and pp_injection :
+  'a.('a -> document) -> 'a injection reg -> document =
+  fun printer {value; _} ->
+    let {kind; elements; _} = value in
+    let sep      = string ";" ^^ break 1 in
+    let elements = Utils.sepseq_to_list elements in
+    let elements = separate_map sep printer elements in
+    let kwd      = pp_injection_kwd kind in
+    group (string (kwd ^ " [")
+           ^^ nest 2 (break 0 ^^ elements) ^^ break 0 ^^ string "]")
+
+and pp_injection_kwd = function
+  InjSet    _ -> "set"
+| InjMap    _ -> "map"
+| InjBigMap _ -> "big_map"
+| InjList   _ -> "list"
+
+and pp_ne_injection :
+  'a.('a -> document) -> 'a ne_injection reg -> document =
+  fun printer {value; _} ->
+    let {kind; ne_elements; _} = value in
+    let elements = pp_nsepseq ";" printer ne_elements in
+    let kwd      = pp_ne_injection_kwd kind in
+    group (string (kwd ^ " [")
+           ^^ group (nest 2 (break 0 ^^ elements ))
+           ^^ break 0 ^^ string "]")
+
+and pp_ne_injection_kwd = function
+  NEInjAttr   _ -> "attributes"
+| NEInjSet    _ -> "set"
+| NEInjMap    _ -> "map"
+| NEInjRecord _ -> "record"
+
+and pp_nsepseq :
+  'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
+  fun sep printer elements ->
+    let elems = Utils.nsepseq_to_list elements
+    and sep   = string sep ^^ break 1
+    in separate_map sep printer elems
+
+(* Patterns *)
+
+and pp_pattern = function
+  PConstr p -> pp_constr_pattern p
+| PVar    v -> pp_ident v
+| PWild   _ -> string "_"
+| PInt    i -> pp_int i
+| PNat    n -> pp_nat n
+| PBytes  b -> pp_bytes b
+| PString s -> pp_string s
+| PList   l -> pp_list_pattern l
+| PTuple  t -> pp_tuple_pattern t
+
+and pp_int {value; _} =
+  string (Z.to_string (snd value))
+
+and pp_nat {value; _} =
+  string (Z.to_string (snd value) ^ "n")
+
+and pp_bytes {value; _} =
+  string ("0x" ^ Hex.show (snd value))
+
+and pp_constr_pattern = function
+  PUnit      _ -> string "Unit"
+| PFalse     _ -> string "False"
+| PTrue      _ -> string "True"
+| PNone      _ -> string "None"
+| PSomeApp   a -> pp_psome a
+| PConstrApp a -> pp_pconstr_app a
+
+and pp_psome {value=_, p; _} =
+  prefix 4 1 (string "Some") (pp_par pp_pattern p)
+
+and pp_pconstr_app {value; _} =
+  match value with
+    constr, None -> pp_ident constr
+  | constr, Some ptuple ->
+      prefix 4 1 (pp_ident constr) (pp_tuple_pattern ptuple)
+
+and pp_tuple_pattern {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_pattern e)
+  | e::items ->
+      group (break 1 ^^ pp_pattern e ^^ string ",") ^^ app items in
+  let components =
+    if   tail = []
+    then pp_pattern head
+    else pp_pattern head ^^ string "," ^^ app (List.map snd tail)
+  in string "(" ^^ nest 1 (components ^^ string ")")
+
+and pp_list_pattern = function
+  PListComp cmp -> pp_list_comp cmp
+| PNil _        -> string "nil"
+| PParCons p    -> pp_ppar_cons p
+| PCons p       -> nest 4 (pp_nsepseq " #" pp_pattern p.value)
+
+and pp_list_comp e = pp_injection pp_pattern e
+
+and pp_ppar_cons {value; _} =
+  let patt1, _, patt2 = value.inside in
+  let comp = prefix 2 1 (pp_pattern patt1 ^^ string " ::") (pp_pattern patt2)
+  in string "(" ^^ nest 1 (comp ^^ string ")")

src/passes/01-parser/pascaligo/Tests/pp.ligo

@@ -1,10 +1,14 @@
+function incr_map (const l : list (int)) : list (int) is
+  List.map (function (const i : int) : int is i + 1, l)
+
 type t is timestamp * nat -> map (string, address)
 type u is A | B of t * int | C of int -> (string -> int)
-type v is record a : t; b : record c : string end end
+type v is record aaaaaa : ttttttt; bbbbbb : record ccccccccc : string end end
 
 function back (var store : store) : list (operation) * store is
   begin
      var operations  : list (operation) := list [];
+    const operations : list (operation) = list [];
     const a          : nat =  0n;
     x0               := record foo = "1"; bar = 4n end;
     x1               := nil;
@@ -13,7 +17,7 @@ function back (var store : store) : list (operation) * store is
     case foo of
       10n -> skip
     end;
-    if s contains x then skip else skip;
+if saaa.0.1.2.a.b.b.x contains xxxxxxxxxxxxxxx[123] then skip else skip;
     s := set [3_000mutez; -2; 1n];
     a := A;
     b := B (a);
@@ -21,12 +25,12 @@ function back (var store : store) : list (operation) * store is
     d := None;
     e := Some (a, B (b));
     z := z.1.2;
-    x := map [1 -> "1"; 2 -> "2"];
+x := if true then map [1 -> "1"; 2 -> "2"; 3 -> "3"; 4 -> "4"; 5 -> "5555555555555555"] else Unit;
     y := a.b.c[3];
     a := "hello " ^ "world" ^ "!";
-    r := record a = 0 end;
+    r := record aaaaaaaaaaaa = 100000000; bbbbbbb = ffffff (2, aa, x, y) + 1 end;
-    r := r with record a = 42 end;
+    r := r with record aaaaaaaaaaa = 444442; bbbbbbbbb = 43 + f (z) / 234 end;
-    patch store.backers with set [(1); f(2*3)];
+    patch store.backers.8.aa.33333.5 with set [(1); f(2*3); 123124234/2345];
     remove (1,2,3) from set foo.bar;
     remove 3 from map foo.bar;
     patch store.backers with map [sender -> amount];
@@ -39,7 +43,7 @@ function back (var store : store) : list (operation) * store is
           begin
             acc := 2 - (if toggle then f(x) else Unit);
           end;
-        for i := 1n to 10n
+        for i := 1n to 10n step 2n
           begin
             acc := acc + i;
           end;
@@ -52,27 +56,32 @@ function back (var store : store) : list (operation) * store is
       | B (x, C (y,z)) -> skip
       | False#True#Unit#0xAA#"hi"#4#nil -> skip
       ]
-  end with (operations, store)
+  end with (operations, store, (more_stuff, and_here_too))
 
-function claim (var store : store) : list (operation) * store is
+  function claim (var store : store; const bar : t; const baz : u; var z : operations * store * (more_stuff * and_here_too)) : list (operation) * store * timestamp * nat -> map (string, address) is
   begin
-    var operations : list (operation) := nil;
+     const operations : list (operation * map (address, map (longname, domain))) = nilllllllllll;
+var operations : list (operation * map (address, map (longname, domain))) := nilllllllllll;
+     attributes ["foo"; "inline"];
     if now <= store.deadline then
       failwith ("Too soon.")
     else
       case store.backers[sender] of
         None ->
           failwith ("Not a backer.")
+      | Some (0) -> skip
       | Some (quantity) ->
           if balance >= store.goal or store.funded then
             failwith ("Goal reached: no refund.")
           else
             begin
-              operations.0.foo := list [transaction (unit, sender, quantity)];
+               operations.0.foo := list [transaction (unit, sender, quantity); transaction (foo, bar, bazzzzzzzzzzzzzzz)];
-              remove sender from map store.backers
+               remove sender.0099999.fffff [fiar (abaxxasfdf)] from map store.backers.foooooo.barrrrr.01.bazzzzzzz
             end
       end
-  end with (operations, store)
+  end with long_function_name (operations, store, (more_stuff, (and_here_too, well_in_here_too), hello))
+
+attributes ["inline"; "foo"]
 
 function withdraw (var store : store) : list (operation) * store is
   begin

src/passes/01-parser/pascaligo/dune

@@ -15,8 +15,10 @@
   (name parser_pascaligo)
   (public_name ligo.parser.pascaligo)
   (modules
-     Scoping AST pascaligo Parser ParserLog LexToken ParErr)
+     Scoping AST pascaligo Parser ParserLog LexToken ParErr Pretty)
   (libraries
+     pprint
+     terminal_size
      menhirLib
      parser_shared
      hex

src/passes/01-parser/reasonligo.ml

@@ -8,6 +8,7 @@ module Region      = Simple_utils.Region
 module ParErr      = Parser_reasonligo.ParErr
 module SyntaxError = Parser_reasonligo.SyntaxError
 module SSet        = Set.Make (String)
+module Pretty      = Parser_reasonligo.Pretty
 
 (* Mock IOs TODO: Fill them with CLI options *)
 
@@ -22,7 +23,8 @@ module SubIO =
       ext     : string;   (* ".religo" *)
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -37,6 +39,7 @@ module SubIO =
            method mode    = `Point
            method cmd     = EvalOpt.Quiet
            method mono    = false
+           method pretty  = false
          end
 
     let make =
@@ -49,6 +52,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -178,3 +182,18 @@ let parse_expression source = apply (fun () -> Unit.expr_in_string source)
 (* Preprocessing a contract in a file *)
 
 let preprocess source = apply (fun () -> Unit.preprocess source)
+
+(* Pretty-print a file (after parsing it). *)
+
+let pretty_print source =
+  match parse_file source with
+    Stdlib.Error _ as e -> e
+  | Ok ast ->
+      let doc    = Pretty.print (fst ast) in
+      let buffer = Buffer.create 131 in
+      let width  =
+        match Terminal_size.get_columns () with
+          None -> 60
+        | Some c -> c in
+      let () = PPrint.ToBuffer.pretty 1.0 width buffer doc
+      in Trace.ok buffer

src/passes/01-parser/reasonligo.mli

@@ -19,3 +19,6 @@ val parse_expression : string -> AST.expr Trace.result
 
 (** Preprocess a given ReasonLIGO file and preprocess it. *)
 val preprocess : string -> Buffer.t Trace.result
+
+(** Pretty-print a given CameLIGO file (after parsing it). *)
+val pretty_print : string -> Buffer.t Trace.result

src/passes/01-parser/reasonligo/.links

@@ -27,5 +27,3 @@ Stubs/Parser_cameligo.ml
 ../cameligo/ParserLog.ml
 ../cameligo/Scoping.mli
 ../cameligo/Scoping.ml
-
-$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml

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

@@ -279,15 +279,12 @@ let_binding:
 | par(closed_irrefutable) type_annotation? "=" expr {
     wild_error $4;
     Scoping.check_pattern $1.value.inside;
-    {binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
+    {binders = $1.value.inside, []; lhs_type=$2; eq=$3; let_rhs=$4}
   }
 | tuple(sub_irrefutable) type_annotation? "=" expr {
     wild_error $4;
     Utils.nsepseq_iter Scoping.check_pattern $1;
-    let hd, tl  = $1 in
+    let region  = nsepseq_to_region pattern_to_region $1 in
-    let start   = pattern_to_region hd in
-    let stop    = last fst tl in
-    let region  = cover start stop in
     let binders = PTuple {value=$1; region}, [] in
     {binders; lhs_type=$2; eq=$3; let_rhs=$4} }
 
@@ -433,7 +430,18 @@ type_expr_simple:
     TProd {region = cover $1 $3; value=$2}
   }
 | "(" type_expr_simple "=>" type_expr_simple ")" {
-    TFun {region = cover $1 $5; value=$2,$3,$4} }
+    TPar {
+      value = {
+        lpar = $1;
+        rpar = $5;
+        inside = TFun {
+          region = cover (type_expr_to_region $2) (type_expr_to_region $4);
+          value=$2,$3,$4
+        }
+      };
+      region = cover $1 $5;
+    }
+}
 
 type_annotation_simple:
   ":" type_expr_simple { $1,$2 }
@@ -456,8 +464,15 @@ fun_expr(right_expr):
         )
     | EAnnot {region; value = {inside = EVar v, colon, typ; _}} ->
         Scoping.check_reserved_name v;
-        let value = {pattern = PVar v; colon; type_expr = typ}
+        let value = {pattern = PVar v; colon; type_expr = typ} in
-        in PTyped {region; value}
+        PPar {
+          value = {
+            lpar = Region.ghost;
+            rpar = Region.ghost;
+            inside = PTyped {region; value}
+          };
+          region
+        }
     | EPar p ->
         let value =
           {p.value with inside = arg_to_pattern p.value.inside}
@@ -497,7 +512,13 @@ fun_expr(right_expr):
          (arg_to_pattern fun_arg, [])
       | EPar {value = {inside = EFun {
           value = {
-              binders = PTyped { value = { pattern; colon; type_expr }; region = fun_region }, [];
+              binders = PPar {
+                value = {
+                  inside = PTyped { value = { pattern; colon; type_expr }; region = fun_region };
+                  _
+                };
+                _
+              }, [];
               arrow;
               body;
               _
@@ -656,7 +677,7 @@ disj_expr_level:
   disj_expr
 | conj_expr_level { $1 }
 | par(tuple(disj_expr_level)) type_annotation_simple? {
-    let region = $1.region in
+    let region = nsepseq_to_region expr_to_region $1.value.inside in
     let tuple  = ETuple {value=$1.value.inside; region} in
     let region =
       match $2 with
@@ -891,7 +912,7 @@ update_record:
       lbrace   = $1;
       record   = $3;
       kwd_with = $4;
-      updates  = {value = {compound = Braces($1,$6);
+      updates  = {value = {compound = Braces (ghost, ghost);
                            ne_elements;
                            terminator};
                   region = cover $4 $6};
@@ -921,10 +942,9 @@ exprs:
       in
       let sequence = ESeq {
         value = {
-          compound = BeginEnd(Region.ghost, Region.ghost);
+          compound   = BeginEnd (ghost, ghost);
           elements   = Some val_;
-          terminator = (snd c)
+          terminator = snd c};
-        };
         region = sequence_region
       }
       in
@@ -959,9 +979,8 @@ sequence:
     let value    = {compound;
                     elements = Some elts;
                     terminator = None} in
-    let region   = cover $1 $3 in  
+    let region   = cover $1 $3
-    {region; value}
+    in {region; value} }
-  }
 
 record:
   "{" field_assignment more_field_assignments? "}" {
@@ -986,15 +1005,13 @@ record:
     let ne_elements = Utils.nsepseq_cons field_name comma elts in
     let compound = Braces ($1,$4) in
     let region   = cover $1 $4 in
-    { value = {compound; ne_elements; terminator = None}; region }
+    {value = {compound; ne_elements; terminator = None}; region} }
-  }
 
 field_assignment_punning:
   (* This can only happen with multiple fields -
      one item punning does NOT work in ReasonML *)
   field_name {
-    let value = {
+    let value = {field_name = $1;
-      field_name = $1;
                  assignment = ghost;
                  field_expr = EVar $1}
     in {$1 with value}
@@ -1003,38 +1020,14 @@ field_assignment_punning:
 
 field_assignment:
   field_name ":" expr {
-    let start  = $1.region in
+    let region = cover $1.region (expr_to_region $3)
-    let stop   = expr_to_region $3 in
+    and value  = {field_name = $1;
-    let region = cover start stop in
-    let value  = {
-      field_name = $1;
                   assignment = $2;
                   field_expr = $3}
     in {region; value} }
 
-real_selection:
-  field_name { FieldName $1 }
-| "<int>"    { Component $1 }
-
 field_path_assignment:
-  real_selection {
+  path ":" expr {
-    let region = selection_to_region $1 
+    let region = cover (path_to_region $1) (expr_to_region $3)
-    and value  = {
+    and value  = {field_path=$1; assignment=$2; field_expr=$3}
-      field_path = ($1,[]);
-      assignment = ghost;
-      field_expr = match $1 with
-        FieldName var -> EVar var
-      | Component {value;region} -> 
-        let value = Z.to_string (snd value) in
-        EVar {value;region} }
-    in {region; value}
-  }
-| nsepseq(real_selection,".") ":" expr {
-    let start  = nsepseq_to_region selection_to_region $1
-    and stop   = expr_to_region $3 in
-    let region = cover start stop
-    and value  = {
-      field_path = $1;
-      assignment = $2;
-      field_expr = $3}
     in {region; value} }

src/passes/01-parser/reasonligo/ParserMain.ml

@@ -22,7 +22,8 @@ module SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     let options : options =
@@ -36,6 +37,7 @@ module SubIO =
         method mode    = IO.options#mode
         method cmd     = IO.options#cmd
         method mono    = IO.options#mono
+        method pretty  = IO.options#pretty
       end
 
     let make =
@@ -48,6 +50,7 @@ module SubIO =
                    ~mode:options#mode
                    ~cmd:options#cmd
                    ~mono:options#mono
+                   ~pretty:options#pretty
   end
 
 module Parser =
@@ -67,12 +70,23 @@ module ParserLog =
 module Lexer = Lexer.Make (LexToken)
 
 module Unit =
-  ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
+  ParserUnit.Make (Lexer)(AST)(Parser)(Parser_msg)(ParserLog)(SubIO)
 
 (* Main *)
 
 let wrap = function
-  Stdlib.Ok _ -> flush_all ()
+  Stdlib.Ok ast ->
+    if IO.options#pretty then
+      begin
+        let doc = Pretty.print ast in
+        let width =
+          match Terminal_size.get_columns () with
+            None -> 60
+          | Some c -> c in
+        PPrint.ToChannel.pretty 1.0 width stdout doc;
+        print_newline ()
+      end;
+    flush_all ()
 | Error msg ->
     (flush_all (); Printf.eprintf "\027[31m%s\027[0m%!" msg.Region.value)
 

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

@@ -0,0 +1,471 @@
+[@@@warning "-42"]
+
+open AST
+module Region = Simple_utils.Region
+open! Region
+open! PPrint
+
+let rec print ast =
+  let app decl = group (pp_declaration decl) in
+  separate_map (hardline ^^ hardline) app (Utils.nseq_to_list ast.decl)
+
+and pp_declaration = function
+  Let decl -> pp_let_decl decl
+| TypeDecl decl -> pp_type_decl decl
+
+and pp_let_decl = function
+| {value = (_,rec_opt, binding, attr); _} ->
+  let let_str =
+    match rec_opt with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let bindings = pp_let_binding let_str binding
+  and attr    = pp_attributes attr
+  in group (attr ^^ bindings ^^ string ";")
+
+and pp_attributes = function
+    [] -> empty
+| attr ->
+    let make s = string "[@" ^^ string s.value ^^ string "]" in
+    group (break 0 ^^ separate_map (break 0) make attr) ^^ hardline
+
+and pp_ident {value; _} = string value
+
+and pp_string s = string "\"" ^^ pp_ident s ^^ string "\""
+
+and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}"
+
+and pp_let_binding let_ (binding : let_binding) =
+  let {binders; lhs_type; let_rhs; _} = binding in
+  let patterns = Utils.nseq_to_list binders in
+  let patterns = group (separate_map (break 0) pp_pattern patterns) in
+  let lhs =
+    string let_ ^^
+      match lhs_type with
+        None -> patterns ^^ string " = "
+      | Some (_,e) ->
+          patterns ^^ group (break 0 ^^ string ": " ^^ pp_type_expr e ^^ string " = ")
+  in
+  let rhs = pp_expr let_rhs in
+  match let_rhs with
+  | EFun _
+  | ESeq _
+  | ERecord _ -> lhs ^^ rhs
+  | _ -> prefix 2 0 lhs rhs
+
+and pp_pattern = function
+  PConstr p -> pp_pconstr p
+| PUnit   _ -> string "()"
+| PFalse  _ -> string "false"
+| PTrue   _ -> string "true"
+| PVar    v -> pp_ident v
+| PInt    i -> pp_int i
+| PNat    n -> pp_nat n
+| PBytes  b -> pp_bytes b
+| PString s -> pp_string s
+| PVerbatim s -> pp_verbatim s
+| PWild   _ -> string "_"
+| PList   l -> pp_plist l
+| PTuple  t -> pp_ptuple t
+| PPar    p -> pp_ppar p
+| PRecord r -> pp_precord r
+| PTyped  t -> pp_ptyped t
+
+and pp_pconstr = function
+  PNone      _ -> string "None"
+| PSomeApp   p -> pp_patt_some p
+| PConstrApp a -> pp_patt_c_app a
+
+and pp_patt_c_app {value; _} =
+  match value with
+    constr, None -> pp_ident constr
+  | constr, Some (PVar _ as pat) ->
+      prefix 2 1 (pp_ident constr)  (pp_pattern pat)
+  | constr, Some (_ as pat)->
+      prefix 2 0 (pp_ident constr)  (pp_pattern pat)
+
+and pp_patt_some {value; _} =
+  prefix 2 0 (string "Some") (pp_pattern (snd value))
+
+and pp_int {value; _} =
+  string (Z.to_string (snd value))
+
+and pp_nat {value; _} =
+  string (Z.to_string (snd value) ^ "n")
+
+and pp_bytes {value; _} =
+  string ("0x" ^ Hex.show (snd value))
+
+and pp_ppar {value; _} =
+  if value.lpar = Region.ghost then
+    nest 1 (pp_pattern value.inside)
+  else
+    string "(" ^^ nest 1 (pp_pattern value.inside) ^^ string ")"
+
+and pp_plist = function
+  PListComp cmp -> pp_list_comp cmp
+| PCons cons -> pp_cons cons
+
+and pp_list_comp e = group (pp_injection pp_pattern e)
+
+and pp_cons {value; _} =
+  let patt1, _, patt2 = value in
+  string "[" ^^ (pp_pattern patt1 ^^ string ", ") ^^ group ( break 0 ^^ string "..." ^^ pp_pattern patt2) ^^ string "]"
+
+and pp_ptuple {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [p] -> group (break 1 ^^ pp_pattern p)
+  | p::items ->
+      group (break 1 ^^ pp_pattern p ^^ string ",") ^^ app items
+  in if tail = []
+     then string "(" ^^ nest 1 (pp_pattern head) ^^ string ")"
+     else string "(" ^^ nest 1 (pp_pattern head ^^ string "," ^^ app (List.map snd tail)) ^^ string ")"
+
+and pp_precord fields = pp_ne_injection pp_field_pattern fields
+
+and pp_field_pattern {value; _} =
+  let {field_name; pattern; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string " =") (pp_pattern pattern)
+
+and pp_ptyped {value; _} =
+  let {pattern; type_expr; _} = value in
+  group (pp_pattern pattern ^^ string ": " ^^ pp_type_expr type_expr)
+
+and pp_type_decl decl =
+  let {name; type_expr; _} = decl.value in
+  string "type " ^^ string name.value ^^ string " = "
+  ^^ group (pp_type_expr type_expr) ^^ string ";"
+
+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
+| EArith  e -> group (pp_arith_expr e)
+| EString e -> pp_string_expr e
+| EList   e -> group (pp_list_expr e)
+| EConstr e -> pp_constr_expr e
+| ERecord e -> pp_record_expr e
+| EProj   e -> pp_projection e
+| EUpdate e -> pp_update e
+| EVar    v -> pp_ident v
+| ECall   e -> pp_call_expr e
+| EBytes  e -> pp_bytes e
+| EUnit   _ -> string "()"
+| ETuple  e -> pp_tuple_expr e
+| EPar    e -> pp_par_expr e
+| ELetIn  e -> pp_let_in e
+| EFun    e -> pp_fun e
+| ESeq    e -> pp_seq e
+
+and pp_case_expr {value; _} =
+  let {expr; cases; _} = value in
+  group (string "switch" ^^ string "(" ^^ nest 1 (pp_expr expr)
+         ^^ string ") " ^^ string "{"
+         ^^ pp_cases cases ^^ hardline ^^ string "}")
+
+and pp_cases {value; _} =
+  let head, tail = value in
+  let rest = List.map snd tail in
+  let app clause = break 1 ^^ string "| " ^^ pp_clause clause
+  in  concat_map app (head :: rest)
+
+and pp_clause {value; _} =
+  let {pattern; rhs; _} = value in
+  prefix 4 1 (pp_pattern pattern ^^ string " =>") (pp_expr rhs)
+
+and pp_cond_expr {value; _} =
+  let {test; ifso; kwd_else; ifnot; _} = value in
+  let if_then =
+    string "if" ^^ string " (" ^^ pp_expr test ^^ string ")" ^^ string " {" ^^ break 0 
+    ^^ group (nest 2 (break 2 ^^ pp_expr ifso)) ^^ hardline ^^ string "}" in
+  if kwd_else#is_ghost then
+    if_then
+  else
+    if_then
+    ^^ string " else" ^^ string " {" ^^ break 0 ^^ group (nest 2 (break 2 ^^ pp_expr ifnot)) ^^ hardline ^^ string "}"
+
+and pp_annot_expr {value; _} =
+  let expr, _, type_expr = value.inside in
+    group (nest 1 (pp_expr expr ^/^ string ": "
+    ^^ pp_type_expr type_expr))
+
+and pp_logic_expr = function
+  BoolExpr e -> pp_bool_expr e
+| CompExpr e -> pp_comp_expr e
+
+and pp_bool_expr = function
+  Or   e  -> pp_bin_op "||" e
+| And  e  -> pp_bin_op "&&" e
+| Not  e  -> pp_un_op "!" e
+| True  _ -> string "true"
+| False _ -> string "false"
+
+and pp_bin_op op {value; _} =
+  let {arg1; arg2; _} = value
+  and length = String.length op + 1 in
+  pp_expr arg1 ^^ string " " ^^ string (op ^ " ") ^^ nest length (pp_expr arg2)
+
+and pp_un_op op {value; _} =
+  string (op ^ " ") ^^ pp_expr value.arg
+
+and pp_comp_expr = function
+  Lt    e -> pp_bin_op "<"  e
+| Leq   e -> pp_bin_op "<=" e
+| Gt    e -> pp_bin_op ">"  e
+| Geq   e -> pp_bin_op ">=" e
+| Equal e -> pp_bin_op "=="  e
+| Neq   e -> pp_bin_op "!=" e
+
+and pp_arith_expr = function
+  Add   e -> pp_bin_op "+" e
+| Sub   e -> pp_bin_op "-" e
+| Mult  e -> pp_bin_op "*" e
+| Div   e -> pp_bin_op "/" e
+| Mod   e -> pp_bin_op "mod" e
+| Neg   e -> string "-" ^^ pp_expr e.value.arg
+| Int   e -> pp_int e
+| Nat   e -> pp_nat e
+| Mutez e -> pp_mutez e
+
+and pp_mutez {value; _} =
+  Z.to_string (snd value) ^ "mutez" |> string
+
+and pp_string_expr = function
+     Cat e -> pp_bin_op "++" e
+| String e -> pp_string e
+| Verbatim e -> pp_verbatim e
+
+and pp_list_expr = function
+| ECons {value = {arg1; arg2; _}; _ } ->
+  string "[" ^^ pp_expr arg1 ^^ string "," ^^ break 1 ^^ string "..." ^^ pp_expr arg2 ^^ string "]"
+| EListComp e -> group (pp_injection pp_expr e)
+
+and pp_injection :
+  'a.('a -> document) -> 'a injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; elements; _} = value in
+    let sep = (string ",") ^^ break 1 in
+    let elements = Utils.sepseq_to_list elements in
+    let elements = separate_map sep printer elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 1 elements ^^ string closing
+
+and pp_compound = function
+  BeginEnd (start, _) ->
+    if start#is_ghost then None else Some ("begin","end")
+| Braces (start, _) ->
+    if start#is_ghost then None else Some ("{","}")
+| Brackets (start, _) ->
+    if start#is_ghost then None else Some ("[","]")
+
+and pp_constr_expr = function
+  ENone      _ -> string "None"
+| ESomeApp   a -> pp_some a
+| EConstrApp a -> pp_constr_app a
+
+and pp_some {value=_, e; _} =
+  prefix 4 1 (string "Some") (pp_expr e)
+
+and pp_constr_app {value; _} =
+  let constr, arg = value in
+  let constr = string constr.value in
+  match arg with
+      None -> constr
+  | Some e -> prefix 2 1 constr (pp_expr e)
+
+and pp_record_expr ne_inj = pp_ne_injection pp_field_assign ne_inj
+
+and pp_field_assign {value; _} =
+  let {field_name; field_expr; _} = value in
+  prefix 2 1 (pp_ident field_name ^^ string ":") (pp_expr field_expr)
+
+and pp_ne_injection :
+  'a.('a -> document) -> 'a ne_injection reg -> document =
+  fun printer {value; _} ->
+    let {compound; ne_elements; _} = value in
+    let elements = pp_nsepseq "," printer ne_elements in
+    match pp_compound compound with
+      None -> elements
+    | Some (opening, closing) ->
+        string opening ^^ nest 2 (break 0 ^^ elements) ^^ break 1 ^^ string closing
+
+and pp_nsepseq :
+  'a.string -> ('a -> document) -> ('a, t) Utils.nsepseq -> document =
+  fun sep printer elements ->
+    let elems = Utils.nsepseq_to_list elements
+    and sep   = string sep ^^ break 1
+    in separate_map sep printer elems
+
+and pp_projection {value; _} =
+  let {struct_name; field_path; _} = value in
+  let subpath = Utils.nsepseq_to_list field_path in
+  let subpath = concat_map pp_selection subpath in
+  group (pp_ident struct_name ^^ subpath)
+
+and pp_selection = function
+  FieldName v   -> string "." ^^ break 0 ^^ string v.value
+| Component cmp ->
+    string "[" ^^ (cmp.value |> snd |> Z.to_string |> string) ^^ string "]"
+
+and pp_update {value; _} =
+  let {record; updates; _} = value in
+  let updates = group (pp_ne_injection pp_field_path_assign updates)
+  and record  = pp_path record in
+  string "{..." ^^ record ^^ string ","
+  ^^ nest 2 (break 1 ^^ updates ^^ string "}")
+
+and pp_field_path_assign {value; _} =
+  let {field_path; field_expr; _} = value in
+  let path = pp_path field_path in
+  prefix 2 1 (path ^^ string ":") (pp_expr field_expr)
+
+and pp_path = function
+  Name v -> pp_ident v
+| Path p -> pp_projection p
+
+and pp_call_expr {value; _} =
+  let lambda, arguments = value in
+  let arguments = Utils.nseq_to_list arguments in
+  let arguments = string "(" ^^ group (separate_map (string "," ^^ break 0 ^^ string " ") pp_expr arguments) ^^ string ")" in
+  group (break 0 ^^ pp_expr lambda ^^ nest 2 arguments)
+
+and pp_tuple_expr {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_expr e ^^ string ",") ^^ app items
+  in if tail = []
+     then string "(" ^^ nest 1 (pp_expr head) ^^ string ")"
+     else string "(" ^^ nest 1 (pp_expr head ^^ string "," ^^ app (List.map snd tail)) ^^ string ")"
+
+and pp_par_expr {value; _} =
+  string "(" ^^ nest 1 (pp_expr value.inside ^^ string ")")
+
+and pp_let_in {value; _} =
+  let {binding; kwd_rec; body; attributes; _} = value in
+  let let_str =
+    match kwd_rec with
+        None -> "let "
+    | Some _ -> "let rec " in
+  let bindings = pp_let_binding let_str binding
+  and attr    = pp_attributes attributes
+  in attr ^^ bindings
+     ^^ string ";" ^^ hardline ^^ pp_expr body
+
+and pp_fun {value; _} =
+  let {binders; lhs_type; body; _} = value in
+  let patterns = Utils.nseq_to_list binders in
+  let binders = group (separate_map (string "," ^^ break 0 ^^ string " ") pp_pattern patterns)
+  and annot   =
+    match lhs_type with
+      None -> empty
+    | Some (_,e) ->
+        group (break 0 ^^ string ": " ^^ nest 2 (pp_type_expr e))
+  in
+  match body with
+  | ESeq _ -> string "(" ^^ nest 1 binders ^^ string ")" ^^ annot ^^ string " => " ^^ pp_expr body
+  | _ -> (prefix 2 0 (string "(" ^^ nest 1 binders ^^ string ")" ^^ annot
+     ^^ string " => ") (pp_expr body))
+
+and pp_seq {value; _} =
+  let {compound; elements; _} = value in
+  let sep = string ";" ^^ hardline in
+  let elements = Utils.sepseq_to_list elements in
+  let elements = separate_map sep pp_expr elements in
+  match pp_compound compound with
+    None -> elements
+  | Some (opening, closing) ->
+     string opening
+     ^^ nest 2 (hardline ^^ elements) ^^ hardline
+     ^^ string closing
+
+and pp_type_expr = function
+  TProd t   -> pp_cartesian t
+| TSum t    -> break 0 ^^ pp_variants t
+| TRecord t -> pp_fields t
+| TApp t    -> pp_type_app t
+| TFun t    -> pp_fun_type t
+| TPar t    -> pp_type_par t
+| TVar t    -> pp_ident t
+| TString s -> pp_string s
+
+and pp_cartesian {value; _} =
+  let head, tail = value in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items
+  in
+  string "(" ^^ nest 1 (pp_type_expr head ^^ (if tail <> [] then string "," else empty) ^^ app (List.map snd tail)) ^^ string ")"
+
+and pp_variants {value; _} =
+  let head, tail = value in
+  let head = pp_variant head in
+  let head = if tail = [] then head
+             else ifflat head (string "  " ^^ head) in
+  let rest = List.map snd tail in
+  let app variant = break 1 ^^ string "| " ^^ pp_variant variant
+  in head ^^ concat_map app rest
+
+and pp_variant {value; _} =
+  let {constr; arg} = value in
+  match arg with
+    None -> pp_ident constr
+  | Some (_, e) ->
+      prefix 2 0 (pp_ident constr) (string "(" ^^ pp_type_expr e ^^ string ")")
+
+and pp_fields fields = group (pp_ne_injection pp_field_decl fields)
+
+and pp_field_decl {value; _} =
+  let {field_name; field_type; _} = value in
+  let name = pp_ident field_name in
+  match field_type with
+  | TVar v when v = field_name ->
+    name
+  | _ ->
+    let t_expr = pp_type_expr field_type
+    in prefix 2 1 (name ^^ string ":") t_expr
+
+and pp_type_app {value; _} =
+  let ctor, tuple = value in
+  prefix 2 0 (pp_type_constr ctor) (string "(" ^^ nest 1 (pp_type_tuple tuple) ^^ string ")")
+
+and pp_type_tuple {value; _} =
+  let head, tail = value.inside in
+  let rec app = function
+    []  -> empty
+  | [e] -> group (break 1 ^^ pp_type_expr e)
+  | e::items ->
+      group (break 1 ^^ pp_type_expr e ^^ string ",") ^^ app items in
+  if tail = []
+  then pp_type_expr head
+  else
+    let components =
+      pp_type_expr head ^^ string "," ^^ app (List.map snd tail)
+    in components
+
+and pp_type_constr ctor = string ctor.value
+
+and pp_fun_args {value; _} =
+  let lhs, _, rhs = value in
+  match rhs with
+  | TFun tf -> group (pp_type_expr lhs ^^ string ", " ^^ pp_fun_args tf)
+  | _ -> group (pp_type_expr lhs ^^ string ")" ^^ string " =>" ^/^ pp_type_expr rhs)
+
+and pp_fun_type {value; _} =
+  let lhs, _, rhs = value in
+  match lhs, rhs with
+  | _, TFun tf -> string "(" ^^ pp_type_expr lhs ^^ string ", " ^^ pp_fun_args tf
+  | TVar _ , _ -> group (pp_type_expr lhs ^^ string " =>" ^/^ pp_type_expr rhs)
+  | _ -> group (string "(" ^^ nest 1 (pp_type_expr lhs) ^^ string ")" ^^ string " =>" ^/^ pp_type_expr rhs)
+
+and pp_type_par {value; _} =
+  string "(" ^^ nest 1 (pp_type_expr value.inside ^^ string ")")

src/passes/01-parser/reasonligo/dune

@@ -15,7 +15,7 @@
  (name parser_reasonligo)
  (public_name ligo.parser.reasonligo)
  (modules
-    SyntaxError reasonligo LexToken ParErr Parser)
+    SyntaxError reasonligo LexToken ParErr Parser Pretty)
  (libraries
     menhirLib
     parser_shared

src/passes/01-parser/shared/EvalOpt.ml

@@ -29,11 +29,12 @@ type options = <
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
-  expr    : bool
+  expr    : bool;
+  pretty  : bool
 >
 
 let make ~input ~libs ~verbose ~offsets ?block
-         ?line ~ext ~mode ~cmd ~mono ~expr : options =
+         ?line ~ext ~mode ~cmd ~mono ~expr ~pretty : options =
   object
     method input   = input
     method libs    = libs
@@ -46,6 +47,7 @@ let make ~input ~libs ~verbose ~offsets ?block
     method cmd     = cmd
     method mono    = mono
     method expr    = expr
+    method pretty  = pretty
   end
 
 (* Auxiliary functions *)
@@ -77,6 +79,7 @@ let help extension () =
   print "      --bytes            Bytes for source locations";
   print "      --mono             Use Menhir monolithic API";
   print "      --expr             Parse an expression";
+  print "      --pretty           Pretty-print the input";
   print "      --verbose=<stages> cli, preproc, ast-tokens, ast (colon-separated)";
   print "      --version          Commit hash on stdout";
   print "  -h, --help             This help";
@@ -100,6 +103,7 @@ and libs     = ref []
 and verb_str = ref ""
 and mono     = ref false
 and expr     = ref false
+and pretty   = ref false
 
 let split_at_colon = Str.(split (regexp ":"))
 
@@ -121,6 +125,7 @@ let specs extension =
     noshort, "bytes",   set bytes true, None;
     noshort, "mono",    set mono true, None;
     noshort, "expr",    set expr true, None;
+    noshort, "pretty",  set pretty true, None;
     noshort, "verbose", None, Some add_verbose;
     'h',     "help",    Some (help extension), None;
     noshort, "version", Some version, None
@@ -156,6 +161,7 @@ let print_opt () =
   printf "bytes    = %b\n" !bytes;
   printf "mono     = %b\n" !mono;
   printf "expr     = %b\n" !expr;
+  printf "pretty   = %b\n" !pretty;
   printf "verbose  = %s\n" !verb_str;
   printf "input    = %s\n" (string_of quote !input);
   printf "libs     = %s\n" (string_of_path !libs)
@@ -185,6 +191,7 @@ let check ?block ?line ~ext =
   and mono    = !mono
   and expr    = !expr
   and verbose = !verbose
+  and pretty  = !pretty
   and libs    = !libs in
 
   let () =
@@ -199,6 +206,7 @@ let check ?block ?line ~ext =
         printf "mode     = %s\n" (if mode = `Byte then "`Byte" else "`Point");
         printf "mono     = %b\n" mono;
         printf "expr     = %b\n" expr;
+        printf "pretty   = %b\n" pretty;
         printf "verbose  = %s\n" !verb_str;
         printf "input    = %s\n" (string_of quote input);
         printf "libs     = %s\n" (string_of_path libs)
@@ -214,7 +222,7 @@ let check ?block ?line ~ext =
     | _ -> abort "Choose one of -q, -c, -u, -t."
 
   in make ~input ~libs ~verbose ~offsets ~mode
-          ~cmd ~mono ~expr ?block ?line ~ext
+          ~cmd ~mono ~expr ?block ?line ~ext ~pretty
 
 (* Parsing the command-line options *)
 

src/passes/01-parser/shared/EvalOpt.mli

@@ -47,6 +47,9 @@ type command = Quiet | Copy | Units | Tokens
       {li If the field [expr] is [true], then the parser for
           expressions is used, otherwise a full-fledged contract is
           expected.}
+
+       {li If the field [pretty] is [true], then the source is
+           pretty-printed on the standard out.}
     } *)
 
 module SSet : Set.S with type elt = string and type t = Set.Make(String).t
@@ -67,7 +70,8 @@ type options = <
   mode    : [`Byte | `Point];
   cmd     : command;
   mono    : bool;
-  expr    : bool
+  expr    : bool;
+  pretty  : bool
 >
 
 val make :
@@ -82,6 +86,7 @@ val make :
   cmd:command ->
   mono:bool ->
   expr:bool ->
+  pretty:bool ->
   options
 
 (** Parsing the command-line options on stdin. *)

src/passes/01-parser/shared/ParserUnit.ml

@@ -15,7 +15,8 @@ module type SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     val options : options
@@ -31,7 +32,7 @@ module type Printer =
     val mk_state :
       offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
 
-    val pp_ast       : state -> ast -> unit
+    val pp_cst       : state -> ast -> unit
     val pp_expr      : state -> expr -> unit
     val print_tokens : state -> ast -> unit
     val print_expr   : state -> expr -> unit
@@ -145,7 +146,7 @@ module Make (Lexer: Lexer.S)
         if SSet.mem "ast" SubIO.options#verbose then
           begin
             Buffer.clear output;
-            ParserLog.pp_ast state ast;
+            ParserLog.pp_cst state ast;
             Buffer.output_buffer stdout output
           end
       in flush_all (); close (); Ok ast

src/passes/01-parser/shared/ParserUnit.mli

@@ -17,7 +17,8 @@ module type SubIO =
       ext     : string;
       mode    : [`Byte | `Point];
       cmd     : EvalOpt.command;
-      mono    : bool
+      mono    : bool;
+      pretty  : bool
     >
 
     val options : options
@@ -35,7 +36,7 @@ module type Printer =
     val mk_state :
       offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state
 
-    val pp_ast       : state -> ast -> unit
+    val pp_cst       : state -> ast -> unit
     val pp_expr      : state -> expr -> unit
     val print_tokens : state -> ast -> unit
     val print_expr   : state -> expr -> unit

src/passes/02-concrete_to_imperative/cameligo.ml

@@ -352,38 +352,32 @@ let rec compile_expression :
   let compile_selection : Raw.selection -> access = fun s ->
     match s with
     | FieldName property -> Access_record property.value
-    | Component index -> (Access_tuple (snd index.value))
+    | Component index -> (Access_tuple (snd index.value)) in
-  in
+
-  let compile_path : Raw.path -> string * access list = fun p ->
+  let compile_path : Raw.path -> string * access list = function
-    match p with
+      Raw.Name v -> v.value, []
-    | Raw.Name v -> (v.value , [])
+    | Raw.Path {value; _} ->
-    | Raw.Path p -> (
+       let Raw.{struct_name; field_path; _} = value in
-        let p' = p.value in
+       let var  = struct_name.value in
-        let var = p'.struct_name.value in
+       let path = List.map compile_selection @@ npseq_to_list field_path
-        let path = p'.field_path in
+       in var, path in
-        let path' = List.map compile_selection @@ npseq_to_list path in
+
-        (var , path')
+let compile_update (u: Raw.update Region.reg) =
-      )
+  let u, loc     = r_split u in
-  in
+  let name, path = compile_path u.record in
-  let compile_update = fun (u:Raw.update Region.reg) ->
+  let var        = e_variable (Var.of_name name) in
-    let (u, loc) = r_split u in
+  let record     = if path = [] then var else e_accessor var path in
-    let (name, path) = compile_path u.record in
-    let record = match path with
-    | [] -> e_variable (Var.of_name name)
-    | _ -> e_accessor (e_variable (Var.of_name name)) path in 
   let updates    = u.updates.value.ne_elements in
   let%bind updates' =
-      let aux (f:Raw.field_path_assign Raw.reg) =
+    let aux (f: Raw.field_path_assignment Raw.reg) =
-        let (f,_) = r_split f in
+      let f, _ = r_split f in
-        let%bind expr = compile_expression f.field_expr in
+      let%bind expr = compile_expression f.field_expr
-          ok ( List.map compile_selection (npseq_to_list f.field_path), expr)
+      in ok (compile_path f.field_path, expr)
-      in
+    in bind_map_list aux @@ npseq_to_list updates in
-      bind_map_list aux @@ npseq_to_list updates
+  let aux ur ((var, path), expr) =
-    in
+    ok @@ e_update ~loc ur (Access_record var :: path) expr
-    let aux ur (path, expr) = ok @@ e_update ~loc ur path expr in
+  in bind_fold_list aux record updates'
-    bind_fold_list aux record updates'
+in trace (abstracting_expr t) @@
-  in
-  trace (abstracting_expr t) @@
   match t with
     Raw.ELetIn e ->
       let Raw.{kwd_rec; binding; body; attributes; _} = e.value in

src/passes/02-concrete_to_imperative/pascaligo.ml

@@ -152,7 +152,7 @@ let return_statement expr = ok @@ fun expr'_opt ->
   | Some expr' -> ok @@ e_sequence expr expr'
 
 let get_t_string_singleton_opt = function
-  | Raw.TStringLiteral s -> Some s.value
+  | Raw.TString s -> Some s.value
   | _ -> None
 
 
@@ -252,7 +252,7 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result =
         @@ npseq_to_list s in
       let m = List.fold_left (fun m ((x,i), y) -> CMap.add (Constructor x) {ctor_type=y;ctor_decl_pos=i} m) CMap.empty lst in
       ok @@ make_t ~loc @@ T_sum m
-  | TStringLiteral _s -> simple_fail "we don't support singleton string type"
+  | TString _s -> simple_fail "we don't support singleton string type"
 
 and compile_list_type_expression (lst:Raw.type_expr list) : type_expression result =
   match lst with
@@ -282,7 +282,8 @@ let rec compile_expression (t:Raw.expr) : expr result =
   let return x = ok x in
   match t with
   | EAnnot a -> (
-      let ((expr , type_expr) , loc) = r_split a in
+      let par, loc = r_split a in
+      let expr, _, type_expr = par.inside in
       let%bind expr' = compile_expression expr in
       let%bind type_expr' = compile_type_expression type_expr in
       return @@ e_annotation ~loc expr' type_expr'
@@ -327,7 +328,8 @@ let rec compile_expression (t:Raw.expr) : expr result =
   | ERecord r ->
       let%bind fields = bind_list
         @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = compile_expression v in ok (k.value, v))
-        @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
+        @@ List.map (fun (x:Raw.field_assignment Raw.reg) ->
+                      (x.value.field_name, x.value.field_expr))
         @@ npseq_to_list r.value.ne_elements in
       let aux prev (k, v) = SMap.add k v prev in
       return @@ e_record (List.fold_left aux SMap.empty fields)
@@ -457,37 +459,28 @@ let rec compile_expression (t:Raw.expr) : expr result =
     let (f , loc) = r_split f in
     let%bind (_ty_opt, f') = compile_fun_expression ~loc f
     in return @@ f'
-
+and compile_update (u: Raw.update Region.reg) =
-
+  let u, loc     = r_split u in
-and compile_update = fun (u:Raw.update Region.reg) ->
+  let name, path = compile_path u.record in
-  let (u, loc) = r_split u in
+  let var        = e_variable (Var.of_name name) in
-  let (name, path) = compile_path u.record in
+  let record     = if path = [] then var else e_accessor var path in
-  let record = match path with
-  | [] -> e_variable (Var.of_name name)
-  | _ -> e_accessor (e_variable (Var.of_name name)) path in 
   let updates    = u.updates.value.ne_elements in
   let%bind updates' =
-    let aux (f:Raw.field_path_assign Raw.reg) =
+    let aux (f: Raw.field_path_assignment Raw.reg) =
-      let (f,_) = r_split f in
+      let f, _ = r_split f in
-      let%bind expr = compile_expression f.field_expr in
+      let%bind expr = compile_expression f.field_expr
-        ok ( List.map compile_selection (npseq_to_list f.field_path), expr)
+      in ok (compile_path f.field_path, expr)
-    in
+    in bind_map_list aux @@ npseq_to_list updates in
-    bind_map_list aux @@ npseq_to_list updates
+  let aux ur ((var, path), expr) =
-  in
+    ok @@ e_update ~loc ur (Access_record var :: path) expr
-  let aux ur (path, expr) = ok @@ e_update ~loc ur path expr in
+  in bind_fold_list aux record updates'
-  bind_fold_list aux record updates'
 
 and compile_logic_expression (t:Raw.logic_expr) : expression result =
-  let return x = ok x in
   match t with
-  | BoolExpr (False reg) -> (
+  | BoolExpr (False reg) ->
-      let loc = Location.lift reg in
+      ok @@ e_bool ~loc:(Location.lift reg) false
-      return @@ e_bool ~loc false
+  | BoolExpr (True reg) ->
-    )
+     ok @@ e_bool ~loc:(Location.lift reg) true
-  | BoolExpr (True reg) -> (
-      let loc = Location.lift reg in
-      return @@ e_bool ~loc true
-    )
   | BoolExpr (Or b) ->
       compile_binop "OR" b
   | BoolExpr (And b) ->
@@ -690,7 +683,7 @@ and compile_fun_expression :
   loc:_ -> Raw.fun_expr -> (type_expression option * expression) result =
   fun ~loc x ->
   let open! Raw in
-  let {kwd_recursive;param;ret_type;return} : fun_expr = x in
+  let {param; ret_type; return; _} : fun_expr = x in
   let statements = [] in
   (match param.value.inside with
     a, [] -> (
@@ -706,10 +699,8 @@ and compile_fun_expression :
           bind_fold_right_list aux result body in
         let binder = Var.of_name binder in
         let fun_type = t_function input_type output_type in
-        let expression = match kwd_recursive with
+        let expression =
-          | None -> e_lambda ~loc binder (Some input_type)(Some output_type) result
+          e_lambda ~loc binder (Some input_type)(Some output_type) result
-          | Some _ -> e_recursive ~loc binder fun_type 
-          @@ {binder;input_type=Some input_type; output_type= Some output_type; result}
         in
         ok (Some fun_type , expression)
       )
@@ -737,10 +728,8 @@ and compile_fun_expression :
          let aux prec cur = cur (Some prec) in
          bind_fold_right_list aux result body in
       let fun_type = t_function input_type output_type in
-      let expression = match kwd_recursive with
+      let expression =
-        | None -> e_lambda ~loc binder (Some input_type)(Some output_type) result
+        e_lambda ~loc binder (Some input_type)(Some output_type) result
-        | Some _ -> e_recursive ~loc binder fun_type 
-        @@ {binder;input_type=Some input_type; output_type= Some output_type; result}
       in
       ok (Some fun_type , expression)
      )
@@ -814,7 +803,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let%bind bound = compile_expression fi.bound in
       let%bind step = match fi.step with
         | None -> ok @@ e_int_z Z.one
-        | Some step -> compile_expression step in
+        | Some (_, step) -> compile_expression step in
       let%bind body = compile_block fi.block.value in
       let%bind body = body @@ None in
       return_statement @@ e_for ~loc binder start bound step body
@@ -861,26 +850,26 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let (a , loc) = r_split a in
       let%bind value_expr = compile_expression a.rhs in
       match a.lhs with
-        | Path path -> (
+        | Path path ->
-            let (name , path') = compile_path path in
+            let name , path' = compile_path path in
             let name = Var.of_name name in
             return_statement @@ e_assign ~loc name path' value_expr
-          )
+        | MapPath v ->
-        | MapPath v -> (
             let v' = v.value in
             let%bind (varname,map,path) = match v'.path with
-              | Name name -> ok (name.value , e_variable (Var.of_name name.value), [])
+              | Name name ->
+                  ok (name.value ,
+                      e_variable (Var.of_name name.value), [])
               | Path p ->
-                let (name,p') = compile_path v'.path in
+                  let name, p' = compile_path v'.path in
                   let%bind accessor = compile_projection p in
-                ok @@ (name , accessor , p')
+                  ok @@ (name, accessor, p') in
-            in
+            let%bind key_expr =
-            let%bind key_expr = compile_expression v'.index.value.inside in
+              compile_expression v'.index.value.inside in
             let expr' = e_map_add key_expr value_expr map in
             let varname = Var.of_name varname in
             return_statement @@ e_assign ~loc varname path expr'
     )
-    )
   | CaseInstr c -> (
       let (c , loc) = r_split c in
       let%bind expr = compile_expression c.expr in
@@ -904,27 +893,28 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let%bind m = compile_cases cases in
       return_statement @@ e_matching ~loc expr m
     )
-  | RecordPatch r -> (
+  | RecordPatch r ->
       let reg = r.region in
-      let (r,loc) = r_split r in
+      let r, loc = r_split r in
-      let aux (fa :Raw.field_assign Raw.reg) : Raw.field_path_assign Raw.reg=
+      let aux (fa: Raw.field_assignment Raw.reg) : Raw.field_path_assignment Raw.reg =
-         {value = {field_path = (FieldName fa.value.field_name, []); equal=fa.value.equal; field_expr = fa.value.field_expr};
+        {value = {field_path = Name fa.value.field_name;
-         region = fa.region}
+                  assignment = fa.value.assignment;
-      in
+                  field_expr = fa.value.field_expr};
-      let update : Raw.field_path_assign Raw.reg Raw.ne_injection Raw.reg = {
+         region = fa.region} in
+      let update : Raw.field_path_assignment Raw.reg Raw.ne_injection Raw.reg = {
         value  = Raw.map_ne_injection aux r.record_inj.value;
-        region=r.record_inj.region
+        region = r.record_inj.region} in
-        } in
+      let u : Raw.update = {
-      let u : Raw.update = {record=r.path;kwd_with=r.kwd_with; updates=update} in
+          record   = r.path;
+          kwd_with = r.kwd_with;
+          updates  = update} in
       let%bind expr = compile_update {value=u;region=reg} in
-      let (name , access_path) = compile_path r.path in
+      let name, access_path = compile_path r.path in
       let name = Var.of_name name in
       return_statement @@ e_assign ~loc name access_path expr
-
+  | MapPatch patch ->
-  )
+      let map_p, loc = r_split patch in
-  | MapPatch patch -> (
+      let name, access_path = compile_path map_p.path in
-      let (map_p, loc) = r_split patch in
-      let (name, access_path) = compile_path map_p.path in
       let%bind inj = bind_list
           @@ List.map (fun (x:Raw.binding Region.reg) ->
             let x = x.value in
@@ -934,20 +924,18 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
             in ok @@ (key', value')
           )
         @@ npseq_to_list map_p.map_inj.value.ne_elements in
-      match inj with
+      (match inj with
       | [] -> return_statement @@ e_skip ~loc ()
       | _ :: _ ->
         let assigns = List.fold_right
             (fun (key, value) map ->  (e_map_add key value map))
             inj
             (e_accessor ~loc (e_variable (Var.of_name name)) access_path)
-        in 
+        and name = Var.of_name name in
-        let name = Var.of_name name in
+        return_statement @@ e_assign ~loc name access_path assigns)
-        return_statement @@ e_assign ~loc name access_path assigns
-    )
   | SetPatch patch -> (
-      let (setp, loc) = r_split patch in
+      let setp, loc = r_split patch in
-      let (name , access_path) = compile_path setp.path in
+      let name, access_path = compile_path setp.path in
       let%bind inj =
         bind_list @@
         List.map compile_expression @@
@@ -961,13 +949,13 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
         let name = Var.of_name name in
         return_statement @@ e_assign ~loc name access_path assigns
     )
-  | MapRemove r -> (
+  | MapRemove r ->
       let (v , loc) = r_split r in
       let key = v.key in
       let%bind (name,map,path) = match v.map with
         | Name v -> ok (v.value , e_variable (Var.of_name v.value) , [])
         | Path p ->
-          let (name,p') = compile_path v.map in
+          let name, p' = compile_path v.map in
           let%bind accessor = compile_projection p in
           ok @@ (name , accessor , p')
       in
@@ -975,37 +963,32 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
       let expr = e_constant ~loc C_MAP_REMOVE [key' ; map] in
       let name = Var.of_name name in
       return_statement @@ e_assign ~loc name path expr
-    )
+  | SetRemove r ->
-  | SetRemove r -> (
+      let set_rm, loc = r_split r in
-      let (set_rm, loc) = r_split r in
+      let%bind (name, set, path) =
-      let%bind (name, set, path) = match set_rm.set with
+        match set_rm.set with
-        | Name v -> ok (v.value, e_variable (Var.of_name v.value), [])
+        | Name v ->
+            ok (v.value, e_variable (Var.of_name v.value), [])
         | Path path ->
-          let(name, p') = compile_path set_rm.set in
+            let name, p' = compile_path set_rm.set in
             let%bind accessor = compile_projection path in
-          ok @@ (name, accessor, p')
+            ok @@ (name, accessor, p') in
-      in
       let%bind removed' = compile_expression set_rm.element in
       let expr = e_constant ~loc C_SET_REMOVE [removed' ; set] in
       let name = Var.of_name name in
       return_statement @@ e_assign ~loc name path expr
-    )
 
-and compile_path : Raw.path -> string * access list = fun p ->
+and compile_path : Raw.path -> string * access list = function
-  match p with
+  Raw.Name v -> v.value, []
-  | Raw.Name v -> (v.value , [])
+| Raw.Path {value; _} ->
-  | Raw.Path p -> (
+    let Raw.{struct_name; field_path; _} = value in
-      let p' = p.value in
+    let var  = struct_name.value in
-      let var = p'.struct_name.value in
+    let path = List.map compile_selection @@ npseq_to_list field_path
-      let path = p'.field_path in
+    in var, path
-      let path' = List.map compile_selection @@ npseq_to_list path in
-      (var , path')
-    )
 
-and compile_selection : Raw.selection -> access = fun s ->
+and compile_selection : Raw.selection -> access = function
-  match s with
+  FieldName property -> Access_record property.value
-  | FieldName property -> Access_record property.value
+| Component index    -> Access_tuple (snd index.value)
-  | Component index -> (Access_tuple (snd index.value))
 
 and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fun t ->
   let open Raw in

src/test/contracts/expected/FA1.2.ligo.expected

@@ -0,0 +1,172 @@
+type tokens is big_map (address, nat)
+
+type allowances is big_map (address * address, nat)
+
+type storage is
+  record [
+    tokens : tokens;
+    allowances : allowances;
+    total_amount : nat
+  ]
+
+type transfer is
+  record [
+    address_from : address;
+    address_to : address;
+    value : nat
+  ]
+
+type approve is record [spender : address; value : nat]
+
+type getAllowance is
+  record [
+    owner : address;
+    spender : address;
+    callback : contract (nat)
+  ]
+
+type getBalance is
+  record [owner : address; callback : contract (nat)]
+
+type getTotalSupply is record [callback : contract (nat)]
+
+type action is
+    Transfer of transfer
+  | Approve of approve
+  | GetAllowance of getAllowance
+  | GetBalance of getBalance
+  | GetTotalSupply of getTotalSupply
+
+function transfer (const p : transfer; const s : storage)
+  : list (operation) * storage is
+block {
+  var new_allowances : allowances := Big_map.empty;
+  if Tezos.sender = p.address_from
+  then {
+    new_allowances := s.allowances
+  }
+  else {
+    var authorized_value : nat
+    := case (Big_map.find_opt
+              ((Tezos.sender, p.address_from), s.allowances))
+      of [
+        Some (value) -> value
+      | None -> 0n
+      ];
+    if (authorized_value < p.value)
+    then {
+      failwith ("Not Enough Allowance")
+    }
+    else {
+      new_allowances :=
+        Big_map.update
+          ((Tezos.sender, p.address_from),
+           (Some (abs (authorized_value - p.value))),
+           s.allowances)
+    }
+  };
+  var sender_balance : nat
+  := case (Big_map.find_opt (p.address_from, s.tokens)) of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var new_tokens : tokens := Big_map.empty;
+  if (sender_balance < p.value)
+  then {
+    failwith ("Not Enough Balance")
+  }
+  else {
+    new_tokens :=
+      Big_map.update
+        (p.address_from,
+         (Some (abs (sender_balance - p.value))), s.tokens);
+    var receiver_balance : nat
+    := case (Big_map.find_opt (p.address_to, s.tokens)) of [
+        Some (value) -> value
+      | None -> 0n
+      ];
+    new_tokens :=
+      Big_map.update
+        (p.address_to, (Some (receiver_balance + p.value)),
+         new_tokens)
+  }
+} with
+    ((nil : list (operation)),
+     s with
+       record [
+         tokens = new_tokens;
+         allowances = new_allowances
+       ])
+
+function approve (const p : approve; const s : storage)
+  : list (operation) * storage is
+block {
+  var previous_value : nat
+  := case Big_map.find_opt
+           ((p.spender, Tezos.sender), s.allowances)
+    of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var new_allowances : allowances := Big_map.empty;
+  if previous_value > 0n and p.value > 0n
+  then {
+    failwith ("Unsafe Allowance Change")
+  }
+  else {
+    new_allowances :=
+      Big_map.update
+        ((p.spender, Tezos.sender), (Some (p.value)),
+         s.allowances)
+  }
+} with
+    ((nil : list (operation)),
+     s with
+       record [allowances = new_allowances])
+
+function getAllowance
+  (const p : getAllowance;
+   const s : storage) : list (operation) * storage is
+block {
+  var value : nat
+  := case Big_map.find_opt
+           ((p.owner, p.spender), s.allowances)
+    of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var op : operation
+  := Tezos.transaction (value, 0mutez, p.callback)
+} with (list [op], s)
+
+function getBalance
+  (const p : getBalance;
+   const s : storage) : list (operation) * storage is
+block {
+  var value : nat
+  := case Big_map.find_opt (p.owner, s.tokens) of [
+      Some (value) -> value
+    | None -> 0n
+    ];
+  var op : operation
+  := Tezos.transaction (value, 0mutez, p.callback)
+} with (list [op], s)
+
+function getTotalSupply
+  (const p : getTotalSupply;
+   const s : storage) : list (operation) * storage is
+block {
+  var total : nat := s.total_amount;
+  var op : operation
+  := Tezos.transaction (total, 0mutez, p.callback)
+} with (list [op], s)
+
+function main (const a : action; const s : storage)
+  : list (operation) * storage is
+  case a of [
+    Transfer (p) -> transfer (p, s)
+  | Approve (p) -> approve (p, s)
+  | GetAllowance (p) -> getAllowance (p, s)
+  | GetBalance (p) -> getBalance (p, s)
+  | GetTotalSupply (p) -> getTotalSupply (p, s)
+  ]

src/test/contracts/expected/FA1.2.mligo.expected

@@ -0,0 +1,136 @@
+type tokens = (address, nat) big_map
+
+type allowances = (address * address, nat) big_map
+
+type storage =
+  {tokens : tokens;
+   allowances : allowances;
+   total_amount : nat}
+
+type transfer =
+  {address_from : address;
+   address_to : address;
+   value : nat}
+
+type approve = {spender : address; value : nat}
+
+type getAllowance =
+  {owner : address;
+   spender : address;
+   callback : nat contract}
+
+type getBalance = {owner : address; callback : nat contract}
+
+type getTotalSupply = {callback : nat contract}
+
+type action =
+  Transfer of transfer
+| Approve of approve
+| GetAllowance of getAllowance
+| GetBalance of getBalance
+| GetTotalSupply of getTotalSupply
+
+let transfer (p, s : transfer * storage)
+: operation list * storage =
+  let new_allowances =
+    if Tezos.sender = p.address_from
+    then s.allowances
+    else
+      let authorized_value =
+        match Big_map.find_opt
+                (Tezos.sender, p.address_from)
+                s.allowances
+        with
+          Some value -> value
+        | None -> 0n
+      in if (authorized_value < p.value)
+         then (failwith "Not Enough Allowance" : allowances)
+         else
+           Big_map.update
+             (Tezos.sender, p.address_from)
+             (Some (abs (authorized_value - p.value)))
+             s.allowances
+  in let sender_balance =
+       match Big_map.find_opt p.address_from s.tokens with
+         Some value -> value
+       | None -> 0n
+     in if (sender_balance < p.value)
+        then
+          (failwith "Not Enough Balance"
+           : operation list * storage)
+        else
+          let new_tokens =
+            Big_map.update
+              p.address_from
+              (Some (abs (sender_balance - p.value)))
+              s.tokens
+          in let receiver_balance =
+               match Big_map.find_opt p.address_to s.tokens
+               with
+                 Some value -> value
+               | None -> 0n
+             in let new_tokens =
+                  Big_map.update
+                    p.address_to
+                    (Some (receiver_balance + p.value))
+                    new_tokens
+                in ([] : operation list),
+                   {s with
+                     tokens = new_tokens;
+                     allowances = new_allowances}
+
+let approve (p, s : approve * storage)
+: operation list * storage =
+  let previous_value =
+    match Big_map.find_opt
+            (p.spender, Tezos.sender)
+            s.allowances
+    with
+      Some value -> value
+    | None -> 0n
+  in if previous_value > 0n && p.value > 0n
+     then
+       (failwith "Unsafe Allowance Change"
+        : operation list * storage)
+     else
+       let new_allowances =
+         Big_map.update
+           (p.spender, Tezos.sender)
+           (Some (p.value))
+           s.allowances
+       in ([] : operation list),
+          {s with
+            allowances = new_allowances}
+
+let getAllowance (p, s : getAllowance * storage)
+: operation list * storage =
+  let value =
+    match Big_map.find_opt (p.owner, p.spender) s.allowances
+    with
+      Some value -> value
+    | None -> 0n
+  in let op = Tezos.transaction value 0mutez p.callback
+     in ([op], s)
+
+let getBalance (p, s : getBalance * storage)
+: operation list * storage =
+  let value =
+    match Big_map.find_opt p.owner s.tokens with
+      Some value -> value
+    | None -> 0n
+  in let op = Tezos.transaction value 0mutez p.callback
+     in ([op], s)
+
+let getTotalSupply (p, s : getTotalSupply * storage)
+: operation list * storage =
+  let total = s.total_amount
+  in let op = Tezos.transaction total 0mutez p.callback
+     in ([op], s)
+
+let main (a, s : action * storage) =
+  match a with
+    Transfer p -> transfer (p, s)
+  | Approve p -> approve (p, s)
+  | GetAllowance p -> getAllowance (p, s)
+  | GetBalance p -> getBalance (p, s)
+  | GetTotalSupply p -> getTotalSupply (p, s)

src/test/contracts/expected/address.ligo.expected

@@ -0,0 +1,4 @@
+function main (const p : key_hash) : address is
+block {
+  const c : contract (unit) = Tezos.implicit_account (p)
+} with Tezos.address (c)

src/test/contracts/expected/address.mligo.expected

@@ -0,0 +1,3 @@
+let main (p : key_hash) =
+  let c : unit contract = Tezos.implicit_account p
+  in Tezos.address c

src/test/contracts/expected/address.religo.expected

@@ -0,0 +1,4 @@
+let main = (p: key_hash): address => {
+  let c: contract(unit) = Tezos.implicit_account(p);
+  Tezos.address(c)
+};

src/test/contracts/expected/amount.ligo.expected

@@ -0,0 +1,7 @@
+function check (const p : unit) : int is
+block {
+  var result : int := 0;
+  if amount = 100000000mutez
+  then result := 42
+  else result := 0
+} with result

src/test/contracts/expected/amount.mligo.expected

@@ -0,0 +1,2 @@
+let check_ (p : unit) : int =
+  if Tezos.amount = 100000000mutez then 42 else 0

src/test/contracts/expected/amount.religo.expected

@@ -0,0 +1,6 @@
+let check_ = (p: unit): int => 
+  if (Tezos.amount == 100000000mutez) {
+    42
+  } else {
+    0
+  };

src/test/contracts/expected/amount_lambda.mligo.expected

@@ -0,0 +1,10 @@
+let f1 (x : unit) : unit -> tez =
+  let amt : tez = Current.amount
+  in fun (x : unit) -> amt
+
+let f2 (x : unit) : unit -> tez =
+  fun (x : unit) -> Current.amount
+
+let main (b, s : bool * (unit -> tez))
+: operation list * (unit -> tez) =
+  (([] : operation list), (if b then f1 () else f2 ()))

src/test/contracts/expected/annotation.ligo.expected

@@ -0,0 +1,4 @@
+const lst : list (int) = list []
+
+const my_address : address
+= ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" : address)

src/test/contracts/expected/application.ligo.expected

@@ -0,0 +1,13 @@
+type foo is record [bar : int -> int]
+
+function f (const i : int) : int is i
+
+function g (const i : unit) : int -> int is f
+
+const r : foo = record [bar = f]
+
+const x : int = f (42)
+
+const y : int = r.bar (42)
+
+const z : int = (g (unit)) (42)

src/test/contracts/expected/arithmetic.ligo.expected

@@ -0,0 +1,16 @@
+function mod_op (const n : int) : nat is n mod 42
+
+function plus_op (const n : int) : int is n + 42
+
+function minus_op (const n : int) : int is n - 42
+
+function times_op (const n : int) : int is n * 42
+
+function div_op (const n : int) : int is n / 2
+
+function int_op (const n : nat) : int is int (n)
+
+function neg_op (const n : int) : int is -n
+
+function ediv_op (const n : int) : option (int * nat) is
+  ediv (n, 2)

src/test/contracts/expected/arithmetic.mligo.expected

@@ -0,0 +1,17 @@
+let mod_op (n : int) : nat = n mod 42
+
+let plus_op (n : int) : int = n + 42
+
+let minus_op (n : int) : int = n - 42
+
+let times_op (n : int) : int = n * 42
+
+let div_op (n : int) : int = n / 2
+
+let neg_op (n : int) : int = -n
+
+let foo (n : int) : int = n + 10
+
+let neg_op_2 (b : int) : int = -(foo b)
+
+let ediv_op (n : int) : (int * nat) option = ediv n 2

src/test/contracts/expected/arithmetic.religo.expected

@@ -0,0 +1,17 @@
+let mod_op = (n: int): nat => n mod 42;
+
+let plus_op = (n: int): int => n + 42;
+
+let minus_op = (n: int): int => n - 42;
+
+let times_op = (n: int): int => n * 42;
+
+let div_op = (n: int): int => n / 2;
+
+let neg_op = (n: int): int => -n;
+
+let foo = (n: int): int => n + 10;
+
+let neg_op_2 = (b: int): int => -foo(b);
+
+let ediv_op = (n: int): option((int, nat)) => ediv(n, 2);

src/test/contracts/expected/assert.mligo.expected

@@ -0,0 +1,3 @@
+let main (p, s : bool * unit) =
+  let u : unit = assert p
+  in ([] : operation list), s

src/test/contracts/expected/assign.ligo.expected

@@ -0,0 +1,4 @@
+function main (const i : int) : int is
+block {
+  i := i + 1
+} with i

src/test/contracts/expected/attributes.ligo.expected

@@ -0,0 +1,24 @@
+const x : int = 1
+
+attributes ["inline"]
+
+function foo (const a : int) : int is
+block {
+  const test : int = 2 + a;
+  attributes ["inline"]
+} with test
+
+attributes ["inline"]
+
+const y : int = 1
+
+attributes ["inline"; "other"]
+
+function bar (const b : int) : int is
+block {
+  function test (const z : int) : int is
+  block {
+    const r : int = 2 + b + z
+  } with r;
+  attributes ["inline"; "foo"; "bar"]
+} with test (b)

src/test/contracts/expected/attributes.mligo.expected

@@ -0,0 +1,14 @@
+let x = 1 [@@inline]
+
+let foo (a : int) : int =
+  (let test = 2 + a [@@inline]
+   in test) [@@inline]
+
+let y = 1 [@@inline][@@other]
+
+let bar (b : int) : int =
+  let test = fun (z : int) -> 2 + b + z
+    [@@inline]
+    [@@foo]
+    [@@bar]
+  in test b

src/test/contracts/expected/bad_address_format.religo.expected

@@ -0,0 +1,2 @@
+let main = (parameter: int, storage: address) => 
+  ([] : list(operation), "KT1badaddr" : address);

src/test/contracts/expected/bad_timestamp.ligo.expected

@@ -0,0 +1,11 @@
+type parameter is unit
+
+type storage is timestamp
+
+type return is list (operation) * storage
+
+function main (const p : parameter; const s : storage)
+  : return is
+block {
+  var stamp : timestamp := ("badtimestamp" : timestamp)
+} with ((nil : list (operation)), stamp)

src/test/contracts/expected/bad_type_operator.ligo.expected

@@ -0,0 +1,12 @@
+type parameter is unit
+
+type binding is nat * nat
+
+type storage is map (binding)
+
+type return is list (operation) * storage
+
+function main
+  (const param : parameter;
+   const store : storage) : return is
+  ((nil : list (operation)), store)

src/test/contracts/expected/balance_constant.ligo.expected

@@ -0,0 +1,10 @@
+type parameter is unit
+
+type storage is tez
+
+type return is list (operation) * storage
+
+function main
+  (const param : parameter;
+   const store : storage) : return is
+  ((nil : list (operation)), Tezos.balance)

src/test/contracts/expected/balance_constant.mligo.expected

@@ -0,0 +1,8 @@
+type parameter = unit
+
+type storage = tez
+
+type return = operation list * storage
+
+let main (p, s : parameter * storage) : return =
+  ([] : operation list), Tezos.balance

src/test/contracts/expected/balance_constant.religo.expected

@@ -0,0 +1,6 @@
+type storage = tez;
+
+let main2 = (p: unit, s: storage) => 
+  ([] : list(operation), Tezos.balance);
+
+let main = (x: (unit, storage)) => main2(x[0], x[1]);

src/test/contracts/expected/basic.mligo.expected

@@ -0,0 +1,3 @@
+type toto = int
+
+let foo : toto = 42 + 127

src/test/contracts/expected/big_map.ligo.expected

@@ -0,0 +1,41 @@
+type parameter is unit
+
+type storage is big_map (int, int) * unit
+
+type return is list (operation) * storage
+
+function main (const p : parameter; const s : storage)
+  : return is
+block {
+  var toto : option (int) := Some (0);
+  toto := s.0 [23];
+  s.0 [2] := 444
+} with ((nil : list (operation)), s)
+
+type foo is big_map (int, int)
+
+function set_ (var n : int; var m : foo) : foo is
+block {
+  m [23] := n
+} with m
+
+function add (var n : int; var m : foo) : foo is set_ (n, m)
+
+function rm (var m : foo) : foo is
+block {
+  remove 42 from map m
+} with m
+
+function get (const m : foo) : option (int) is m [42]
+
+const empty_big_map : big_map (int, int) = big_map []
+
+const big_map1 : big_map (int, int)
+= big_map [23 -> 0; 42 -> 0]
+
+function mutimaps (const m : foo; const n : foo) : foo is
+block {
+  var bar : foo := m;
+  bar [42] := 0;
+  n [42] := get_force (42, bar)
+} with n

src/test/contracts/expected/big_map.mligo.expected

@@ -0,0 +1,22 @@
+type foo = (int, int) big_map
+
+let set_ (n, m : int * foo) : foo =
+  Big_map.update 23 (Some n) m
+
+let add (n, m : int * foo) : foo = Big_map.add 23 n m
+
+let rm (m : foo) : foo = Big_map.remove 42 m
+
+let gf (m : foo) : int = Big_map.find 23 m
+
+let get (m : foo) : int option = Big_map.find_opt 42 m
+
+let empty_map : foo = Big_map.empty
+
+let map1 : foo = Big_map.literal [(23, 0); (42, 0)]
+
+let map1 : foo = Big_map.literal [(23, 0); (42, 0)]
+
+let mutimaps (m : foo) (n : foo) : foo =
+  let bar : foo = Big_map.update 42 (Some 0) m
+  in Big_map.update 42 (get bar) n

src/test/contracts/expected/bitwise_arithmetic.ligo.expected

@@ -0,0 +1,11 @@
+function or_op (const n : nat) : nat is Bitwise.or (n, 4n)
+
+function and_op (const n : nat) : nat is Bitwise.and (n, 7n)
+
+function xor_op (const n : nat) : nat is Bitwise.xor (n, 7n)
+
+function lsl_op (const n : nat) : nat is
+  Bitwise.shift_left (n, 7n)
+
+function lsr_op (const n : nat) : nat is
+  Bitwise.shift_right (n, 7n)

src/test/contracts/expected/bitwise_arithmetic.mligo.expected

@@ -0,0 +1,9 @@
+let or_op (n : nat) : nat = Bitwise.or n 4n
+
+let and_op (n : nat) : nat = Bitwise.and n 7n
+
+let xor_op (n : nat) : nat = Bitwise.xor n 7n
+
+let lsl_op (n : nat) : nat = Bitwise.shift_left n 7n
+
+let lsr_op (n : nat) : nat = Bitwise.shift_right n 7n

src/test/contracts/expected/bitwise_arithmetic.religo.expected

@@ -0,0 +1,9 @@
+let or_op = (n: nat): nat => Bitwise.or(n, 4n);
+
+let and_op = (n: nat): nat => Bitwise.and(n, 7n);
+
+let xor_op = (n: nat): nat => Bitwise.xor(n, 7n);
+
+let lsl_op = (n: nat): nat => Bitwise.shift_left(n, 7n);
+
+let lsr_op = (n: nat): nat => Bitwise.shift_right(n, 7n);

src/test/contracts/expected/blockless.ligo.expected

@@ -0,0 +1 @@
+function blockless (const n : int) : int is n + 10

src/test/contracts/expected/boolean_operators.ligo.expected

@@ -0,0 +1,9 @@
+function or_true (const b : bool) : bool is b or True
+
+function or_false (const b : bool) : bool is b or False
+
+function and_true (const b : bool) : bool is b and True
+
+function and_false (const b : bool) : bool is b and False
+
+function not_bool (const b : bool) : bool is not b

src/test/contracts/expected/boolean_operators.mligo.expected

@@ -0,0 +1,9 @@
+let or_true (b : bool) : bool = b || true
+
+let or_false (b : bool) : bool = b || false
+
+let and_true (b : bool) : bool = b && true
+
+let and_false (b : bool) : bool = b && false
+
+let not_bool (b : bool) : bool = not b

src/test/contracts/expected/boolean_operators.religo.expected

@@ -0,0 +1,9 @@
+let or_true = (b: bool): bool => b || true;
+
+let or_false = (b: bool): bool => b || false;
+
+let and_true = (b: bool): bool => b && true;
+
+let and_false = (b: bool): bool => b && false;
+
+let not_bool = (b: bool): bool => ! b;

src/test/contracts/expected/bytes_arithmetic.ligo.expected

@@ -0,0 +1,8 @@
+function concat_op (const s : bytes) : bytes is
+  Bytes.concat (s, 0x7070)
+
+function slice_op (const s : bytes) : bytes is
+  Bytes.sub (1n, 2n, s)
+
+function hasherman (const s : bytes) : bytes is
+  Crypto.sha256 (s)

src/test/contracts/expected/bytes_arithmetic.mligo.expected

@@ -0,0 +1,5 @@
+let concat_op (s : bytes) : bytes = Bytes.concat s 0x7070
+
+let slice_op (s : bytes) : bytes = Bytes.sub 1n 2n s
+
+let hasherman (s : bytes) : bytes = Crypto.sha256 s

src/test/contracts/expected/bytes_arithmetic.religo.expected

@@ -0,0 +1,5 @@
+let concat_op = (s: bytes): bytes => Bytes.concat(s, 0x7070);
+
+let slice_op = (s: bytes): bytes => Bytes.slice(1n, 2n, s);
+
+let hasherman = (s: bytes): bytes => Crypto.sha256(s);

src/test/contracts/expected/bytes_unpack.ligo.expected

@@ -0,0 +1,15 @@
+function id_string (const p : string) : option (string) is
+block {
+  const packed : bytes = Bytes.pack (p)
+} with (Bytes.unpack (packed) : option (string))
+
+function id_int (const p : int) : option (int) is
+block {
+  const packed : bytes = Bytes.pack (p)
+} with (Bytes.unpack (packed) : option (int))
+
+function id_address (const p : address)
+  : option (address) is
+block {
+  const packed : bytes = Bytes.pack (p)
+} with (Bytes.unpack (packed) : option (address))

src/test/contracts/expected/bytes_unpack.mligo.expected

@@ -0,0 +1,11 @@
+let id_string (p : string) : string option =
+  let packed : bytes = Bytes.pack p
+  in (Bytes.unpack packed : string option)
+
+let id_int (p : int) : int option =
+  let packed : bytes = Bytes.pack p
+  in (Bytes.unpack packed : int option)
+
+let id_address (p : address) : address option =
+  let packed : bytes = Bytes.pack p
+  in (Bytes.unpack packed : address option)

src/test/contracts/expected/bytes_unpack.religo.expected

@@ -0,0 +1,14 @@
+let id_string = (p: string): option(string) => {
+  let packed: bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)) : option(string))
+};
+
+let id_int = (p: int): option(int) => {
+  let packed: bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)) : option(int))
+};
+
+let id_address = (p: address): option(address) => {
+  let packed: bytes = Bytes.pack(p);
+  ((Bytes.unpack(packed)) : option(address))
+};

src/test/contracts/expected/chain_id.ligo.expected

@@ -0,0 +1,2 @@
+function chain_id (const tt : chain_id) : chain_id is
+  Tezos.chain_id

src/test/contracts/expected/check_signature.ligo.expected

@@ -0,0 +1,5 @@
+function check_signature
+  (const pk : key;
+   const signed : signature;
+   const msg : bytes) : bool is
+  Crypto.check (pk, signed, msg)

src/test/contracts/expected/check_signature.mligo.expected

@@ -0,0 +1,11 @@
+let check_signature
+  (pk, signed, msg : key * signature * bytes) : bool =
+  Crypto.check pk signed msg
+
+let example : bool =
+  Crypto.check
+    ("edpktz4xg6csJnJ5vcmMb2H37sWXyBDcoAp3XrBvjRaTSQ1zmZTeRQ"
+     : key)
+    ("edsigtnzKd51CDomKVMFBoU8SzFZgNqRkYUaQH4DLUg8Lsimz98DFB82uiHAkdvx29DDqHxPf1noQ8noWpKMZoxTCsfprrbs4Xo"
+     : signature)
+    0x05010000000568656c6c6f

src/test/contracts/expected/check_signature.religo.expected

@@ -0,0 +1,4 @@
+let check_signature = (param: (key, signature, bytes)): bool => {
+  let (pk, signed, msg) = param;
+  Crypto.check(pk, signed, msg)
+};

src/test/contracts/expected/closure-1.ligo.expected

@@ -0,0 +1,4 @@
+function foo (const i : int) : int is
+block {
+  function add (const j : int) : int is i + j
+} with add (i)

src/test/contracts/expected/closure-2.ligo.expected

@@ -0,0 +1,5 @@
+function foobar (const i : int) : int is
+block {
+  const j : int = 3;
+  function add (const k : int) : int is i + j + k
+} with add (42)

src/test/contracts/expected/closure-3.ligo.expected

@@ -0,0 +1,6 @@
+function foobar (const i : int) : int is
+block {
+  const j : int = 3;
+  const k : int = 4;
+  function add (const l : int) : int is i + j + k + l
+} with add (42)

src/test/contracts/expected/closure.ligo.expected

@@ -0,0 +1,5 @@
+function toto (const i : int) : int is
+block {
+  function tata (const j : int) : int is i + j;
+  function titi (const j : int) : int is i + j
+} with tata (i) + titi (i)

src/test/contracts/expected/closure.mligo.expected

@@ -0,0 +1,5 @@
+let test (k : int) : int =
+  let j : int = k + 5
+  in let close : int -> int = fun (i : int) -> i + j
+     in let j : int = 20
+        in close 20

src/test/contracts/expected/closure.religo.expected

@@ -0,0 +1,6 @@
+let test = (k: int): int => {
+  let j: int = k + 5;
+  let close: (int => int) = (i: int) => i + j;
+  let j: int = 20;
+  close(20)
+};

src/test/contracts/expected/coase.ligo.expected

@@ -0,0 +1,137 @@
+type card_pattern_id is nat
+
+type card_pattern is
+  record [coefficient : tez; quantity : nat]
+
+type card_patterns is map (card_pattern_id, card_pattern)
+
+type card_id is nat
+
+type card is
+  record [
+    card_owner : address;
+    card_pattern : card_pattern_id
+  ]
+
+type cards is map (card_id, card)
+
+type storage is
+  record [
+    cards : cards;
+    card_patterns : card_patterns;
+    next_id : nat
+  ]
+
+type return is list (operation) * storage
+
+type action_buy_single is
+  record [card_to_buy : card_pattern_id]
+
+type action_sell_single is record [card_to_sell : card_id]
+
+type action_transfer_single is
+  record [card_to_transfer : card_id; destination : address]
+
+type parameter is
+    Buy_single of action_buy_single
+  | Sell_single of action_sell_single
+  | Transfer_single of action_transfer_single
+
+function transfer_single
+  (const action : action_transfer_single;
+   const s : storage) : return is
+block {
+  const cards : cards = s.cards;
+  const card : card
+  = case cards [action.card_to_transfer] of [
+      Some (card) -> card
+    | None ->
+        (failwith ("transfer_single: No card.") : card)
+    ];
+  if card.card_owner =/= sender
+  then failwith ("This card doesn't belong to you")
+  else skip;
+  card.card_owner := action.destination;
+  cards [action.card_to_transfer] := card;
+  s.cards := cards
+} with ((nil : list (operation)), s)
+
+function sell_single
+  (const action : action_sell_single;
+   const s : storage) : return is
+block {
+  const card : card
+  = case s.cards [action.card_to_sell] of [
+      Some (card) -> card
+    | None -> (failwith ("sell_single: No card.") : card)
+    ];
+  if card.card_owner =/= sender
+  then failwith ("This card doesn't belong to you")
+  else skip;
+  const card_pattern : card_pattern
+  = case s.card_patterns [card.card_pattern] of [
+      Some (pattern) -> pattern
+    | None ->
+        (failwith ("sell_single: No card pattern.")
+         : card_pattern)
+    ];
+  card_pattern.quantity := abs (card_pattern.quantity - 1n);
+  const card_patterns : card_patterns = s.card_patterns;
+  card_patterns [card.card_pattern] := card_pattern;
+  s.card_patterns := card_patterns;
+  const cards : cards = s.cards;
+  remove action.card_to_sell from map cards;
+  s.cards := cards;
+  const price : tez
+  = card_pattern.coefficient * card_pattern.quantity;
+  const receiver : contract (unit)
+  = case (Tezos.get_contract_opt (Tezos.sender)
+          : option (contract (unit)))
+    of [
+      Some (contract) -> contract
+    | None ->
+        (failwith ("sell_single: No contract.")
+         : contract (unit))
+    ];
+  const op : operation
+  = Tezos.transaction (unit, price, receiver);
+  const operations : list (operation) = list [op]
+} with (operations, s)
+
+function buy_single
+  (const action : action_buy_single;
+   const s : storage) : return is
+block {
+  const card_pattern : card_pattern
+  = case s.card_patterns [action.card_to_buy] of [
+      Some (pattern) -> pattern
+    | None ->
+        (failwith ("buy_single: No card pattern.")
+         : card_pattern)
+    ];
+  const price : tez
+  = card_pattern.coefficient * (card_pattern.quantity + 1n);
+  if price > amount
+  then failwith ("Not enough money")
+  else skip;
+  card_pattern.quantity := card_pattern.quantity + 1n;
+  const card_patterns : card_patterns = s.card_patterns;
+  card_patterns [action.card_to_buy] := card_pattern;
+  s.card_patterns := card_patterns;
+  const cards : cards = s.cards;
+  cards [s.next_id] :=
+    record [
+      card_owner = sender;
+      card_pattern = action.card_to_buy
+    ];
+  s.cards := cards;
+  s.next_id := s.next_id + 1n
+} with ((nil : list (operation)), s)
+
+function main (const action : parameter; const s : storage)
+  : return is
+  case action of [
+    Buy_single (bs) -> buy_single (bs, s)
+  | Sell_single (as) -> sell_single (as, s)
+  | Transfer_single (at) -> transfer_single (at, s)
+  ]

src/test/contracts/expected/comparable.mligo.expected

@@ -0,0 +1,28 @@
+let int_ (a : int) = a < a
+
+let nat_ (a : nat) = a < a
+
+let bool_ (a : bool) = a < a
+
+let mutez_ (a : tez) = a < a
+
+let string_ (a : string) = a < a
+
+let bytes_ (a : bytes) = a < a
+
+let address_ (a : address) = a < a
+
+let timestamp_ (a : timestamp) = a < a
+
+let key_hash_ (a : key_hash) = a < a
+
+type comp_pair = int * int
+
+let comp_pair (a : comp_pair) = a < a
+
+type inner_record = (int, "one", nat, "two") michelson_pair
+
+type comb_record =
+  (int, "three", inner_record, "four") michelson_pair
+
+let comb_record (a : comb_record) = a < a

src/test/contracts/expected/condition-annot.mligo.expected

@@ -0,0 +1,4 @@
+type integer = int
+
+let main (i : int) =
+  if (i = 2 : bool) then (42 : int) else (0 : integer)

src/test/contracts/expected/condition-shadowing.mligo.expected

@@ -0,0 +1,9 @@
+let main (i : int) =
+  let result = 0
+  in if i = 2
+     then
+       let result = 42
+       in result
+     else
+       let result = 0
+       in result

src/test/contracts/expected/condition-shadowing.religo.expected

@@ -0,0 +1,12 @@
+let main = (i: int) => {
+  let result = 0;
+  if (i == 2) {
+  
+    let result = 42;
+    result
+  } else {
+  
+    let result = 0;
+    result
+  }
+};

src/test/contracts/expected/condition-simple.ligo.expected

@@ -0,0 +1,2 @@
+function main (const i : int) : int is
+  if 1 = 1 then 42 else 0