remaking PacscaLIGO simplifier

src/bin/expect_tests/code_insertion.ml

@@ -33,7 +33,7 @@ let%expect_test _ =
   run_ligo_bad [ "compile-contract" ; bad_contract "bad_michelson_insertion_2.ligo" ; "main" ] ;
   [%expect{|
     ligo: error
-    in file "bad_michelson_insertion_2.ligo", line 3, character 0 to line 5, character 41
+    in file "bad_michelson_insertion_2.ligo", line 3, characters 9-13
     Constant declaration 'main'
     Bad types: expected nat got ( nat * nat )
 

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

@@ -161,8 +161,7 @@ and attr_decl = string reg ne_injection reg
 and const_decl = {
   kwd_const  : kwd_const;
   name       : variable;
-  colon      : colon;
+  const_type : (colon * type_expr) option;
-  const_type : type_expr;
   equal      : equal;
   init       : expr;
   terminator : semi option;
@@ -209,8 +208,7 @@ and type_tuple = (type_expr, comma) nsepseq par reg
 and fun_expr = {
   kwd_function : kwd_function;
   param        : parameters;
-  colon        : colon;
+  ret_type     : (colon * type_expr) option;
-  ret_type     : type_expr;
   kwd_is       : kwd_is;
   return       : expr
 }
@@ -220,8 +218,7 @@ and fun_decl = {
   kwd_function  : kwd_function;
   fun_name      : variable;
   param         : parameters;
-  colon         : colon;
+  ret_type      : (colon * type_expr) option;
-  ret_type      : type_expr;
   kwd_is        : kwd_is;
   block_with    : (block reg * kwd_with) option;
   return        : expr;
@@ -238,15 +235,13 @@ and param_decl =
 and param_const = {
   kwd_const  : kwd_const;
   var        : variable;
-  colon      : colon;
+  param_type : (colon * type_expr) option
-  param_type : type_expr
 }
 
 and param_var = {
   kwd_var    : kwd_var;
   var        : variable;
-  colon      : colon;
+  param_type : (colon * type_expr) option
-  param_type : type_expr
 }
 
 and block = {
@@ -274,8 +269,7 @@ and data_decl =
 and var_decl = {
   kwd_var    : kwd_var;
   name       : variable;
-  colon      : colon;
+  var_type   : (colon * type_expr) option;
-  var_type   : type_expr;
   assign     : assign;
   init       : expr;
   terminator : semi option;
@@ -413,18 +407,14 @@ and for_loop =
 | ForCollect of for_collect reg
 
 and for_int = {
-  kwd_for : kwd_for;
+  kwd_for    : kwd_for;
-  assign  : var_assign reg;
+  binder     : variable;
-  kwd_to  : kwd_to;
+  assign     : assign;
-  bound   : expr;
+  init       : expr;
-  step    : (kwd_step * expr) option;
+  kwd_to     : kwd_to;
-  block   : block reg
+  bound      : expr;
-}
+  step       : (kwd_step * expr) option;
-
+  block      : block reg
-and var_assign = {
-  name   : variable;
-  assign : assign;
-  expr   : expr
 }
 
 and for_collect = {
@@ -633,6 +623,7 @@ and pattern =
 | PTuple  of tuple_pattern
 
 and constr_pattern =
+  (*What is a unit pattern what does it catch ? is it like PWild ? *)
   PUnit      of c_Unit
 | PFalse     of c_False
 | PTrue      of c_True
@@ -645,6 +636,7 @@ and tuple_pattern = (pattern, comma) nsepseq par reg
 and list_pattern =
   PListComp of pattern injection reg
 | PNil      of kwd_nil
+  (* Currently hd # tl is PCons, i would expect this to have type pattern * cons * pattern just like PParCons*)
 | PParCons  of (pattern * cons * pattern) par reg
 | PCons     of (pattern, cons) nsepseq reg
 

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

@@ -142,6 +142,7 @@ type_decl:
                   terminator = $5}
     in {region; value} }
 
+type_expr_colon: ":" type_expr { $1,$2 }
 type_expr:
   fun_type | sum_type | record_type { $1 }
 
@@ -239,52 +240,49 @@ field_decl:
 
 
 fun_expr:
-  "function" parameters ":" type_expr "is" expr {
+  "function" parameters type_expr_colon? "is" expr {
-    let stop   = expr_to_region $6 in
+    let stop   = expr_to_region $5 in
     let region = cover $1 stop
     and value  = {kwd_function = $1;
                   param        = $2;
-                  colon        = $3;
+                  ret_type     = $3;
-                  ret_type     = $4;
+                  kwd_is       = $4;
-                  kwd_is       = $5;
+                  return       = $5}
-                  return       = $6}
     in {region; value} }
 
 (* Function declarations *)
 
 open_fun_decl:
-  ioption ("recursive") "function" fun_name parameters ":" type_expr "is"
+  ioption ("recursive") "function" fun_name parameters type_expr_colon? "is"
   block "with" expr {
     Scoping.check_reserved_name $3;
-    let stop   = expr_to_region $10 in
+    let stop   = expr_to_region $9 in
     let region = cover $2 stop
     and value  = {kwd_recursive= $1;
                   kwd_function = $2;
                   fun_name     = $3;
                   param        = $4;
-                  colon        = $5;
+                  ret_type     = $5;
-                  ret_type     = $6;
+                  kwd_is       = $6;
-                  kwd_is       = $7;
+                  block_with   = Some ($7, $8);
-                  block_with   = Some ($8, $9);
+                  return       = $9;
-                  return       = $10;
                   terminator   = None;
                   attributes   = None}
     in {region; value}
   }
-| ioption ("recursive") "function" fun_name parameters ":" type_expr "is"
+| ioption ("recursive") "function" fun_name parameters type_expr_colon? "is"
   expr {
     Scoping.check_reserved_name $3;
-    let stop   = expr_to_region $8 in
+    let stop   = expr_to_region $7 in
     let region = cover $2 stop
     and value  = {kwd_recursive= $1;
                   kwd_function = $2;
                   fun_name     = $3;
                   param        = $4;
-                  colon        = $5;
+                  ret_type     = $5;
-                  ret_type     = $6;
+                  kwd_is       = $6;
-                  kwd_is       = $7;
                   block_with   = None;
-                  return       = $8;
+                  return       = $7;
                   terminator   = None;
                   attributes   = None}
     in {region; value} }
@@ -300,28 +298,26 @@ parameters:
     in Scoping.check_parameters params; $1 }
 
 param_decl:
-  "var" var ":" param_type {
+  "var" var param_type? {
     Scoping.check_reserved_name $2;
-    let stop   = type_expr_to_region $4 in
+    let stop   = match $3 with None -> $2.region | Some (_,t) -> type_expr_to_region t in
     let region = cover $1 stop
     and value  = {kwd_var    = $1;
                   var        = $2;
-                  colon      = $3;
+                  param_type = $3}
-                  param_type = $4}
     in ParamVar {region; value}
   }
-| "const" var ":" param_type {
+| "const" var param_type? {
     Scoping.check_reserved_name $2;
-    let stop   = type_expr_to_region $4 in
+    let stop   = match $3 with None -> $2.region | Some (_,t) -> type_expr_to_region t in
     let region = cover $1 stop
     and value  = {kwd_const  = $1;
                   var        = $2;
-                  colon      = $3;
+                  param_type = $3}
-                  param_type = $4}
     in ParamConst {region; value} }
 
 param_type:
-  fun_type { $1 }
+  ":" fun_type { $1,$2 }
 
 block:
   "begin" sep_or_term_list(statement,";") "end" {
@@ -352,11 +348,10 @@ open_data_decl:
 
 open_const_decl:
   "const" unqualified_decl("=") {
-    let name, colon, const_type, equal, init, stop = $2 in
+    let name, const_type, equal, init, stop = $2 in
     let region = cover $1 stop
     and value  = {kwd_const = $1;
                   name;
-                  colon;
                   const_type;
                   equal;
                   init;
@@ -366,11 +361,10 @@ open_const_decl:
 
 open_var_decl:
   "var" unqualified_decl(":=") {
-    let name, colon, var_type, assign, init, stop = $2 in
+    let name, var_type, assign, init, stop = $2 in
     let region = cover $1 stop
     and value  = {kwd_var = $1;
                   name;
-                  colon;
                   var_type;
                   assign;
                   init;
@@ -378,10 +372,10 @@ open_var_decl:
     in {region; value} }
 
 unqualified_decl(OP):
-  var ":" type_expr OP expr {
+  var type_expr_colon? OP expr {
     Scoping.check_reserved_name $1;
-    let region = expr_to_region $5
+    let region = expr_to_region $4
-    in $1, $2, $3, $4, $5, region }
+    in $1, $2, $3, $4, region }
 
 const_decl:
   open_const_decl ";"? {
@@ -616,26 +610,30 @@ while_loop:
     in While {region; value} }
 
 for_loop:
-  "for" var_assign "to" expr block {
+  "for" var ":=" expr "to" expr block {
-    let region = cover $1 $5.region in
-    let value  = {kwd_for  = $1;
-                  assign   = $2;
-                  kwd_to   = $3;
-                  bound    = $4;
-                  step     = None;
-                  block    = $5}
-    in For (ForInt {region; value})
-  }
-| "for" var_assign "to" expr "step" expr block {
     let region = cover $1 $7.region in
     let value  = {kwd_for  = $1;
-                  assign   = $2;
+                  binder   = $2;
-                  kwd_to   = $3;
+                  assign   = $3;
-                  bound    = $4;
+                  init     = $4;
-                  step     = Some ($5, $6);
+                  kwd_to   = $5;
+                  bound    = $6;
+                  step     = None;
                   block    = $7}
     in For (ForInt {region; value})
   }
+| "for" var ":=" expr "to" expr "step" expr block {
+    let region = cover $1 $9.region in
+    let value  = {kwd_for  = $1;
+                  binder   = $2;
+                  assign   = $3;
+                  init     = $4;
+                  kwd_to   = $5;
+                  bound    = $6;
+                  step     = Some ($7, $8);
+                  block    = $9}
+    in For (ForInt {region; value})
+  }
 | "for" var arrow_clause? "in" collection expr block {
     Scoping.check_reserved_name $2;
     let region = cover $1 $7.region in
@@ -653,13 +651,6 @@ collection:
 | "set"  { Set  $1 }
 | "list" { List $1 }
 
-var_assign:
-  var ":=" expr {
-    Scoping.check_reserved_name $1;
-    let region = cover $1.region (expr_to_region $3)
-    and value  = {name=$1; assign=$2; expr=$3}
-    in {region; value} }
-
 arrow_clause:
   "->" var { Scoping.check_reserved_name $2; ($1,$2) }
 

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

@@ -64,6 +64,11 @@ let print_sepseq :
         None -> ()
   | Some seq -> print_nsepseq state sep print seq
 
+let print_option : state -> (state -> 'a -> unit ) -> 'a option -> unit =
+  fun state print -> function
+    None -> ()
+  | Some opt -> print state opt
+
 let print_token state region lexeme =
   let line =
     sprintf "%s: %s\n"(compact state region) lexeme
@@ -126,12 +131,11 @@ and print_decl state = function
 | AttrDecl  decl -> print_attr_decl  state decl
 
 and print_const_decl state {value; _} =
-  let {kwd_const; name; colon; const_type;
+  let {kwd_const; name; const_type;
        equal; init; terminator; _} = value in
   print_token      state kwd_const "const";
   print_var        state name;
-  print_token      state colon ":";
+  print_option     state print_colon_type_expr const_type;
-  print_type_expr  state const_type;
   print_token      state equal "=";
   print_expr       state init;
   print_terminator state terminator
@@ -155,6 +159,10 @@ and print_type_expr state = function
 | TVar    type_var    -> print_var         state type_var
 | TString str         -> print_string      state str
 
+and print_colon_type_expr state (colon, type_expr) =
+  print_token     state colon ":";
+  print_type_expr state type_expr;
+
 and print_cartesian state {value; _} =
   print_nsepseq state "*" print_type_expr value
 
@@ -203,14 +211,13 @@ and print_type_tuple state {value; _} =
   print_token state rpar ")"
 
 and print_fun_decl state {value; _} =
-  let {kwd_function; fun_name; param; colon;
+  let {kwd_function; fun_name; param;
        ret_type; kwd_is; block_with;
        return; terminator; _} = value in
   print_token      state kwd_function "function";
   print_var        state fun_name;
   print_parameters state param;
-  print_token      state colon ":";
+  print_option     state print_colon_type_expr  ret_type;
-  print_type_expr  state ret_type;
   print_token      state kwd_is "is";
   (match block_with with
     None -> ()
@@ -221,12 +228,11 @@ and print_fun_decl state {value; _} =
   print_terminator state terminator;
 
 and print_fun_expr state {value; _} =
-  let {kwd_function; param; colon;
+  let {kwd_function; param;
        ret_type; kwd_is; return} : fun_expr = value in
   print_token      state kwd_function "function";
   print_parameters state param;
-  print_token      state colon ":";
+  print_option     state print_colon_type_expr ret_type;
-  print_type_expr  state ret_type;
   print_token      state kwd_is "is";
   print_expr       state return
 
@@ -249,18 +255,16 @@ and print_param_decl state = function
 | ParamVar   param_var   -> print_param_var   state param_var
 
 and print_param_const state {value; _} =
-  let {kwd_const; var; colon; param_type} = value in
+  let {kwd_const; var; param_type} = value in
   print_token     state kwd_const "const";
   print_var       state var;
-  print_token     state colon ":";
+  print_option    state print_colon_type_expr param_type
-  print_type_expr state param_type
 
 and print_param_var state {value; _} =
-  let {kwd_var; var; colon; param_type} = value in
+  let {kwd_var; var; param_type} = value in
-  print_token     state kwd_var "var";
+  print_token    state kwd_var "var";
-  print_var       state var;
+  print_var      state var;
-  print_token     state colon ":";
+  print_option   state print_colon_type_expr param_type
-  print_type_expr state param_type
 
 and print_block state block =
   let {enclosing; statements; terminator} = block.value in
@@ -283,12 +287,11 @@ and print_data_decl state = function
 | LocalFun  decl -> print_fun_decl  state decl
 
 and print_var_decl state {value; _} =
-  let {kwd_var; name; colon; var_type;
+  let {kwd_var; name; var_type;
        assign; init; terminator} = value in
   print_token      state kwd_var "var";
   print_var        state name;
-  print_token      state colon ":";
+  print_option     state print_colon_type_expr var_type;
-  print_type_expr  state var_type;
   print_token      state assign ":=";
   print_expr       state init;
   print_terminator state terminator
@@ -403,9 +406,11 @@ 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; step; block} = value in
+  let {kwd_for; binder; assign; init; kwd_to; bound; step; block} = value in
   print_token      state kwd_for "for";
-  print_var_assign state assign;
+  print_var        state binder;
+  print_token      state assign ":=";
+  print_expr       state init;
   print_token      state kwd_to "to";
   print_expr       state bound;
   (match step with
@@ -415,12 +420,6 @@ and print_for_int state ({value; _} : for_int reg) =
        print_expr   state expr);
   print_block      state block
 
-and print_var_assign state {value; _} =
-  let {name; assign; expr} = value in
-  print_var   state name;
-  print_token state assign ":=";
-  print_expr  state expr
-
 and print_for_collect state ({value; _} : for_collect reg) =
   let {kwd_for; var; bind_to;
        kwd_in; collection; expr; block} = value in
@@ -927,7 +926,7 @@ and pp_fun_decl state decl =
   let () =
     let state = state#pad arity (start + 2) in
     pp_node state "<return type>";
-    pp_type_expr (state#pad 1 0) decl.ret_type in
+    print_option (state#pad 1 0) pp_type_expr @@ Option.map snd decl.ret_type in
   let () =
     let state = state#pad arity (start + 3) in
     pp_node state "<body>";
@@ -945,7 +944,7 @@ and pp_fun_decl state decl =
 and pp_const_decl state decl =
   let arity = 3 in
   pp_ident (state#pad arity 0) decl.name;
-  pp_type_expr (state#pad arity 1) decl.const_type;
+  print_option (state#pad arity 1) pp_type_expr @@ Option.map snd decl.const_type;
   pp_expr (state#pad arity 2) decl.init
 
 and pp_type_expr state = function
@@ -1014,7 +1013,7 @@ and pp_fun_expr state (expr: fun_expr) =
   let () =
     let state = state#pad 3 1 in
     pp_node state "<return type>";
-    pp_type_expr (state#pad 1 0) expr.ret_type in
+    print_option (state#pad 1 0) pp_type_expr @@ Option.map snd expr.ret_type in
   let () =
     let state = state#pad 3 2 in
     pp_node state "<return>";
@@ -1042,11 +1041,11 @@ and pp_param_decl state = function
   ParamConst {value; region} ->
     pp_loc_node state "ParamConst" region;
     pp_ident (state#pad 2 0) value.var;
-    pp_type_expr (state#pad 2 1) value.param_type
+    print_option (state#pad 2 1) pp_type_expr @@ Option.map snd value.param_type
 | ParamVar {value; region} ->
     pp_loc_node state "ParamVar" region;
     pp_ident (state#pad 2 0) value.var;
-    pp_type_expr (state#pad 2 1) value.param_type
+    print_option (state#pad 2 1) pp_type_expr @@ Option.map snd value.param_type
 
 and pp_statements state statements =
   let statements = Utils.nsepseq_to_list statements in
@@ -1334,13 +1333,15 @@ 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 {binder; init; bound; step; block; _} = for_int in
   let arity =
     match step with None -> 3 | Some _ -> 4 in
   let () =
     let state = state#pad arity 0 in
     pp_node state "<init>";
-    pp_var_assign state assign.value in
+    pp_ident (state#pad 2 0) binder;
+    pp_expr  (state#pad 2 1) init
+    in
   let () =
     let state = state#pad arity 1 in
     pp_node state "<bound>";
@@ -1359,10 +1360,6 @@ and pp_for_int state for_int =
     pp_statements state statements
   in ()
 
-and pp_var_assign state asgn =
-  pp_ident (state#pad 2 0) asgn.name;
-  pp_expr  (state#pad 2 1) asgn.expr
-
 and pp_for_collect state collect =
   let () =
     let state = state#pad 3 0 in
@@ -1450,7 +1447,7 @@ and pp_data_decl state = function
 
 and pp_var_decl state decl =
   pp_ident     (state#pad 3 0) decl.name;
-  pp_type_expr (state#pad 3 1) decl.var_type;
+  print_option (state#pad 3 1) pp_type_expr @@ Option.map snd decl.var_type;
   pp_expr      (state#pad 3 2) decl.init
 
 and pp_expr state = function

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

@@ -19,6 +19,11 @@ let pp_braces : ('a -> document) -> 'a braces reg -> document =
   fun printer {value; _} ->
     string "{" ^^ nest 1 (printer value.inside ^^ string "}")
 
+let pp_option : ('a -> document) -> 'a option -> document =
+  fun printer -> function
+    None -> empty
+  | Some opt -> printer opt
+
 let rec print ast =
   let app decl = group (pp_declaration decl) in
   let decl = Utils.nseq_to_list ast.decl in
@@ -35,11 +40,11 @@ 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 t_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 (start ^/^ pp_option (fun (_, d) -> nest 2 (string ": " ^^ pp_type_expr d)) t_expr)
   ^^ group (break 1 ^^ nest 2 (string "= " ^^ pp_expr init))
   ^^ attr
 
@@ -123,10 +128,9 @@ 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))
+  ^^ pp_option (fun (_,d) -> group (break 1 ^^ nest 2 (string ": " ^^ pp_type_expr d))) ret_type
   ^^ string " is" ^^ group (nest 4 (break 1 ^^ expr))
 
 and pp_fun_decl {value; _} =
@@ -138,7 +142,6 @@ and pp_fun_decl {value; _} =
     | 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
@@ -150,7 +153,7 @@ and pp_fun_decl {value; _} =
         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"))
+  ^^ group (nest 2 (pp_option (fun (_, d) -> break 1 ^^ string ": " ^^ nest 2 (pp_type_expr d)) ret_type ^^ string " is"))
   ^^ body ^^ attr
 
 and pp_parameters p = pp_nsepseq ";" pp_param_decl p
@@ -161,15 +164,13 @@ and pp_param_decl = function
 
 and pp_param_const {value; _} =
   let {var; param_type; _} : param_const = value in
-  let name   = string ("const " ^ var.value) in
+  let name   = string ("const " ^ var.value)
-  let t_expr = pp_type_expr param_type
+  in prefix 2 1 name @@ pp_option (fun (_,d) -> string ": " ^^ pp_type_expr d) 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 name   = string ("var " ^ var.value)
-  let t_expr = pp_type_expr param_type
+  in prefix 2 1 name @@ pp_option (fun (_,d) -> string ": " ^^ pp_type_expr d) param_type
-  in prefix 2 1 (name ^^ string " :") t_expr
 
 and pp_block {value; _} =
   string "block {"
@@ -191,8 +192,7 @@ and pp_data_decl = function
 and pp_var_decl {value; _} =
   let {name; var_type; init; _} = value in
   let start = string ("var " ^ name.value) in
-  let t_expr = pp_type_expr var_type in
+  group (start ^/^ pp_option (fun (_,d) -> nest 2 (string ": " ^^ pp_type_expr d)) var_type)
-  group (start ^/^ nest 2 (string ": " ^^ t_expr))
   ^^ group (break 1 ^^ nest 2 (string ":= " ^^ pp_expr init))
 
 and pp_instruction = function
@@ -330,19 +330,15 @@ and pp_for_loop = function
 | ForCollect l -> pp_for_collect l
 
 and pp_for_int {value; _} =
-  let {assign; bound; step; block; _} = value in
+  let {binder; init; 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 "for") (prefix 2 1 (pp_ident binder ^^ string " :=") (pp_expr init))
   ^^ 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 =

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

@@ -827,18 +827,6 @@ interactive_expr: Function LPAR Var Ident COLON Ident VBAR
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-interactive_expr: Function LPAR Var Ident COLON With
-##
-## Ends in an error in state: 74.
-##
-## param_decl -> Var Ident COLON . param_type [ SEMI RPAR ]
-##
-## The known suffix of the stack is as follows:
-## Var Ident COLON
-##
-
-<YOUR SYNTAX ERROR MESSAGE HERE>
-
 interactive_expr: Function LPAR Var Ident With
 ##
 ## Ends in an error in state: 73.
@@ -2828,18 +2816,6 @@ contract: Const Ident COLON String VBAR
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-contract: Const Ident COLON With
-##
-## Ends in an error in state: 495.
-##
-## unqualified_decl(EQ) -> Ident COLON . type_expr EQ expr [ Type SEMI Recursive RBRACE Function End EOF Const Attributes ]
-##
-## The known suffix of the stack is as follows:
-## Ident COLON
-##
-
-<YOUR SYNTAX ERROR MESSAGE HERE>
-
 contract: Const Ident With
 ##
 ## Ends in an error in state: 494.
@@ -4010,18 +3986,6 @@ contract: Function Ident LPAR Const Ident COLON Ident RPAR COLON String Is Begin
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-contract: Function Ident LPAR Const Ident COLON Ident RPAR COLON String Is Begin Var Ident COLON With
-##
-## Ends in an error in state: 418.
-##
-## unqualified_decl(ASS) -> Ident COLON . type_expr ASS expr [ SEMI RBRACE End ]
-##
-## The known suffix of the stack is as follows:
-## Ident COLON
-##
-
-<YOUR SYNTAX ERROR MESSAGE HERE>
-
 contract: Function Ident LPAR Const Ident COLON Ident RPAR COLON String Is Begin Var Ident With
 ##
 ## Ends in an error in state: 417.
@@ -4174,19 +4138,6 @@ contract: Function Ident LPAR Const Ident COLON Ident RPAR COLON String VBAR
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-contract: Function Ident LPAR Const Ident COLON Ident RPAR COLON With
-##
-## Ends in an error in state: 463.
-##
-## open_fun_decl -> Function Ident parameters COLON . type_expr Is block With expr [ Type SEMI Recursive RBRACE Function End EOF Const Attributes ]
-## open_fun_decl -> Function Ident parameters COLON . type_expr Is expr [ Type SEMI Recursive RBRACE Function End EOF Const Attributes ]
-##
-## The known suffix of the stack is as follows:
-## Function Ident parameters COLON
-##
-
-<YOUR SYNTAX ERROR MESSAGE HERE>
-
 contract: Function Ident LPAR Const Ident COLON Ident RPAR With
 ##
 ## Ends in an error in state: 462.
@@ -4284,19 +4235,6 @@ contract: Recursive Function Ident LPAR Const Ident COLON Ident RPAR COLON Strin
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
 
-contract: Recursive Function Ident LPAR Const Ident COLON Ident RPAR COLON With
-##
-## Ends in an error in state: 87.
-##
-## open_fun_decl -> Recursive Function Ident parameters COLON . type_expr Is block With expr [ Type SEMI Recursive RBRACE Function End EOF Const Attributes ]
-## open_fun_decl -> Recursive Function Ident parameters COLON . type_expr Is expr [ Type SEMI Recursive RBRACE Function End EOF Const Attributes ]
-##
-## The known suffix of the stack is as follows:
-## Recursive Function Ident parameters COLON
-##
-
-<YOUR SYNTAX ERROR MESSAGE HERE>
-
 contract: Recursive Function Ident LPAR Const Ident COLON Ident RPAR With
 ##
 ## Ends in an error in state: 86.
@@ -4836,4 +4774,3 @@ contract: With
 ##
 
 <YOUR SYNTAX ERROR MESSAGE HERE>
-

src/passes/02-concrete_to_imperative/cameligo.ml

@@ -543,7 +543,7 @@ and compile_fun lamb' : (expr , abs_error) result =
     let aux ((var : Raw.variable) , ty_opt) =
       match var.value , ty_opt with
       | "storage" , None ->
-        ok (var , t_variable "storage")
+        ok (var , t_variable ~loc @@ Var.fresh ~name:"storage" ())
       | _ , None ->
           fail @@ untyped_fun_param var
       | _ , Some ty -> (

src/passes/02-concrete_to_imperative/errors_pascaligo.ml

@@ -10,32 +10,38 @@ type abs_error = [
   | `Concrete_pascaligo_unknown_predefined_type of Raw.constr
   | `Concrete_pascaligo_unsupported_non_var_pattern of Raw.pattern
   | `Concrete_pascaligo_only_constructors of Raw.pattern
-  | `Concrete_pascaligo_unsupported_pattern_type of Raw.pattern list
+  | `Concrete_pascaligo_unsupported_pattern_type of Raw.pattern
   | `Concrete_pascaligo_unsupported_tuple_pattern of Raw.pattern
   | `Concrete_pascaligo_unsupported_string_singleton of Raw.type_expr
   | `Concrete_pascaligo_unsupported_deep_some_pattern of Raw.pattern
-  | `Concrete_pascaligo_unsupported_deep_list_pattern of (Raw.pattern, Raw.wild) Parser_shared.Utils.nsepseq Raw.reg
+  | `Concrete_pascaligo_unsupported_deep_list_pattern of Raw.pattern
+  | `Concrete_pascaligo_unsupported_deep_tuple_pattern of (Raw.pattern, Raw.wild) Parser_shared.Utils.nsepseq Raw.par Raw.reg
   | `Concrete_pascaligo_unknown_built_in of string
   | `Concrete_pascaligo_michelson_type_wrong of Raw.type_expr * string
   | `Concrete_pascaligo_michelson_type_wrong_arity of Location.t * string
   | `Concrete_pascaligo_instruction_tracer of Raw.instruction * abs_error
   | `Concrete_pascaligo_program_tracer of Raw.declaration list * abs_error
+  | `Concrete_pascaligo_recursive_fun of Location.t
+  | `Concrete_pascaligo_block_attribute of Raw.block Region.reg
   ]
 
 let unsupported_cst_constr p = `Concrete_pascaligo_unsupported_constant_constr p
 let unknown_predefined_type name = `Concrete_pascaligo_unknown_predefined_type name
 let unsupported_non_var_pattern p = `Concrete_pascaligo_unsupported_non_var_pattern p
+let untyped_recursive_fun loc = `Concrete_pascaligo_recursive_fun loc
 let only_constructors p = `Concrete_pascaligo_only_constructors p
 let unsupported_pattern_type pl = `Concrete_pascaligo_unsupported_pattern_type pl
 let unsupported_tuple_pattern p = `Concrete_pascaligo_unsupported_tuple_pattern p
 let unsupported_string_singleton te = `Concrete_pascaligo_unsupported_string_singleton te
 let unsupported_deep_some_patterns p = `Concrete_pascaligo_unsupported_deep_some_pattern p
 let unsupported_deep_list_patterns cons = `Concrete_pascaligo_unsupported_deep_list_pattern cons
+let unsupported_deep_tuple_patterns t = `Concrete_pascaligo_unsupported_deep_tuple_pattern t
 let unknown_built_in name = `Concrete_pascaligo_unknown_built_in name
 let michelson_type_wrong texpr name = `Concrete_pascaligo_michelson_type_wrong (texpr,name)
 let michelson_type_wrong_arity loc name = `Concrete_pascaligo_michelson_type_wrong_arity (loc,name)
 let abstracting_instruction_tracer i err = `Concrete_pascaligo_instruction_tracer (i,err)
 let program_tracer decl err = `Concrete_pascaligo_program_tracer (decl,err)
+let block_start_with_attribute block = `Concrete_pascaligo_block_attribute block
 
 let rec error_ppformat : display_format:string display_format ->
   Format.formatter -> abs_error -> unit =
@@ -51,7 +57,7 @@ let rec error_ppformat : display_format:string display_format ->
     | `Concrete_pascaligo_unsupported_pattern_type pl ->
       Format.fprintf f
         "@[<hv>%a@Currently, only booleans, lists, options, and constructors are supported in patterns@]"
-        Location.pp_lift (List.fold_left (fun a p -> Region.cover a (Raw.pattern_to_region p)) Region.ghost pl)
+        Location.pp_lift @@ Raw.pattern_to_region pl
     | `Concrete_pascaligo_unsupported_tuple_pattern p ->
       Format.fprintf f
         "@[<hv>%a@The following tuple pattern is not supported yet:@\"%s\"@]"
@@ -76,7 +82,11 @@ let rec error_ppformat : display_format:string display_format ->
     | `Concrete_pascaligo_unsupported_deep_list_pattern cons ->
       Format.fprintf f
         "@[<hv>%a@Currently, only empty lists and x::y are supported in list patterns@]"
-        Location.pp_lift @@ cons.Region.region
+        Location.pp_lift @@ Raw.pattern_to_region cons
+    | `Concrete_pascaligo_unsupported_deep_tuple_pattern tuple ->
+      Format.fprintf f
+        "@[<hv>%a@Currently, nested tuple pattern is not suppoerted@]"
+        Location.pp_lift @@ tuple.Region.region
     | `Concrete_pascaligo_only_constructors p ->
       Format.fprintf f
         "@[<hv>%a@Currently, only constructors are supported in patterns@]"
@@ -105,6 +115,14 @@ let rec error_ppformat : display_format:string display_format ->
         "@[<hv>%a@Abstracting program@%a@]"
         Location.pp_lift (List.fold_left (fun a d -> Region.cover a (Raw.declaration_to_region d)) Region.ghost decl)
         (error_ppformat ~display_format) err
+    | `Concrete_pascaligo_recursive_fun loc ->
+      Format.fprintf f
+        "@[<hv>%a@Untyped recursive functions are not supported yet@]"
+        Location.pp loc
+    | `Concrete_pascaligo_block_attribute block ->
+      Format.fprintf f
+        "@[<hv>%a@Attributes have to follow the declaration it is attached@]"
+        Location.pp_lift @@ block.region
   )
 
 
@@ -125,9 +143,16 @@ let rec error_jsonformat : abs_error -> J.t = fun a ->
       ("location", `String loc);
       ("type", t ) ] in
     json_error ~stage ~content
+  | `Concrete_pascaligo_recursive_fun loc ->
+    let message = `String "Untyped recursive functions are not supported yet" in
+    let loc = Format.asprintf "%a" Location.pp loc in
+    let content = `Assoc [
+      ("message", message );
+      ("location", `String loc);] in
+    json_error ~stage ~content
   | `Concrete_pascaligo_unsupported_pattern_type pl ->
     let loc = Format.asprintf "%a"
-      Location.pp_lift (List.fold_left (fun a p -> Region.cover a (Raw.pattern_to_region p)) Region.ghost pl) in
+      Location.pp_lift @@ Raw.pattern_to_region pl in
     let message = `String "Currently, only booleans, lists, options, and constructors are supported in patterns" in
     let content = `Assoc [
       ("message", message );
@@ -172,7 +197,14 @@ let rec error_jsonformat : abs_error -> J.t = fun a ->
     json_error ~stage ~content
   | `Concrete_pascaligo_unsupported_deep_list_pattern cons ->
     let message = `String "Currently, only empty lists and x::y are supported in list patterns" in
-    let loc = Format.asprintf "%a" Location.pp_lift @@ cons.Region.region in
+    let loc = Format.asprintf "%a" Location.pp_lift @@ Raw.pattern_to_region cons in
+    let content = `Assoc [
+      ("message", message );
+      ("location", `String loc);] in
+    json_error ~stage ~content
+  | `Concrete_pascaligo_unsupported_deep_tuple_pattern tuple ->
+    let message = `String "Currently, nested tuple pattern is not supported" in
+    let loc = Format.asprintf "%a" Location.pp_lift @@ tuple.Region.region in
     let content = `Assoc [
       ("message", message );
       ("location", `String loc);] in
@@ -224,4 +256,11 @@ let rec error_jsonformat : abs_error -> J.t = fun a ->
       ("message", message );
       ("location", `String loc);
       ("children", children) ] in
-    json_error ~stage ~content
+    json_error ~stage ~content
+  | `Concrete_pascaligo_block_attribute block ->
+    let message = Format.asprintf "Attributes have to follow the declaration it is attached" in
+    let loc = Format.asprintf "%a" Location.pp_lift block.region in
+    let content = `Assoc [
+      ("message", `String message );
+      ("location", `String loc); ] in
+    json_error ~stage ~content

src/passes/02-concrete_to_imperative/pascaligo.mli

@@ -1,15 +1,14 @@
 (** Converts PascaLIGO programs to the Simplified Abstract Syntax Tree. *)
 
 open Trace
-open Ast_imperative
 
-module Raw = Parser.Pascaligo.AST
+module AST = Ast_imperative
-module SMap = Map.String
+module CST = Parser.Pascaligo.AST
 
 (** Convert a concrete PascaLIGO expression AST to the imperative
     expression AST used by the compiler. *)
-val compile_expression : Raw.expr -> (expr , Errors_pascaligo.abs_error) result
+val compile_expression : CST.expr -> (AST.expr , Errors_pascaligo.abs_error) result
 
 (** Convert a concrete PascaLIGO program AST to the miperative program
     AST used by the compiler. *)
-val compile_program : Raw.ast -> (program, Errors_pascaligo.abs_error) result
+val compile_program : CST.ast -> (AST.program, Errors_pascaligo.abs_error) result

src/passes/03-self_ast_imperative/helpers.ml

@@ -97,8 +97,13 @@ let rec fold_expression : ('a, 'err) folder -> 'a -> expression -> ('a, 'err) re
       let ab = (expr1,expr2) in
       let%bind res = bind_fold_pair self init' ab in
       ok res
-  | E_assign {variable=_;access_path=_;expression} ->
+  | E_assign {variable=_;access_path;expression} ->
-      let%bind res = self init' expression in
+      let aux res a = match a with
+      | Access_map e -> self res e 
+      | _ -> ok res
+      in
+      let%bind res = bind_fold_list aux init' access_path in
+      let%bind res = self res expression in
       ok res
   | E_for {body; _} ->
       let%bind res = self init' body in
@@ -246,6 +251,13 @@ let rec map_expression : 'err exp_mapper -> expression -> (expression, 'err) res
       return @@ E_sequence {expr1;expr2}
     )
   | E_assign {variable;access_path;expression} -> (
+      let aux a = match a with
+      | Access_map e -> 
+        let%bind e = self e in
+        ok @@ Access_map e
+      | e -> ok @@ e
+      in
+      let%bind access_path = bind_map_list aux access_path in
       let%bind expression = self expression in
       return @@ E_assign {variable;access_path;expression}
   )
@@ -437,7 +449,14 @@ let rec fold_map_expression : ('a, 'err) fold_mapper -> 'a -> expression -> ('a
       ok (res, return @@ E_sequence {expr1;expr2})
     )
   | E_assign {variable;access_path;expression} ->
-      let%bind (res, expression) = self init' expression in
+      let aux res a = match a with
+      | Access_map e -> 
+        let%bind (res,e) = self res e in
+        ok @@ (res,Access_map e)
+      | e -> ok @@ (res,e)
+      in
+      let%bind (res, access_path)   = bind_fold_map_list aux init' access_path in
+      let%bind (res, expression) = self res expression in
       ok (res, return @@ E_assign {variable;access_path;expression})
   | E_for {binder; start; final; increment; body} ->
       let%bind (res, body) = self init' body in

src/passes/03-self_ast_imperative/none_variant.ml

@@ -7,4 +7,11 @@ let peephole_expression : expression -> (expression , self_ast_imperative_error)
   match e.expression_content with
   | E_constructor {constructor=Constructor "Some";element=e} -> return @@ E_constant {cons_name=C_SOME;arguments=[ e ]}
   | E_constructor {constructor=Constructor "None"; _} -> return @@ E_constant {cons_name=C_NONE ; arguments=[]}
+  | E_matching {matchee;cases=Match_variant [((Constructor "None", _),none_expr);((Constructor "Some", some),some_expr)]}
+  | E_matching {matchee;cases=Match_variant [((Constructor "Some", some),some_expr);((Constructor "None", _),none_expr)]}
+  ->
+    let match_none = none_expr in
+    let match_some = some,some_expr in
+    let cases = Match_option {match_none;match_some} in 
+    return @@ E_matching {matchee;cases}
   | e -> return e

src/passes/06-sugar_to_core/sugar_to_core.ml

@@ -122,7 +122,7 @@ let rec compile_expression : I.expression -> (O.expression , sugar_to_core_error
         | I.Access_record a -> ok @@ O.e_record_update ?loc s (Label a) e
         | I.Access_map k ->
           let%bind k = compile_expression k in
-          ok @@ O.e_constant ?loc C_UPDATE [k;O.e_some (e);s]
+          ok @@ O.e_constant ?loc C_MAP_ADD [k;e;s]
       in
       let aux (s, e : O.expression * _) lst =
         let%bind s' = accessor ~loc:s.location s lst in

src/stages/1-ast_imperative/combinators.ml

@@ -20,25 +20,24 @@ let t_key_hash ?loc ()    : type_expression = make_t ?loc @@ T_constant (TC_key_
 let t_timestamp ?loc ()   : type_expression = make_t ?loc @@ T_constant (TC_timestamp)
 let t_option ?loc o       : type_expression = make_t ?loc @@ T_operator (TC_option, [o])
 let t_list ?loc t         : type_expression = make_t ?loc @@ T_operator (TC_list, [t])
-let t_variable ?loc n     : type_expression = make_t ?loc @@ T_variable (Var.of_name n)
+let t_constant ?loc c     : type_expression = make_t ?loc @@ T_constant c
+let t_variable ?loc n     : type_expression = make_t ?loc @@ T_variable n
+let t_variable_ez ?loc n  : type_expression = t_variable ?loc @@ Var.of_name n
+
+let t_record ?loc record  : type_expression = make_t ?loc @@ T_record record
 let t_record_ez ?loc lst =
   let lst = List.mapi (fun i (k, v) -> (Label k, {field_type=v;field_decl_pos=i})) lst in
-  let m = LMap.of_list lst in
+  let record = LMap.of_list lst in
-  make_t ?loc @@ T_record (m:field_content label_map)
+  t_record ?loc (record:field_content label_map)
-let t_record ?loc m  : type_expression =
-  let lst = Map.String.to_kv_list m in
-  t_record_ez ?loc lst
 
 let t_tuple ?loc lst    : type_expression = make_t ?loc @@ T_tuple lst
 let t_pair ?loc (a , b) : type_expression = t_tuple ?loc [a; b]
 
-let ez_t_sum ?loc (lst:(string * type_expression) list) : type_expression =
+let t_sum ?loc sum : type_expression = make_t ?loc @@ T_sum sum
+let t_sum_ez ?loc (lst:(string * type_expression) list) : type_expression =
   let aux (prev,i) (k, v) = (CMap.add (Constructor k) {ctor_type=v;ctor_decl_pos=i} prev, i+1) in
   let (map,_) = List.fold_left aux (CMap.empty,0) lst in
-  make_t ?loc @@ T_sum (map: ctor_content constructor_map)
+  t_sum ?loc (map: ctor_content constructor_map)
-let t_sum ?loc m : type_expression =
-  let lst = Map.String.to_kv_list m in
-  ez_t_sum ?loc lst
 
 let t_operator ?loc op lst: type_expression = make_t ?loc @@ T_operator (op, lst)
 let t_annoted ?loc ty str : type_expression = make_t ?loc @@ T_annoted (ty, str)
@@ -86,14 +85,13 @@ let e'_bytes b : expression_content option =
     let bytes = Hex.to_bytes (`Hex b) in
     Some (E_literal (Literal_bytes bytes))
   with _ -> None
-let e_bytes_hex ?loc b : expression option =
+let e_bytes_hex_ez ?loc b : expression option =
   match e'_bytes b with
   | Some e' -> Some (make_e ?loc e')
   | None -> None
-let e_bytes_raw ?loc (b: bytes) : expression =
+let e_bytes_raw ?loc (b: bytes) : expression = make_e ?loc @@ E_literal (Literal_bytes b)
-  make_e ?loc @@ E_literal (Literal_bytes b)
+let e_bytes_hex ?loc b : expression = e_bytes_raw ?loc @@ Hex.to_bytes b
-let e_bytes_string ?loc (s: string) : expression =
+let e_bytes_string ?loc (s: string) : expression = e_bytes_hex ?loc @@ Hex.of_string s
-  make_e ?loc @@ E_literal (Literal_bytes (Hex.to_bytes (Hex.of_string s)))
 let e_some ?loc s  : expression = make_e ?loc @@ E_constant {cons_name = C_SOME; arguments = [s]}
 let e_none ?loc () : expression = make_e ?loc @@ E_constant {cons_name = C_NONE; arguments = []}
 let e_string_cat ?loc sl sr : expression = make_e ?loc @@ E_constant {cons_name = C_CONCAT; arguments = [sl ; sr ]}
@@ -102,13 +100,18 @@ let e_binop ?loc name a b  = make_e ?loc @@ E_constant {cons_name = name ; argum
 
 let e_constant ?loc name lst = make_e ?loc @@ E_constant {cons_name=name ; arguments = lst}
 let e_variable ?loc v = make_e ?loc @@ E_variable v
+let e_variable_ez ?loc v = e_variable ?loc @@ Var.of_name v
 let e_application ?loc a b = make_e ?loc @@ E_application {lamb=a ; args=b}
 let e_lambda ?loc binder input_type output_type result : expression = make_e ?loc @@ E_lambda {binder; input_type; output_type; result}
 let e_recursive ?loc fun_name fun_type lambda = make_e ?loc @@ E_recursive {fun_name; fun_type; lambda}
-let e_let_in ?loc (binder, ascr) inline rhs let_result = make_e ?loc @@ E_let_in { let_binder = (binder, ascr) ; rhs ; let_result; inline }
+let e_recursive_ez ?loc fun_name fun_type lambda = e_recursive ?loc (Var.of_name fun_name) fun_type lambda
+let e_let_in ?loc let_binder inline rhs let_result = make_e ?loc @@ E_let_in { let_binder; rhs ; let_result; inline }
+let e_let_in_ez ?loc binder ascr inline rhs let_result = e_let_in ?loc (Var.of_name binder, ascr) inline rhs let_result
 let e_raw_code ?loc language code = make_e ?loc @@ E_raw_code {language; code}
 
 let e_constructor ?loc s a : expression = make_e ?loc @@ E_constructor { constructor = Constructor s; element = a}
+let e_true  ?loc (): expression = e_constructor ?loc "true"  @@ e_unit ?loc ()
+let e_false ?loc (): expression = e_constructor ?loc "false" @@ e_unit ?loc ()
 let e_matching ?loc a b : expression = make_e ?loc @@ E_matching {matchee=a;cases=b}
 
 let e_accessor ?loc record path      = make_e ?loc @@ E_accessor {record; path}
@@ -132,26 +135,28 @@ let e_while ?loc condition body = make_e ?loc @@ E_while {condition; body}
 let e_for ?loc binder start final increment body = make_e ?loc @@ E_for {binder;start;final;increment;body}
 let e_for_each ?loc binder collection collection_type body = make_e ?loc @@ E_for_each {binder;collection;collection_type;body}
 
+let e_for_ez ?loc binder start final increment body = e_for ?loc (Var.of_name binder) start final increment body
+let e_for_each_ez ?loc (b,bo) collection collection_type body = e_for_each ?loc (Var.of_name b, Option.map Var.of_name bo) collection collection_type body
+
 let e_bool ?loc   b : expression = e_constructor ?loc (string_of_bool b) (e_unit ())
 
-let ez_match_variant (lst : ((string * string) * 'a) list) =
+let e_matching_variant ?loc a lst = e_matching ?loc a @@ Match_variant lst
-  let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in
-  Match_variant lst
-let e_matching_variant ?loc a (lst : ((string * string)* 'a) list) =
-  e_matching ?loc a (ez_match_variant lst)
-
 let e_matching_record   ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_record   (lst,ty_opt, expr)
 let e_matching_tuple    ?loc m lst ty_opt expr = e_matching ?loc m @@ Match_tuple    (lst,ty_opt, expr)
 let e_matching_variable ?loc m var ty_opt expr = e_matching ?loc m @@ Match_variable (var,ty_opt, expr)
 
+let e_matching_tuple_ez ?loc m lst ty_opt expr =
+  let lst = List.map Var.of_name lst in
+  e_matching_tuple ?loc m lst ty_opt expr
+
+let ez_match_variant (lst : ((string * string) * 'a) list) =
+  let lst = List.map (fun ((c,n),a) -> ((Constructor c, Var.of_name n), a) ) lst in
+  Match_variant lst
+
+let e_record ?loc map = make_e ?loc @@ E_record map
 let e_record_ez ?loc (lst : (string * expr) list) : expression =
   let map = List.fold_left (fun m (x, y) -> LMap.add (Label x) y m) LMap.empty lst in
-  make_e ?loc @@ E_record map
+  e_record ?loc map
-let e_record ?loc map =
-  let lst = Map.String.to_kv_list map in
-  e_record_ez ?loc lst 
-
-
 
 let make_option_typed ?loc e t_opt =
   match t_opt with
@@ -175,8 +180,9 @@ let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k)
 
 
 
-let e_assign ?loc variable access_path expression =
+let e_assign ?loc variable access_path expression = make_e ?loc @@ E_assign {variable;access_path;expression} 
-  make_e ?loc @@ E_assign {variable;access_path;expression} 
+let e_assign_ez ?loc variable access_path expression = e_assign ?loc (Var.of_name variable) access_path expression
+
 
 let get_e_accessor = fun t ->
   match t with

src/stages/1-ast_imperative/combinators.mli

@@ -17,15 +17,17 @@ val t_key_hash  : ?loc:Location.t -> unit -> type_expression
 val t_timestamp : ?loc:Location.t -> unit -> type_expression
 val t_signature : ?loc:Location.t -> unit -> type_expression
 val t_list      : ?loc:Location.t -> type_expression -> type_expression
-val t_variable  : ?loc:Location.t -> string -> type_expression
+val t_constant  : ?loc:Location.t -> type_constant -> type_expression
+val t_variable  : ?loc:Location.t -> type_variable -> type_expression
+val t_variable_ez : ?loc:Location.t -> string -> type_expression
 val t_pair   : ?loc:Location.t -> ( type_expression * type_expression ) -> type_expression
 val t_tuple  : ?loc:Location.t -> type_expression list -> type_expression
 
-val t_record    : ?loc:Location.t -> type_expression Map.String.t -> type_expression
+val t_record    : ?loc:Location.t -> field_content label_map -> type_expression
 val t_record_ez : ?loc:Location.t -> (string * type_expression) list -> type_expression
 
-val t_sum    : ?loc:Location.t -> type_expression Map.String.t -> type_expression
+val t_sum    : ?loc:Location.t -> ctor_content constructor_map -> type_expression
-val ez_t_sum : ?loc:Location.t -> ( string * type_expression ) list -> type_expression
+val t_sum_ez : ?loc:Location.t -> ( string * type_expression ) list -> type_expression
 
 val t_function : ?loc:Location.t -> type_expression -> type_expression -> type_expression
 val t_map      : ?loc:Location.t -> type_expression -> type_expression -> type_expression
@@ -65,8 +67,11 @@ val e_key_hash : ?loc:Location.t -> string -> expression
 val e_chain_id : ?loc:Location.t -> string -> expression 
 val e_mutez_z : ?loc:Location.t -> Z.t -> expression
 val e_mutez : ?loc:Location.t -> int -> expression
+val e_true  : ?loc:Location.t -> unit -> expression
+val e_false : ?loc:Location.t -> unit -> expression
 val e'_bytes : string -> expression_content option
-val e_bytes_hex : ?loc:Location.t -> string -> expression option
+val e_bytes_hex_ez : ?loc:Location.t -> string -> expression option
+val e_bytes_hex : ?loc:Location.t -> Hex.t -> expression
 val e_bytes_raw : ?loc:Location.t -> bytes -> expression
 val e_bytes_string : ?loc:Location.t -> string -> expression
 
@@ -78,21 +83,27 @@ val e_map_add : ?loc:Location.t -> expression -> expression ->  expression -> ex
 
 val e_constant : ?loc:Location.t -> constant' -> expression list -> expression
 val e_variable : ?loc:Location.t -> expression_variable -> expression
+val e_variable_ez : ?loc:Location.t -> string -> expression
 val e_application : ?loc:Location.t -> expression -> expression -> expression
 val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
 val e_recursive : ?loc:Location.t -> expression_variable -> type_expression -> lambda -> expression
+val e_recursive_ez : ?loc:Location.t -> string -> type_expression -> lambda -> expression
 val e_let_in : ?loc:Location.t -> ( expression_variable * type_expression option ) -> bool -> expression -> expression -> expression
+val e_let_in_ez : ?loc:Location.t -> string -> type_expression option -> bool -> expression -> expression -> expression
 val e_raw_code : ?loc:Location.t -> string -> expression -> expression
 
 val e_constructor : ?loc:Location.t -> string -> expression -> expression
 val e_matching : ?loc:Location.t -> expression -> matching_expr -> expression
+
 val ez_match_variant : ((string * string ) * expression) list -> matching_expr
-val e_matching_variant : ?loc:Location.t -> expression -> ((string * string) * expression) list -> expression
+val e_matching_variant : ?loc:Location.t -> expression -> ((constructor' * expression_variable) * expression) list -> expression
 val e_matching_record  : ?loc:Location.t -> expression -> (label * expression_variable) list -> type_expression list option -> expression -> expression
 val e_matching_tuple   : ?loc:Location.t -> expression -> expression_variable list -> type_expression list option -> expression -> expression
 val e_matching_variable: ?loc:Location.t -> expression -> expression_variable -> type_expression option -> expression -> expression
 
-val e_record : ?loc:Location.t -> expr Map.String.t -> expression
+val e_matching_tuple_ez: ?loc:Location.t -> expression -> string list -> type_expression list option -> expression -> expression
+
+val e_record     : ?loc:Location.t -> expr label_map -> expression
 val e_record_ez  : ?loc:Location.t -> ( string * expr ) list -> expression
 val e_accessor : ?loc:Location.t -> expression -> access list -> expression
 val e_update   : ?loc:Location.t -> expression -> access list -> expression -> expression
@@ -112,11 +123,15 @@ val e_map : ?loc:Location.t -> ( expression * expression ) list -> expression
 val e_big_map : ?loc:Location.t -> ( expr * expr ) list -> expression
 
 val e_assign : ?loc:Location.t -> expression_variable -> access list -> expression -> expression
+val e_assign_ez : ?loc:Location.t -> string -> access list -> expression -> expression
 
 val e_while  : ?loc:Location.t -> expression -> expression -> expression
 val e_for     : ?loc:Location.t -> expression_variable -> expression -> expression -> expression -> expression -> expression
 val e_for_each : ?loc:Location.t -> expression_variable * expression_variable option -> expression -> collect_type -> expression -> expression
 
+val e_for_ez  : ?loc:Location.t -> string -> expression -> expression -> expression -> expression -> expression
+val e_for_each_ez : ?loc:Location.t -> string * string option -> expression -> collect_type -> expression -> expression
+
 val make_option_typed : ?loc:Location.t -> expression -> type_expression option -> expression
 
 val e_typed_none : ?loc:Location.t -> type_expression -> expression

src/test/integration_tests.ml

@@ -410,13 +410,13 @@ let string_arithmetic_religo () : (unit, _) result =
 
 let bytes_arithmetic () : (unit, _) result =
   let%bind program = type_file "./contracts/bytes_arithmetic.ligo" in
-  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f00" in
+  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f00" in
-  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f007070" in
+  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f007070" in
-  let%bind toto = trace_option (test_internal __LOC__) @@ e_bytes_hex "7070" in
+  let%bind toto = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "7070" in
-  let%bind empty = trace_option (test_internal __LOC__) @@ e_bytes_hex "" in
+  let%bind empty = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "" in
-  let%bind tata = trace_option (test_internal __LOC__) @@ e_bytes_hex "ff7a7aff" in
+  let%bind tata = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "ff7a7aff" in
-  let%bind at = trace_option (test_internal __LOC__) @@ e_bytes_hex "7a7a" in
+  let%bind at = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "7a7a" in
-  let%bind ba = trace_option (test_internal __LOC__) @@ e_bytes_hex "ba" in
+  let%bind ba = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "ba" in
   let%bind () = expect_eq program "concat_op" foo foototo in
   let%bind () = expect_eq program "concat_op" empty toto in
   let%bind () = expect_eq program "slice_op" tata at in
@@ -454,8 +454,8 @@ let comparable_mligo () : (unit, _) result =
 
 let crypto () : (unit, _) result =
   let%bind program = type_file "./contracts/crypto.ligo" in
-  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f00" in
+  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f00" in
-  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f007070" in
+  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f007070" in
   let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in
   let%bind () = expect_eq_core program "hasherman512" foo b1 in
   let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in
@@ -468,8 +468,8 @@ let crypto () : (unit, _) result =
 
 let crypto_mligo () : (unit, _) result =
   let%bind program = mtype_file "./contracts/crypto.mligo" in
-  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f00" in
+  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f00" in
-  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f007070" in
+  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f007070" in
   let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in
   let%bind () = expect_eq_core program "hasherman512" foo b1 in
   let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in
@@ -482,8 +482,8 @@ let crypto_mligo () : (unit, _) result =
 
 let crypto_religo () : (unit, _) result =
   let%bind program = retype_file "./contracts/crypto.religo" in
-  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f00" in
+  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f00" in
-  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f007070" in
+  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f007070" in
   let%bind b1 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foo in
   let%bind () = expect_eq_core program "hasherman512" foo b1 in
   let%bind b2 = Test_helpers.run_typed_program_with_imperative_input program "hasherman512" foototo in
@@ -496,13 +496,13 @@ let crypto_religo () : (unit, _) result =
 
 let bytes_arithmetic_mligo () : (unit, _) result =
   let%bind program = mtype_file "./contracts/bytes_arithmetic.mligo" in
-  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f00" in
+  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f00" in
-  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f007070" in
+  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f007070" in
-  let%bind toto = trace_option (test_internal __LOC__) @@ e_bytes_hex "7070" in
+  let%bind toto = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "7070" in
-  let%bind empty = trace_option (test_internal __LOC__) @@ e_bytes_hex "" in
+  let%bind empty = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "" in
-  let%bind tata = trace_option (test_internal __LOC__) @@ e_bytes_hex "ff7a7aff" in
+  let%bind tata = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "ff7a7aff" in
-  let%bind at = trace_option (test_internal __LOC__) @@ e_bytes_hex "7a7a" in
+  let%bind at = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "7a7a" in
-  let%bind ba = trace_option (test_internal __LOC__) @@ e_bytes_hex "ba" in
+  let%bind ba = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "ba" in
   let%bind () = expect_eq program "concat_op" foo foototo in
   let%bind () = expect_eq program "concat_op" empty toto in
   let%bind () = expect_eq program "slice_op" tata at in
@@ -516,13 +516,13 @@ let bytes_arithmetic_mligo () : (unit, _) result =
 
 let bytes_arithmetic_religo () : (unit, _) result =
   let%bind program = retype_file "./contracts/bytes_arithmetic.religo" in
-  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f00" in
+  let%bind foo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f00" in
-  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex "0f007070" in
+  let%bind foototo = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "0f007070" in
-  let%bind toto = trace_option (test_internal __LOC__) @@ e_bytes_hex "7070" in
+  let%bind toto = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "7070" in
-  let%bind empty = trace_option (test_internal __LOC__) @@ e_bytes_hex "" in
+  let%bind empty = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "" in
-  let%bind tata = trace_option (test_internal __LOC__) @@ e_bytes_hex "ff7a7aff" in
+  let%bind tata = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "ff7a7aff" in
-  let%bind at = trace_option (test_internal __LOC__) @@ e_bytes_hex "7a7a" in
+  let%bind at = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "7a7a" in
-  let%bind ba = trace_option (test_internal __LOC__) @@ e_bytes_hex "ba" in
+  let%bind ba = trace_option (test_internal __LOC__) @@ e_bytes_hex_ez "ba" in
   let%bind () = expect_eq program "concat_op" foo foototo in
   let%bind () = expect_eq program "concat_op" empty toto in
   let%bind () = expect_eq program "slice_op" tata at in