Merge branch '2-support-for-cameligo-in-the-binary' into 'dev'

Resolve "Support for Cameligo in the binary"

See merge request ligolang/ligo!7

src/ast_simplified/PP.ml

@@ -30,7 +30,7 @@ let literal ppf (l:literal) = match l with
   | Literal_address s -> fprintf ppf "@%S" s
   | Literal_operation _ -> fprintf ppf "Operation(...bytes)"
 
-let rec expression ppf (e:expression) = match e with
+let rec expression ppf (e:expression) = match Location.unwrap e with
   | E_literal l -> literal ppf l
   | E_variable name -> fprintf ppf "%s" name
   | E_application (f, arg) -> fprintf ppf "(%a)@(%a)" expression f expression arg

src/ast_simplified/combinators.ml

@@ -35,76 +35,79 @@ let t_map key value = (T_constant ("map", [key ; value]))
 
 let make_name (s : string) : name = s
 
-let e_var (s : string) : expression = E_variable s
+let e_var ?loc (s : string) : expression = Location.wrap ?loc @@ E_variable s
+let e_literal ?loc l : expression = Location.wrap ?loc @@ E_literal l
+let e_unit ?loc () : expression = Location.wrap ?loc @@ E_literal (Literal_unit)
+let e_int ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_int n)
+let e_nat ?loc n : expression = Location.wrap ?loc @@ E_literal (Literal_nat n)
+let e_bool ?loc   b : expression = Location.wrap ?loc @@ E_literal (Literal_bool b)
+let e_string ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_string s)
+let e_address ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_address s)
+let e_tez ?loc s : expression = Location.wrap ?loc @@ E_literal (Literal_tez s)
+let e_bytes ?loc  b : expression = Location.wrap ?loc @@ E_literal (Literal_bytes (Bytes.of_string b))
+let e_record ?loc map : expression = Location.wrap ?loc @@ E_record map
+let e_tuple ?loc lst : expression = Location.wrap ?loc @@ E_tuple lst
+let e_some ?loc s : expression = Location.wrap ?loc @@ E_constant ("SOME", [s])
+let e_none ?loc () : expression = Location.wrap ?loc @@ E_constant ("NONE", [])
+let e_map_update ?loc k v old : expression = Location.wrap ?loc @@ E_constant ("MAP_UPDATE" , [k ; v ; old])
+let e_map ?loc lst : expression = Location.wrap ?loc @@ E_map lst
+let e_list ?loc lst : expression = Location.wrap ?loc @@ E_list lst
+let e_pair ?loc a b : expression = Location.wrap ?loc @@ E_tuple [a; b]
+let e_constructor ?loc s a : expression = Location.wrap ?loc @@ E_constructor (s , a)
+let e_matching ?loc a b : expression = Location.wrap ?loc @@ E_matching (a , b)
+let e_matching_bool ?loc a b c : expression = e_matching ?loc a (Match_bool {match_true = b ; match_false = c})
+let e_accessor ?loc a b = Location.wrap ?loc @@ E_accessor (a , b)
+let e_accessor_props ?loc a b = e_accessor ?loc a (List.map (fun x -> Access_record x) b)
+let e_variable ?loc v = Location.wrap ?loc @@ E_variable v
+let e_failwith ?loc v = Location.wrap ?loc @@ E_failwith v
+let e_skip ?loc () = Location.wrap ?loc @@ E_skip
+let e_loop ?loc cond body = Location.wrap ?loc @@ E_loop (cond , body)
+let e_sequence ?loc a b = Location.wrap ?loc @@ E_sequence (a , b)
+let e_let_in ?loc binder rhs result = Location.wrap ?loc @@ E_let_in { binder ; rhs ; result }
+let e_annotation ?loc expr ty = Location.wrap ?loc @@ E_annotation (expr , ty)
+let e_application ?loc a b = Location.wrap ?loc @@ E_application (a , b)
+let e_binop ?loc name a b = Location.wrap ?loc @@ E_constant (name , [a ; b])
+let e_constant ?loc name lst = Location.wrap ?loc @@ E_constant (name , lst)
+let e_look_up ?loc x y = Location.wrap ?loc @@ E_look_up (x , y)
+let e_assign ?loc a b c = Location.wrap ?loc @@ E_assign (a , b , c)
 
-let e_unit () : expression = E_literal (Literal_unit)
+let make_option_typed ?loc e t_opt =
-let e_int n : expression = E_literal (Literal_int n)
-let e_nat n : expression = E_literal (Literal_nat n)
-let e_bool   b : expression = E_literal (Literal_bool b)
-let e_string s : expression = E_literal (Literal_string s)
-let e_address s : expression = E_literal (Literal_address s)
-let e_tez s : expression = E_literal (Literal_tez s)
-let e_bytes  b : expression = E_literal (Literal_bytes (Bytes.of_string b))
-let e_record map : expression = E_record map
-let e_tuple lst : expression = E_tuple lst
-let e_some s : expression = E_constant ("SOME", [s])
-let e_none : expression = E_constant ("NONE", [])
-let e_map_update k v old : expression = E_constant ("MAP_UPDATE" , [k ; v ; old])
-let e_map lst : expression = E_map lst
-let e_list lst : expression = E_list lst
-let e_pair a b : expression = E_tuple [a; b]
-let e_constructor s a : expression = E_constructor (s , a)
-let e_match a b : expression = E_matching (a , b)
-let e_match_bool a b c : expression = e_match a (Match_bool {match_true = b ; match_false = c})
-let e_accessor a b = E_accessor (a , b)
-let e_accessor_props a b = e_accessor a (List.map (fun x -> Access_record x) b)
-let e_variable v = E_variable v
-let e_failwith v = E_failwith v
-let e_skip = E_skip
-let e_loop cond body = E_loop (cond , body)
-let e_sequence a b = E_sequence (a , b)
-let e_let_in binder rhs result = E_let_in { binder ; rhs ; result }
-let e_annotation expr ty = E_annotation (expr , ty)
-let e_application a b = E_application (a , b)
-
-let e_binop name a b = E_constant (name , [a ; b])
-
-let make_option_typed e t_opt =
   match t_opt with
   | None -> e
-  | Some t -> e_annotation e t
+  | Some t -> e_annotation ?loc e t
 
 
-let ez_e_record lst =
+let ez_e_record ?loc lst =
   let aux prev (k, v) = SMap.add k v prev in
   let map = List.fold_left aux SMap.empty lst in
-  e_record map
+  e_record ?loc map
 
-let e_typed_none t_opt =
+let e_typed_none ?loc t_opt =
   let type_annotation = t_option t_opt in
-  e_annotation e_none type_annotation
+  e_annotation ?loc (e_none ?loc ()) type_annotation
 
-let e_typed_list lst t =
+let e_typed_list ?loc lst t =
-  e_annotation (e_list lst) (t_list t)
+  e_annotation ?loc (e_list lst) (t_list t)
 
-let e_map lst k v = e_annotation (e_map lst) (t_map k v)
+let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v)
 
-let e_lambda (binder : string)
+let e_lambda ?loc (binder : string)
     (input_type : type_expression option)
     (output_type : type_expression option)
     (result : expression)
   : expression =
-  E_lambda {
+  Location.wrap ?loc @@ E_lambda {
     binder = (make_name binder , input_type) ;
     input_type = input_type ;
     output_type = output_type ;
     result ;
   }
 
-let e_record (lst : (string * expr) list) : expression =
+let e_record ?loc map = Location.wrap ?loc @@ E_record map
-  let aux prev (k, v) = SMap.add k v prev in
+
-  let map = List.fold_left aux SMap.empty lst in
+let e_ez_record ?loc (lst : (string * expr) list) : expression =
-  E_record map
+  let map = SMap.of_list lst in
+  e_record ?loc map
 
 let get_e_accessor = fun t ->
   match t with
@@ -130,3 +133,10 @@ let get_e_list = fun t ->
   match t with
   | E_list lst -> ok lst
   | _ -> simple_fail "not a pair"
+
+let get_e_failwith = fun e ->
+  match Location.unwrap e with
+  | E_failwith fw -> ok fw
+  | _ -> simple_fail "not a failwith"
+
+let is_e_failwith e = to_bool @@ get_e_failwith e

src/ast_simplified/misc.ml

@@ -35,7 +35,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
     Format.asprintf "\n@[<v>- %a@;- %a]" PP.expression a PP.expression b
   in
   trace (fun () -> error (thunk "not equal") error_content ()) @@
-  match (a , b) with
+  match (Location.unwrap a , Location.unwrap b) with
   | E_literal a , E_literal b ->
       assert_literal_eq (a, b)
   | E_literal _ , _ ->
@@ -113,8 +113,8 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
     )
   | E_list _, _ ->
       simple_fail "comparing list with other stuff"
-  | (E_annotation (a , _) ,  b) -> assert_value_eq (a , b)
+  | (E_annotation (a , _) ,  _b') -> assert_value_eq (a , b)
-  | (a , E_annotation (b , _)) -> assert_value_eq (a , b)
+  | (_a' , E_annotation (b , _)) -> assert_value_eq (a , b)
   | (E_variable _, _) | (E_lambda _, _)
   | (E_application _, _) | (E_let_in _, _)
   | (E_accessor _, _)

src/ast_simplified/types.ml

@@ -42,7 +42,7 @@ and let_in = {
   result : expr ;
 }
 
-and expression =
+and expression' =
   (* Base *)
   | E_literal of literal
   | E_constant of (name * expr list) (* For language constants, like (Cons hd tl) or (plus i j) *)
@@ -72,6 +72,8 @@ and expression =
   (* Annotate *)
   | E_annotation of expr * type_expression
 
+and expression = expression' Location.wrap
+
 and access =
   | Access_tuple of int
   | Access_record of string

src/ast_typed/combinators.ml

@@ -2,7 +2,13 @@ open Trace
 open Types
 
 let make_t type_value' simplified = { type_value' ; simplified }
-let make_a_e expression type_annotation environment = { expression ; type_annotation ; dummy_field = () ; environment }
+let make_a_e ?(location = Location.generated) expression type_annotation environment = {
+  expression ;
+  type_annotation ;
+  dummy_field = () ;
+  environment ;
+  location ;
+}
 let make_n_e name a_e = { name ; annotated_expression = a_e }
 let make_n_t type_name type_value = { type_name ; type_value }
 

src/ast_typed/types.ml

@@ -34,10 +34,11 @@ and small_environment = (environment * type_environment)
 and full_environment = small_environment List.Ne.t
 
 and annotated_expression = {
-  expression: expression ;
+  expression : expression ;
-  type_annotation: tv ;
+  type_annotation : tv ;
-  environment: full_environment ;
+  environment : full_environment ;
-  dummy_field: unit ;
+  location : Location.t ;
+  dummy_field : unit ;
 }
 
 and named_expression = {
@@ -162,6 +163,6 @@ let get_entry (p:program) (entry : string) : annotated_expression result =
 let get_functional_entry (p:program) (entry : string) : (lambda * type_value) result =
   let%bind entry = get_entry p entry in
   match entry.expression with
-  | E_lambda l -> ok (l, entry.type_annotation)
+  | E_lambda l -> ok (l , entry.type_annotation)
   | _ -> simple_fail "given entry point is not functional"
 

src/bin/cli.ml

@@ -11,95 +11,76 @@ let main =
   let term = Term.(const print_endline $ const "Ligo needs a command. Do ligo --help") in
   (term , Term.info "ligo")
 
+let source =
+  let open Arg in
+  let info =
+    let docv = "SOURCE_FILE" in
+    let doc = "$(docv) is the path to the .ligo file of the contract." in
+    info ~docv ~doc [] in
+  required @@ pos 0 (some string) None info
+
+let entry_point =
+  let open Arg in
+  let info =
+    let docv = "ENTRY_POINT" in
+    let doc = "$(docv) is entry-point that will be compiled." in
+    info ~docv ~doc [] in
+  value @@ pos 1 string "main" info
+
+let expression =
+  let open Arg in
+  let docv = "EXPRESSION" in
+  let doc = "$(docv) is the expression that will be compiled." in
+  let info = info ~docv ~doc [] in
+  required @@ pos 2 (some string) None info
+
+let syntax =
+  let open Arg in
+  let info =
+    let docv = "SYNTAX" in
+    let doc = "$(docv) is the syntax that will be used. Currently supported syntaxes are \"pascaligo\" and \"cameligo\". \"pascaligo\" is the default." in
+    info ~docv ~doc [] in
+  value @@ opt string "pascaligo" info
+
 let compile_file =
-  let f source entry_point =
+  let f source entry_point syntax =
     toplevel @@
     let%bind contract =
       trace (simple_error "compile michelson") @@
-      Ligo.Contract.compile_contract_file source entry_point in
+      Ligo.Run.compile_contract_file source entry_point syntax in
     Format.printf "Contract:\n%s\n" contract ;
     ok ()
   in
   let term =
-    let source =
+    Term.(const f $ source $ entry_point $ syntax) in
-      let open Arg in
-      let info =
-        let docv = "SOURCE_FILE" in
-        let doc = "$(docv) is the path to the .ligo file of the contract." in
-        info ~docv ~doc [] in
-      required @@ pos 0 (some string) None info in
-    let entry_point =
-      let open Arg in
-      let info =
-        let docv = "ENTRY_POINT" in
-        let doc = "$(docv) is entry-point that will be compiled." in
-        info ~docv ~doc [] in
-      value @@ pos 1 string "main" info in
-    Term.(const f $ source $ entry_point) in
   let docs = "Compile contracts." in
   (term , Term.info ~docs "compile-contract")
 
 let compile_parameter =
-  let f source entry_point expression =
+  let f source entry_point expression syntax =
     toplevel @@
     let%bind value =
       trace (simple_error "compile-input") @@
-      Ligo.Contract.compile_contract_parameter source entry_point expression in
+      Ligo.Run.compile_contract_parameter source entry_point expression syntax in
     Format.printf "Input:\n%s\n" value;
     ok ()
   in
   let term =
-    let source =
+    Term.(const f $ source $ entry_point $ expression $ syntax) in
-      let open Arg in
-      let docv = "SOURCE_FILE" in
-      let doc = "$(docv) is the path to the .ligo file of the contract." in
-      let info = info ~docv ~doc [] in
-      required @@ pos 0 (some string) None info in
-    let entry_point =
-      let open Arg in
-      let docv = "ENTRY_POINT" in
-      let doc = "$(docv) is the entry-point of the contract." in
-      let info = info ~docv ~doc [] in
-      required @@ pos 1 (some string) None info in
-    let expression =
-      let open Arg in
-      let docv = "EXPRESSION" in
-      let doc = "$(docv) is the expression that will be compiled." in
-      let info = info ~docv ~doc [] in
-      required @@ pos 2 (some string) None info in
-    Term.(const f $ source $ entry_point $ expression) in
   let docs = "Compile contracts parameters." in
   (term , Term.info ~docs "compile-parameter")
 
 let compile_storage =
-  let f source entry_point expression =
+  let f source entry_point expression syntax =
     toplevel @@
     let%bind value =
       trace (simple_error "compile-storage") @@
-      Ligo.Contract.compile_contract_storage source entry_point expression in
+      Ligo.Run.compile_contract_storage source entry_point expression syntax in
     Format.printf "Storage:\n%s\n" value;
     ok ()
   in
   let term =
-    let source =
+    Term.(const f $ source $ entry_point $ expression $ syntax) in
-      let open Arg in
-      let docv = "SOURCE_FILE" in
-      let doc = "$(docv) is the path to the .ligo file of the contract." in
-      let info = info ~docv ~doc [] in
-      required @@ pos 0 (some string) None info in
-    let entry_point =
-      let open Arg in
-      let docv = "ENTRY_POINT" in
-      let doc = "$(docv) is the entry-point of the contract." in
-      let info = info ~docv ~doc [] in
-      required @@ pos 1 (some string) None info in
-    let expression =
-      let open Arg in
-      let docv = "EXPRESSION" in
-      let doc = "$(docv) is the expression that will be compiled." in
-      let info = info ~docv ~doc [] in
-      required @@ pos 2 (some string) None info in
-    Term.(const f $ source $ entry_point $ expression) in
   let docs = "Compile contracts storage." in
   (term , Term.info ~docs "compile-storage")
 

src/contracts/counter.mligo

@@ -1,4 +1,4 @@
 type storage = int
 
 let%entry main (p:int) storage =
-  (list [] : operation list , p + storage)
+  (([] : operation list) , p + storage)

src/contracts/type-alias.ligo

@@ -0,0 +1,3 @@
+type toto is int
+
+const foo : toto = 23

src/main/main.ml

@@ -1,6 +1,6 @@
 module Run_mini_c = Run_mini_c
 
-open Trace
+(* open Trace *)
 module Parser = Parser
 module AST_Raw = Parser.Pascaligo.AST
 module AST_Simplified = Ast_simplified
@@ -8,189 +8,128 @@ module AST_Typed = Ast_typed
 module Mini_c = Mini_c
 module Typer = Typer
 module Transpiler = Transpiler
+
+module Run = struct
+  include Run_source
+  include Run_simplified
+  include Run_typed
+  include Run_mini_c
+end
+
 (* module Parser_multifix = Multifix
  * module Simplify_multifix = Simplify_multifix *)
 
 
-let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.Pascaligo.simpl_program p
+(* let simplify (p:AST_Raw.t) : Ast_simplified.program result = Simplify.Pascaligo.simpl_program p
-let simplify_expr (e:AST_Raw.expr) : Ast_simplified.expression result = Simplify.Pascaligo.simpl_expression e
+ * let simplify_expr (e:AST_Raw.expr) : Ast_simplified.expression result = Simplify.Pascaligo.simpl_expression e
-let unparse_simplified_expr (e:AST_Simplified.expression) : string result =
+ * let unparse_simplified_expr (e:AST_Simplified.expression) : string result =
-  ok @@ Format.asprintf "%a" AST_Simplified.PP.expression e
+ *   ok @@ Format.asprintf "%a" AST_Simplified.PP.expression e
-
+ * 
-let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p
+ * let type_ (p:AST_Simplified.program) : AST_Typed.program result = Typer.type_program p
-let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty)
+ * let type_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty)
-    (e:AST_Simplified.expression) : AST_Typed.annotated_expression result =
+ *     (e:AST_Simplified.expression) : AST_Typed.annotated_expression result =
-  Typer.type_expression env e
+ *   Typer.type_expression env e
-let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.expression result = Typer.untype_expression e
+ * let untype_expression (e:AST_Typed.annotated_expression) : AST_Simplified.expression result = Typer.untype_expression e
-
+ * 
-let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p
+ * let transpile (p:AST_Typed.program) : Mini_c.program result = Transpiler.translate_program p
-let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name
+ * let transpile_entry (p:AST_Typed.program) (name:string) : Mini_c.anon_function result = Transpiler.translate_entry p name
-let transpile_expression (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression e
+ * let transpile_expression (e:AST_Typed.annotated_expression) : Mini_c.expression result = Transpiler.translate_annotated_expression e
-let transpile_value
+ * 
-    (e:AST_Typed.annotated_expression) : Mini_c.value result =
+ * let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
-  let%bind f =
+ *   Transpiler.untranspile v e
-    let open Transpiler in
+ * 
-    let (f , _) = functionalize e in
+ * let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program
-    let%bind main = translate_main f in
+ * 
-    ok main
+ * let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result =
-  in
+ *   let%bind result =
-
+ *     let%bind mini_c_main =
-  let input = Mini_c.Combinators.d_unit in
+ *       transpile_entry program entry in
-  let%bind r = Run_mini_c.run_entry f input in
+ *     Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
-  ok r
+ *   let%bind typed_result =
-
+ *     let%bind typed_main = Ast_typed.get_entry program entry in
-let untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
+ *     untranspile_value result typed_main.type_annotation in
-  Transpiler.untranspile v e
+ *   ok typed_result
-
+ * 
-let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program
+ * 
-
+ * let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed")
-let type_file ?(debug_simplify = false) ?(debug_typed = false)
+ * 
-    (path:string) : AST_Typed.program result =
+ * 
-  let%bind raw = Parser.parse_file path in
+ * let easy_run_typed
-  let%bind simpl =
+ *     ?(debug_mini_c = false) ?options (entry:string)
-    trace (simple_error "simplifying") @@
+ *     (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
-    simplify raw in
+ *   let%bind () =
-  (if debug_simplify then
+ *     let open Ast_typed in
-     Format.(printf "Simplified : %a\n%!" AST_Simplified.PP.program simpl)
+ *     let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
-  ) ;
+ *     let%bind (arg_ty , _) =
-  let%bind typed =
+ *       trace_strong (simple_error "entry-point doesn't have a function type") @@
-    trace (simple_error "typing") @@
+ *       get_t_function @@ get_type_annotation d.annotated_expression in
-    type_ simpl in
+ *     Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
-  (if debug_typed then (
+ *   in
-      Format.(printf "Typed : %a\n%!" AST_Typed.PP.program typed)
+ * 
-    )) ;
+ *   let%bind mini_c_main =
-  ok typed
+ *     trace (simple_error "transpile mini_c entry") @@
+ *     transpile_entry program entry in
+ *   (if debug_mini_c then
+ *      Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
+ *   ) ;
+ * 
+ *   let%bind mini_c_value = transpile_value input in
+ * 
+ *   let%bind mini_c_result =
+ *     let error =
+ *       let title () = "run Mini_c" in
+ *       let content () =
+ *         Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
+ *       in
+ *       error title content in
+ *     trace error @@
+ *     Run_mini_c.run_entry ?options mini_c_main mini_c_value in
+ *   let%bind typed_result =
+ *     let%bind main_result_type =
+ *       let%bind typed_main = Ast_typed.get_functional_entry program entry in
+ *       match (snd typed_main).type_value' with
+ *       | T_function (_, result) -> ok result
+ *       | _ -> simple_fail "main doesn't have fun type" in
+ *     untranspile_value mini_c_result main_result_type in
+ *   ok typed_result
+ * 
+ * let easy_run_typed_simplified
+ *     ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
+ *     (program:AST_Typed.program) (input:Ast_simplified.expression) : Ast_simplified.expression result =
+ *   let%bind mini_c_main =
+ *     trace (simple_error "transpile mini_c entry") @@
+ *     transpile_entry program entry in
+ *   (if debug_mini_c then
+ *      Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
+ *   ) ;
+ * 
+ *   let%bind typed_value =
+ *     let env =
+ *       let last_declaration = Location.unwrap List.(hd @@ rev program) in
+ *       match last_declaration with
+ *       | Declaration_constant (_ , (_ , post_env)) -> post_env
+ *     in
+ *     type_expression ~env input in
+ *   let%bind mini_c_value = transpile_value typed_value in
+ * 
+ *   let%bind mini_c_result =
+ *     let error =
+ *       let title () = "run Mini_c" in
+ *       let content () =
+ *         Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
+ *       in
+ *       error title content in
+ *     trace error @@
+ *     Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in
+ *   let%bind typed_result =
+ *     let%bind main_result_type =
+ *       let%bind typed_main = Ast_typed.get_functional_entry program entry in
+ *       match (snd typed_main).type_value' with
+ *       | T_function (_, result) -> ok result
+ *       | _ -> simple_fail "main doesn't have fun type" in
+ *     untranspile_value mini_c_result main_result_type in
+ *   let%bind annotated_result = untype_expression typed_result in
+ *   ok annotated_result *)
 
 
-let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_expression result =
+(* module Contract = Contract *)
-  let%bind result =
-    let%bind mini_c_main =
-      transpile_entry program entry in
-    Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
-  let%bind typed_result =
-    let%bind typed_main = Ast_typed.get_entry program entry in
-    untranspile_value result typed_main.type_annotation in
-  ok typed_result
-
-let easy_evaluate_typed_simplified (entry:string) (program:AST_Typed.program) : Ast_simplified.expression result =
-  let%bind result =
-    let%bind mini_c_main =
-      transpile_entry program entry in
-    Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
-  let%bind typed_result =
-    let%bind typed_main = Ast_typed.get_entry program entry in
-    untranspile_value result typed_main.type_annotation in
-  let%bind annotated_result = untype_expression typed_result in
-  ok annotated_result
-
-let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed")
-
-let easy_run_typed
-    ?(debug_mini_c = false) ?options (entry:string)
-    (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
-  let%bind () =
-    let open Ast_typed in
-    let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
-    let%bind (arg_ty , _) =
-      trace_strong (simple_error "entry-point doesn't have a function type") @@
-      get_t_function @@ get_type_annotation d.annotated_expression in
-    Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
-  in
-
-  let%bind mini_c_main =
-    trace (simple_error "transpile mini_c entry") @@
-    transpile_entry program entry in
-  (if debug_mini_c then
-     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
-  ) ;
-
-  let%bind mini_c_value = transpile_value input in
-
-  let%bind mini_c_result =
-    let error =
-      let title () = "run Mini_c" in
-      let content () =
-        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
-      in
-      error title content in
-    trace error @@
-    Run_mini_c.run_entry ?options mini_c_main mini_c_value in
-  let%bind typed_result =
-    let%bind main_result_type =
-      let%bind typed_main = Ast_typed.get_functional_entry program entry in
-      match (snd typed_main).type_value' with
-      | T_function (_, result) -> ok result
-      | _ -> simple_fail "main doesn't have fun type" in
-    untranspile_value mini_c_result main_result_type in
-  ok typed_result
-
-let easy_run_typed_simplified
-    ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
-    (program:AST_Typed.program) (input:Ast_simplified.expression) : Ast_simplified.expression result =
-  let%bind mini_c_main =
-    trace (simple_error "transpile mini_c entry") @@
-    transpile_entry program entry in
-  (if debug_mini_c then
-     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
-  ) ;
-
-  let%bind typed_value =
-    let env =
-      let last_declaration = Location.unwrap List.(hd @@ rev program) in
-      match last_declaration with
-      | Declaration_constant (_ , (_ , post_env)) -> post_env
-    in
-    type_expression ~env input in
-  let%bind mini_c_value = transpile_value typed_value in
-
-  let%bind mini_c_result =
-    let error =
-      let title () = "run Mini_c" in
-      let content () =
-        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
-      in
-      error title content in
-    trace error @@
-    Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in
-  let%bind typed_result =
-    let%bind main_result_type =
-      let%bind typed_main = Ast_typed.get_functional_entry program entry in
-      match (snd typed_main).type_value' with
-      | T_function (_, result) -> ok result
-      | _ -> simple_fail "main doesn't have fun type" in
-    untranspile_value mini_c_result main_result_type in
-  let%bind annotated_result = untype_expression typed_result in
-  ok annotated_result
-
-let easy_run_main_typed
-    ?(debug_mini_c = false)
-    (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result =
-  easy_run_typed ~debug_mini_c "main" program input
-
-let easy_run_main (path:string) (input:string) : AST_Typed.annotated_expression result =
-  let%bind typed = type_file path in
-
-  let%bind raw_expr = Parser.parse_expression input in
-  let%bind simpl_expr = simplify_expr raw_expr in
-  let%bind typed_expr = type_expression simpl_expr in
-  easy_run_main_typed typed typed_expr
-
-let compile_file (source: string) (entry_point:string) : Michelson.t result =
-  let%bind raw =
-    trace (simple_error "parsing") @@
-    Parser.parse_file source in
-  let%bind simplified =
-    trace (simple_error "simplifying") @@
-    simplify raw in
-  let%bind typed =
-    trace (simple_error "typing") @@
-    type_ simplified in
-  let%bind mini_c =
-    trace (simple_error "transpiling") @@
-    transpile typed in
-  let%bind {body = michelson} =
-    trace (simple_error "compiling") @@
-    compile mini_c entry_point in
-  ok michelson
-
-module Contract = Contract

src/main/run_mini_c.ml

@@ -22,14 +22,6 @@ let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) :
     Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in
   ok (Ex_typed_value (output_ty, output))
 
-let run_node (program:program) (input:Michelson.t) : Michelson.t result =
-  let%bind compiled = translate_program program "main" in
-  let%bind (Ex_typed_value (output_ty, output)) = run_aux compiled input in
-  let%bind output =
-    Trace.trace_tzresult_lwt (simple_error "error unparsing output") @@
-    Memory_proto_alpha.unparse_michelson_data output_ty output in
-  ok output
-
 let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:value) : value result =
   let%bind compiled =
     let error =
@@ -45,17 +37,3 @@ let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:v
   let%bind ex_ty_value = run_aux ?options compiled input_michelson in
   let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
   ok result
-
-let run (program:program) (input:value) : value result =
-  let%bind input_michelson = translate_value input in
-  let%bind compiled = translate_program program "main" in
-  let%bind ex_ty_value = run_aux compiled input_michelson in
-  let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
-  ok result
-
-let expression_to_value (e:expression) : value result =
-  match (Combinators.Expression.get_content e) with
-  | E_literal v -> ok v
-  | _ -> fail
-      @@ error (thunk "not a value")
-      @@ (fun () -> Format.asprintf "%a" PP.expression e)

src/main/run_simplified.ml

@@ -0,0 +1,24 @@
+open Trace
+
+let run_simplityped
+    ?options
+    ?(debug_mini_c = false) ?(debug_michelson = false)
+    (program : Ast_typed.program) (entry : string)
+    (input : Ast_simplified.expression) : Ast_simplified.expression result =
+  let%bind typed_input =
+    let env =
+      let last_declaration = Location.unwrap List.(hd @@ rev program) in
+      match last_declaration with
+      | Declaration_constant (_ , (_ , post_env)) -> post_env
+    in
+    Typer.type_expression env input in  
+  let%bind typed_result =
+    Run_typed.run_typed ?options ~debug_mini_c ~debug_michelson entry program typed_input in
+  let%bind annotated_result = Typer.untype_expression typed_result in
+  ok annotated_result
+
+let evaluate_simplityped (program : Ast_typed.program) (entry : string)
+  : Ast_simplified.expression result =
+  let%bind typed_result = Run_typed.evaluate_typed entry program in
+  let%bind annotated_result = Typer.untype_expression typed_result in
+  ok annotated_result

src/main/run_source.ml

@@ -59,13 +59,60 @@ let transpile_value
   let%bind r = Run_mini_c.run_entry f input in
   ok r
 
-let compile_contract_file : string -> string -> string result = fun source entry_point ->
+let parsify_pascaligo = fun source ->
   let%bind raw =
     trace (simple_error "parsing") @@
-    Parser.parse_file source in
+    Parser.Pascaligo.parse_file source in
   let%bind simplified =
     trace (simple_error "simplifying") @@
     Simplify.Pascaligo.simpl_program raw in
+  ok simplified
+
+let parsify_expression_pascaligo = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing expression") @@
+    Parser.Pascaligo.parse_expression source in
+  let%bind simplified =
+    trace (simple_error "simplifying expression") @@
+    Simplify.Pascaligo.simpl_expression raw in
+  ok simplified
+
+let parsify_ligodity = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    Parser.Ligodity.parse_file source in
+  let%bind simplified =
+    trace (simple_error "simplifying") @@
+    Simplify.Ligodity.simpl_program raw in
+  ok simplified
+
+let parsify_expression_ligodity = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing expression") @@
+    Parser.Ligodity.parse_expression source in
+  let%bind simplified =
+    trace (simple_error "simplifying expression") @@
+    Simplify.Ligodity.simpl_expression raw in
+  ok simplified
+
+let parsify = fun syntax source ->
+  let%bind parsify = match syntax with
+    | "pascaligo" -> ok parsify_pascaligo
+    | "cameligo" -> ok parsify_ligodity
+    | _ -> simple_fail "unrecognized parser"
+  in
+  parsify source
+
+let parsify_expression = fun syntax source ->
+  let%bind parsify = match syntax with
+    | "pascaligo" -> ok parsify_expression_pascaligo
+    | "cameligo" -> ok parsify_expression_ligodity
+    | _ -> simple_fail "unrecognized parser"
+  in
+  parsify source
+
+let compile_contract_file : string -> string -> string -> string result = fun source entry_point syntax ->
+  let%bind simplified = parsify syntax source in
   let%bind () =
     assert_entry_point_defined simplified entry_point in
   let%bind typed =
@@ -81,14 +128,9 @@ let compile_contract_file : string -> string -> string result = fun source entry
     Format.asprintf "%a" Michelson.pp_stripped michelson in
   ok str
 
-let compile_contract_parameter : string -> string -> string -> string result = fun source entry_point expression ->
+let compile_contract_parameter : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
   let%bind (program , parameter_tv) =
-    let%bind raw =
+    let%bind simplified = parsify syntax source in
-      trace (simple_error "parsing file") @@
-      Parser.parse_file source in
-    let%bind simplified =
-      trace (simple_error "simplifying file") @@
-      Simplify.Pascaligo.simpl_program raw in
     let%bind () =
       assert_entry_point_defined simplified entry_point in
     let%bind typed =
@@ -99,13 +141,8 @@ let compile_contract_parameter : string -> string -> string -> string result = f
     ok (typed , param_ty)
   in
   let%bind expr =
-    let%bind raw =
-      trace (simple_error "parsing expression") @@
-      Parser.parse_expression expression in
-    let%bind simplified =
-      trace (simple_error "simplifying expression") @@
-      Simplify.Pascaligo.simpl_expression raw in
     let%bind typed =
+      let%bind simplified = parsify_expression syntax expression in
       let env =
         let last_declaration = Location.unwrap List.(hd @@ rev program) in
         match last_declaration with
@@ -129,14 +166,9 @@ let compile_contract_parameter : string -> string -> string -> string result = f
   ok expr
 
 
-let compile_contract_storage : string -> string -> string -> string result = fun source entry_point expression ->
+let compile_contract_storage : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
   let%bind (program , storage_tv) =
-    let%bind raw =
+    let%bind simplified = parsify syntax source in
-      trace (simple_error "parsing file") @@
-      Parser.parse_file source in
-    let%bind simplified =
-      trace (simple_error "simplifying file") @@
-      Simplify.Pascaligo.simpl_program raw in
     let%bind () =
       assert_entry_point_defined simplified entry_point in
     let%bind typed =
@@ -147,12 +179,7 @@ let compile_contract_storage : string -> string -> string -> string result = fun
     ok (typed , storage_ty)
   in
   let%bind expr =
-    let%bind raw =
+    let%bind simplified = parsify_expression syntax expression in
-      trace (simple_error "parsing expression") @@
-      Parser.parse_expression expression in
-    let%bind simplified =
-      trace (simple_error "simplifying expression") @@
-      Simplify.Pascaligo.simpl_expression raw in
     let%bind typed =
       let env =
         let last_declaration = Location.unwrap List.(hd @@ rev program) in
@@ -175,3 +202,17 @@ let compile_contract_storage : string -> string -> string -> string result = fun
     ok str
   in
   ok expr
+
+let type_file ?(debug_simplify = false) ?(debug_typed = false)
+    syntax (path:string) : Ast_typed.program result =
+  let%bind simpl = parsify syntax path in
+  (if debug_simplify then
+     Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl)
+  ) ;
+  let%bind typed =
+    trace (simple_error "typing") @@
+    Typer.type_program simpl in
+  (if debug_typed then (
+      Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed)
+    )) ;
+  ok typed

src/main/run_typed.ml

@@ -0,0 +1,64 @@
+open Trace
+
+let transpile_value
+    (e:Ast_typed.annotated_expression) : Mini_c.value result =
+  let%bind f =
+    let open Transpiler in
+    let (f , _) = functionalize e in
+    let%bind main = translate_main f in
+    ok main
+  in
+
+  let input = Mini_c.Combinators.d_unit in
+  let%bind r = Run_mini_c.run_entry f input in
+  ok r
+
+let evaluate_typed (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result =
+  trace (simple_error "easy evaluate typed") @@
+  let%bind result =
+    let%bind mini_c_main =
+      Transpiler.translate_entry program entry in
+    Run_mini_c.run_entry mini_c_main (Mini_c.Combinators.d_unit) in
+  let%bind typed_result =
+    let%bind typed_main = Ast_typed.get_entry program entry in
+    Transpiler.untranspile result typed_main.type_annotation in
+  ok typed_result
+
+let run_typed
+    ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string)
+    (program:Ast_typed.program) (input:Ast_typed.annotated_expression) : Ast_typed.annotated_expression result =
+  let%bind () =
+    let open Ast_typed in
+    let%bind (Declaration_constant (d , _)) = get_declaration_by_name program entry in
+    let%bind (arg_ty , _) =
+      trace_strong (simple_error "entry-point doesn't have a function type") @@
+      get_t_function @@ get_type_annotation d.annotated_expression in
+    Ast_typed.assert_type_value_eq (arg_ty , (Ast_typed.get_type_annotation input))
+  in
+
+  let%bind mini_c_main =
+    trace (simple_error "transpile mini_c entry") @@
+    Transpiler.translate_entry program entry in
+  (if debug_mini_c then
+     Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
+  ) ;
+
+  let%bind mini_c_value = transpile_value input in
+
+  let%bind mini_c_result =
+    let error =
+      let title () = "run Mini_c" in
+      let content () =
+        Format.asprintf "\n%a" Mini_c.PP.function_ mini_c_main
+      in
+      error title content in
+    trace error @@
+    Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in
+  let%bind typed_result =
+    let%bind main_result_type =
+      let%bind typed_main = Ast_typed.get_functional_entry program entry in
+      match (snd typed_main).type_value' with
+      | T_function (_, result) -> ok result
+      | _ -> simple_fail "main doesn't have fun type" in
+    Transpiler.untranspile mini_c_result main_result_type in
+  ok typed_result

src/parser/ligodity.ml

@@ -0,0 +1,98 @@
+open Trace
+open Parser_ligodity
+module Parser = Parser_ligodity.Parser
+module AST = Parser_ligodity.AST
+
+let parse_file (source: string) : AST.t result =  
+  (* let pp_input =
+   *   let prefix = Filename.(source |> basename |> remove_extension)
+   *   and suffix = ".pp.ligo"
+   *   in prefix ^ suffix in *)
+
+  (* let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s"
+   *                              source pp_input in
+   * let%bind () = sys_command cpp_cmd in *)
+
+  let pp_input =
+    source
+  in
+  let%bind channel =
+    generic_try (simple_error "error opening file") @@
+    (fun () -> open_in pp_input) in
+  let lexbuf = Lexing.from_channel channel in
+  let read = Lexer.get_token in
+  specific_try (function
+      | Parser.Error -> (
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
+              start.pos_fname source
+          in
+          simple_error str
+        )
+      | exn ->
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
+              (Printexc.to_string exn)
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
+              start.pos_fname source
+          in
+          simple_error str
+    ) @@ (fun () -> Parser.program read lexbuf) >>? fun raw ->
+  ok raw
+
+let parse_string (s:string) : AST.t result =
+  
+  let lexbuf = Lexing.from_string s in
+  let read = Lexer.get_token in
+  specific_try (function
+      | Parser.Error -> (
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
+          simple_error str
+        )
+      | _ -> simple_error "unrecognized parse_ error"
+    ) @@ (fun () -> Parser.program read lexbuf)  >>? fun raw ->
+  ok raw
+
+let parse_expression (s:string) : AST.expr result =
+  let lexbuf = Lexing.from_string s in
+  let read = Lexer.get_token in
+  specific_try (function
+      | Parser.Error -> (
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
+          simple_error str
+        )
+      | exn ->
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
+              (Printexc.to_string exn)
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
+              start.pos_fname s
+          in
+          simple_error str
+    ) @@ (fun () -> Parser.expr read lexbuf) >>? fun raw ->
+  ok raw

src/parser/ligodity/AST.ml

@@ -116,7 +116,7 @@ and declaration =
 (* Non-recursive values *)
 
 and let_binding = {
-  variable : variable;
+  bindings : pattern list;
   lhs_type : (colon * type_expr) option;
   eq       : equal;
   let_rhs  : expr
@@ -327,7 +327,7 @@ and let_in = {
 
 and fun_expr = {
   kwd_fun : kwd_fun;
-  param   : variable;
+  params  : pattern list;
   p_annot : (colon * type_expr) option;
   arrow   : arrow;
   body    : expr
@@ -544,8 +544,8 @@ and print_terminator = function
   Some semi -> print_token semi ";"
 | None -> ()
 
-and print_let_binding {variable; lhs_type; eq; let_rhs} =
+and print_let_binding {bindings; lhs_type; eq; let_rhs} =
-  print_var variable;
+  List.iter print_pattern bindings;
   (match lhs_type with
      None -> ()
    | Some (colon, type_expr) ->
@@ -737,10 +737,10 @@ and print_let_in (bind: let_in) =
   print_expr body
 
 and print_fun_expr {value; _} =
-  let {kwd_fun; param; p_annot; arrow; body} = value in
+  let {kwd_fun; params; p_annot; arrow; body} = value in
   print_token kwd_fun "fun";
   (match p_annot with
-     None -> print_var param
+     None -> List.iter print_pattern params
    | Some (colon, type_expr) ->
       print_token colon ":";
       print_type_expr type_expr);

src/parser/ligodity/AST.mli

@@ -125,7 +125,7 @@ and declaration =
 (* Non-recursive values *)
 
 and let_binding = {                                  (* p = e   p : t = e *)
-  variable : variable;
+  bindings : pattern list;
   lhs_type : (colon * type_expr) option;
   eq       : equal;
   let_rhs  : expr
@@ -336,7 +336,7 @@ and let_in = {
 
 and fun_expr = {
   kwd_fun : kwd_fun;
-  param   : variable;
+  params  : pattern list;
   p_annot : (colon * type_expr) option;
   arrow   : arrow;
   body    : expr
@@ -486,3 +486,4 @@ val unpar : expr -> expr
 
 val print_projection : projection -> unit
 val print_pattern : pattern -> unit
+val print_expr : expr -> unit

src/parser/ligodity/Parser.mly

@@ -7,10 +7,10 @@ open AST
 
 module VMap = Utils.String.Map
 
-let ghost_of value = Region.{region=ghost; value}
+(*let ghost_of value = Region.{region=ghost; value}*)
 let ghost = Region.ghost
 
-let fail_syn_unif type1 type2 : 'a =
+(* let fail_syn_unif type1 type2 : 'a =
   let reg = AST.region_of_type_expr type1 in
   let reg = reg#compact ~file:false `Byte in
   let value =
@@ -25,167 +25,31 @@ let mk_component rank =
   let par = {lpar=ghost; inside = ghost_of num; rpar=ghost}
   in Component (ghost_of par)
 
+
 let rec mk_field_path (rank, tail) =
   let head = mk_component rank in
   match tail with
         [] -> head, []
   | hd::tl -> mk_field_path (hd,tl) |> Utils.nsepseq_cons head ghost
 
-let mk_projection fresh (path : int Utils.nseq) = {
+ let mk_projection fresh (path : int Utils.nseq) = {
   struct_name = fresh;
   selector    = ghost;
   field_path  = Utils.nsepseq_rev (mk_field_path path)
-}
+} *)
 
-let rec sub_rec fresh path (map, rank) pattern =
-  let path' = Utils.nseq_cons rank path in
-  let map'  = split fresh map path' pattern
-  in map', rank+1
-
-and split fresh map path = function
-  PTuple t -> let apply = sub_rec fresh path in
-             Utils.nsepseq_foldl apply (map,1) t.value |> fst
-| PPar p   -> split fresh map path p.value.inside
-| PVar v   -> if VMap.mem v.value map
-             then
-               let err =
-                 Region.{value="Non-linear pattern."; region=v.region}
-               in (Lexer.prerr ~kind:"Syntactical" err; exit 1)
-             else
-               let proj = mk_projection fresh path
-               in VMap.add v.value (None, proj) map
-| PWild _  -> map
-| PUnit _  -> let anon = Utils.gen_sym () in
-             let unit = ghost, TAlias (ghost_of "unit")
-             and proj = mk_projection fresh path
-             in VMap.add anon (Some unit, proj) map
-| PRecord {region; _}
-| PConstr {region; _}
-| PTyped {region; _} ->
-    let err = Region.{value="Not implemented yet."; region}
-    in (Lexer.prerr ~kind:"Syntactical" err; exit 1)
-| p -> let _, _, map = split_pattern p in map
-
-and split_pattern = function
-  PPar p  -> split_pattern p.value.inside
-| PVar v  -> v, None, VMap.empty
-| PWild _ -> Utils.gen_sym () |> ghost_of, None, VMap.empty
-| PUnit _ -> let fresh = Utils.gen_sym () |> ghost_of in
-            let unit = TAlias (ghost_of "unit")
-            in fresh, Some unit, VMap.empty
-| PTyped {value=p; _} ->
-    let var', type', map = split_pattern p.pattern in
-    (match type' with
-       None -> var', Some p.type_expr, map
-     | Some t when t = p.type_expr -> var', Some t, map (* hack *)
-     | Some t -> fail_syn_unif t p.type_expr)
-| PTuple t ->
-    let fresh = Utils.gen_sym () |> ghost_of
-    and init = VMap.empty, 1 in
-    let apply (map, rank) pattern =
-      split fresh map (rank,[]) pattern, rank+1 in
-    let map = Utils.nsepseq_foldl apply init t.value |> fst
-    in fresh, None, map
-| PRecord {region; _}
-| PConstr {region; _} ->
-    let err = Region.{value="Not implemented yet."; region}
-    in (Lexer.prerr ~kind:"Syntactical" err; exit 1)
-| PInt {region; _} | PTrue region
-| PFalse region | PString {region; _}
-| PList Sugar {region; _} | PList PCons {region; _} ->
-    let err = Region.{value="Incomplete pattern."; region}
-    in (Lexer.prerr ~kind:"Syntactical" err; exit 1)
-
-let mk_let_bindings =
-  let apply var (lhs_type, proj) =
-    let new_bind = {
-      variable = ghost_of var;
-      lhs_type;
-      eq = ghost;
-      let_rhs = EProj (ghost_of proj)} in
-    let new_let = Let (ghost_of (ghost, new_bind))
-    in Utils.nseq_cons new_let
-  in VMap.fold apply
-
-let mk_let_in_bindings =
-  let apply var (lhs_type, proj) acc =
-    let binding = {
-      variable = ghost_of var;
-      lhs_type;
-      eq = ghost;
-      let_rhs = EProj (ghost_of proj)} in
-    let let_in = {
-      kwd_let = ghost;
-      binding;
-      kwd_in = ghost;
-      body = acc}
-    in ELetIn (ghost_of let_in)
-  in VMap.fold apply
 
 (* We rewrite "fun p -> e" into "fun x -> match x with p -> e" *)
 
-let norm_fun_expr patterns expr =
-  let apply pattern expr =
-    match pattern with
-      PVar var ->
-        let fun_expr = {
-          kwd_fun = ghost;
-          param   = var;
-          p_annot = None;
-          arrow   = ghost;
-          body    = expr}
-        in EFun (ghost_of fun_expr)
-    | PTyped p ->
-        let pattern = p.value.pattern
-        and type_expr = p.value.type_expr in
-        let fresh = Utils.gen_sym () |> ghost_of in
-        let clause = {pattern; arrow=ghost; rhs=expr} in
-        let clause = ghost_of clause in
-        let cases = ghost_of (clause, []) in
-        let case = {
-          kwd_match = ghost;
-          expr      = EVar fresh;
-          opening   = With ghost;
-          lead_vbar = None;
-          cases;
-          closing   = End ghost} in
-        let case = ECase (ghost_of case) in
-        let fun_expr = {
-          kwd_fun = ghost;
-          param   = fresh;
-          p_annot = Some (p.value.colon, type_expr);
-          arrow   = ghost;
-          body    = case}
-        in EFun (ghost_of fun_expr)
-    | _ -> let fresh = Utils.gen_sym () |> ghost_of in
-          let clause = {pattern; arrow=ghost; rhs=expr} in
-          let clause = ghost_of clause in
-          let cases = ghost_of (clause, []) in
-          let case = {
-            kwd_match = ghost;
-            expr      = EVar fresh;
-            opening   = With ghost;
-            lead_vbar = None;
-            cases;
-            closing   = End ghost} in
-          let case = ECase (ghost_of case) in
-          let fun_expr = {
-            kwd_fun = ghost;
-            param   = fresh;
-            p_annot = None;
-            arrow   = ghost;
-            body    = case}
-          in EFun (ghost_of fun_expr)
-  in Utils.nseq_foldr apply patterns expr
-
 (* END HEADER *)
 %}
 
 
 (* Entry points *)
 
-%start program
+%start program expr
 %type <AST.t> program
+%type <AST.expr> expr
 
 %%
 
@@ -330,7 +194,7 @@ declarations:
 declaration:
   reg(kwd(LetEntry) entry_binding {$1,$2})          { LetEntry $1, [] }
 | reg(type_decl)                                    { TypeDecl $1, [] }
-| let_declaration                                   {              $1 }
+| let_declaration                                   {          $1, [] }
 
 (* Type declarations *)
 
@@ -415,36 +279,33 @@ field_decl:
 
 entry_binding:
   ident nseq(sub_irrefutable) type_annotation? eq expr {
-    let let_rhs = norm_fun_expr $2 $5 in
+    let let_rhs = $5 in
-    {variable = $1; lhs_type=$3; eq=$4; let_rhs}
+    let pattern = PVar $1 in
+    let (hd , tl) = $2 in
+    {bindings = pattern :: hd :: tl; lhs_type=$3; eq=$4; let_rhs}
   }
-| ident type_annotation? eq fun_expr(expr) {
+  | ident type_annotation? eq fun_expr(expr) {
-    {variable = $1; lhs_type=$2; eq=$3; let_rhs=$4} }
+    let pattern = PVar $1 in	    
+    {bindings = [pattern]; lhs_type=$2; eq=$3; let_rhs=$4} }
 
 (* Top-level non-recursive definitions *)
 
 let_declaration:
   reg(kwd(Let) let_binding {$1,$2}) {
-    let kwd_let, (binding, map) = $1.value in
+    let kwd_let, binding = $1.value in
-    let let0 = Let {$1 with value = kwd_let, binding}
+    Let {$1 with value = kwd_let, binding}
-    in mk_let_bindings map (let0,[])
   }
 
 let_binding:
   ident nseq(sub_irrefutable) type_annotation? eq expr {
-    let let_rhs = norm_fun_expr $2 $5 in
+    let let_rhs = $5 in
-    let map = VMap.empty in
+    let ident_pattern = PVar $1 in
-    {variable=$1; lhs_type=$3; eq=$4; let_rhs}, map
+    let (hd , tl) = $2 in
+    {bindings= (ident_pattern :: hd :: tl); lhs_type=$3; eq=$4; let_rhs}
   }
 | irrefutable type_annotation? eq expr {
-    let variable, type_opt, map = split_pattern $1 in
+    let pattern = $1 in
-    match type_opt, $2 with
+    {bindings = [pattern]; lhs_type=$2; eq=$3; let_rhs=$4}
-      Some type1, Some (_,type2) when type1 <> type2 ->
-        fail_syn_unif type1 type2
-    | Some type1, None ->
-         let lhs_type = Some (ghost, type1) in
-         {variable; lhs_type; eq=$3; let_rhs=$4}, map
-    | _ -> {variable; lhs_type=$2; eq=$3; let_rhs=$4}, map
   }
 
 type_annotation:
@@ -590,14 +451,24 @@ case_clause(right_expr):
 
 let_expr(right_expr):
   reg(kwd(Let) let_binding kwd(In) right_expr {$1,$2,$3,$4}) {
-    let kwd_let, (binding, map), kwd_in, body = $1.value in
+    let kwd_let, binding , kwd_in, body = $1.value in
-    let body = mk_let_in_bindings map body in
     let let_in = {kwd_let; binding; kwd_in; body}
     in ELetIn {region=$1.region; value=let_in} }
 
 fun_expr(right_expr):
-  kwd(Fun) nseq(irrefutable) arrow right_expr   { norm_fun_expr $2 $4 }
+  reg(kwd(Fun) nseq(irrefutable) arrow right_expr {$1,$2,$3,$4}) {
-
+    let kwd_fun, bindings, arrow, body = $1.value in
+    let (hd , tl) = bindings in
+    let f = {
+      kwd_fun ;
+      params = hd :: tl ;
+      p_annot = None ;
+      arrow ;
+      body ;
+    } in
+    EFun { region=$1.region; value=f }
+  }
+	 
 disj_expr_level:
   reg(disj_expr)                          { ELogic (BoolExpr (Or $1)) }
 | conj_expr_level                                                { $1 }

src/parser/parser.ml

@@ -1,117 +1,5 @@
-open Trace
+module Pascaligo = Pascaligo
-
-module Pascaligo = Parser_pascaligo
 module Camligo = Parser_camligo
-module Ligodity = Parser_ligodity
+module Ligodity = Ligodity
-
-open Parser_pascaligo
-module AST_Raw = Parser_pascaligo.AST
 
 
-let parse_file (source: string) : AST_Raw.t result =
-  let pp_input =
-    let prefix = Filename.(source |> basename |> remove_extension)
-    and suffix = ".pp.ligo"
-    in prefix ^ suffix in
-
-  let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s"
-                               source pp_input in
-  let%bind () = sys_command cpp_cmd in
-
-  let%bind channel =
-    generic_try (simple_error "error opening file") @@
-    (fun () -> open_in pp_input) in
-  let lexbuf = Lexing.from_channel channel in
-  let module Lexer = Lexer.Make(LexToken) in
-  let Lexer.{read ; close ; _} =
-    Lexer.open_token_stream None in
-  specific_try (function
-      | Parser.Error -> (
-          let start = Lexing.lexeme_start_p lexbuf in
-          let end_ = Lexing.lexeme_end_p lexbuf in
-          let str = Format.sprintf
-              "Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
-              (Lexing.lexeme lexbuf)
-              start.pos_lnum (start.pos_cnum - start.pos_bol)
-              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
-              start.pos_fname source
-          in
-          simple_error str
-        )
-      | exn ->
-          let start = Lexing.lexeme_start_p lexbuf in
-          let end_ = Lexing.lexeme_end_p lexbuf in
-          let str = Format.sprintf
-              "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
-              (Printexc.to_string exn)
-              (Lexing.lexeme lexbuf)
-              start.pos_lnum (start.pos_cnum - start.pos_bol)
-              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
-              start.pos_fname source
-          in
-          simple_error str
-    ) @@ (fun () ->
-      let raw = Parser.contract read lexbuf in
-      close () ;
-      raw
-    ) >>? fun raw ->
-  ok raw
-
-let parse_string (s:string) : AST_Raw.t result =
-  let lexbuf = Lexing.from_string s in
-  let module Lexer = Lexer.Make(LexToken) in
-  let Lexer.{read ; close ; _} =
-    Lexer.open_token_stream None in
-  specific_try (function
-      | Parser.Error -> (
-          let start = Lexing.lexeme_start_p lexbuf in
-          let end_ = Lexing.lexeme_end_p lexbuf in
-          let str = Format.sprintf
-              "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
-              (Lexing.lexeme lexbuf)
-              start.pos_lnum (start.pos_cnum - start.pos_bol)
-              end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
-          simple_error str
-        )
-      | _ -> simple_error "unrecognized parse_ error"
-    ) @@ (fun () ->
-      let raw = Parser.contract read lexbuf in
-      close () ;
-      raw
-    ) >>? fun raw ->
-  ok raw
-
-let parse_expression (s:string) : AST_Raw.expr result =
-  let lexbuf = Lexing.from_string s in
-  let module Lexer = Lexer.Make(LexToken) in
-  let Lexer.{read ; close; _} =
-    Lexer.open_token_stream None in
-  specific_try (function
-      | Parser.Error -> (
-          let start = Lexing.lexeme_start_p lexbuf in
-          let end_ = Lexing.lexeme_end_p lexbuf in
-          let str = Format.sprintf
-              "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
-              (Lexing.lexeme lexbuf)
-              start.pos_lnum (start.pos_cnum - start.pos_bol)
-              end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
-          simple_error str
-        )
-      | exn ->
-          let start = Lexing.lexeme_start_p lexbuf in
-          let end_ = Lexing.lexeme_end_p lexbuf in
-          let str = Format.sprintf
-              "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
-              (Printexc.to_string exn)
-              (Lexing.lexeme lexbuf)
-              start.pos_lnum (start.pos_cnum - start.pos_bol)
-              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
-              start.pos_fname s
-          in
-          simple_error str
-    ) @@ (fun () ->
-      let raw = Parser.interactive_expr read lexbuf in
-      close () ;
-      raw
-    ) >>? fun raw ->
-  ok raw

src/parser/pascaligo.ml

@@ -0,0 +1,114 @@
+open Trace
+open Parser_pascaligo
+module Parser = Parser_pascaligo.Parser
+module AST = Parser_pascaligo.AST
+module ParserLog = Parser_pascaligo.ParserLog
+
+let parse_file (source: string) : AST.t result =  
+  let pp_input =
+    let prefix = Filename.(source |> basename |> remove_extension)
+    and suffix = ".pp.ligo"
+    in prefix ^ suffix in
+
+  let cpp_cmd = Printf.sprintf "cpp -traditional-cpp %s > %s"
+                               source pp_input in
+  let%bind () = sys_command cpp_cmd in
+
+  let%bind channel =
+    generic_try (simple_error "error opening file") @@
+    (fun () -> open_in pp_input) in
+  let lexbuf = Lexing.from_channel channel in
+  let module Lexer = Lexer.Make(LexToken) in
+  let Lexer.{read ; close ; _} =
+    Lexer.open_token_stream None in
+  specific_try (function
+      | Parser.Error -> (
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Parse error at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
+              start.pos_fname source
+          in
+          simple_error str
+        )
+      | exn ->
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In file \"%s|%s\"\n"
+              (Printexc.to_string exn)
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
+              start.pos_fname source
+          in
+          simple_error str
+    ) @@ (fun () ->
+      let raw = Parser.contract read lexbuf in
+      close () ;
+      raw
+    ) >>? fun raw ->
+  ok raw
+
+let parse_string (s:string) : AST.t result =
+  
+  let lexbuf = Lexing.from_string s in
+  let module Lexer = Lexer.Make(LexToken) in
+  let Lexer.{read ; close ; _} =
+    Lexer.open_token_stream None in
+  specific_try (function
+      | Parser.Error -> (
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
+          simple_error str
+        )
+      | _ -> simple_error "unrecognized parse_ error"
+    ) @@ (fun () ->
+      let raw = Parser.contract read lexbuf in
+      close () ;
+      raw
+    ) >>? fun raw ->
+  ok raw
+
+let parse_expression (s:string) : AST.expr result =
+  let lexbuf = Lexing.from_string s in
+  let module Lexer = Lexer.Make(LexToken) in
+  let Lexer.{read ; close; _} =
+    Lexer.open_token_stream None in
+  specific_try (function
+      | Parser.Error -> (
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Parse error at \"%s\" from (%d, %d) to (%d, %d)\n"
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol) in
+          simple_error str
+        )
+      | exn ->
+          let start = Lexing.lexeme_start_p lexbuf in
+          let end_ = Lexing.lexeme_end_p lexbuf in
+          let str = Format.sprintf
+              "Unrecognized error (%s) at \"%s\" from (%d, %d) to (%d, %d). In expression \"%s|%s\"\n"
+              (Printexc.to_string exn)
+              (Lexing.lexeme lexbuf)
+              start.pos_lnum (start.pos_cnum - start.pos_bol)
+              end_.pos_lnum (end_.pos_cnum - end_.pos_bol)
+              start.pos_fname s
+          in
+          simple_error str
+    ) @@ (fun () ->
+      let raw = Parser.interactive_expr read lexbuf in
+      close () ;
+      raw
+    ) >>? fun raw ->
+  ok raw

src/simplify/camligo.ml

@@ -206,7 +206,7 @@ and ifthenelse
   let%bind cond' = bind_map_location expression cond in
   let%bind branch_true' = bind_map_location expression branch_true in
   let%bind branch_false' = bind_map_location expression branch_false in
-  ok @@ O.(e_match_bool (unwrap cond') (unwrap branch_true') (unwrap branch_false'))
+  ok @@ O.(e_matching_bool (unwrap cond') (unwrap branch_true') (unwrap branch_false'))
 
 and ifthen
   : (I.expression Location.wrap * I.expression Location.wrap) -> O.expression result
@@ -214,7 +214,7 @@ and ifthen
   let (cond , branch_true) = it in
   let%bind cond' = bind_map_location expression cond in
   let%bind branch_true' = bind_map_location expression branch_true in
-  ok @@ O.(e_match_bool (unwrap cond') (unwrap branch_true') (e_unit ()))
+  ok @@ O.(e_matching_bool (unwrap cond') (unwrap branch_true') (e_unit ()))
 
 and match_
   : I.expression Location.wrap * I.e_match_clause Location.wrap list -> O.expression result
@@ -231,7 +231,7 @@ and match_
         ok (x' , y') in
       bind_map_list aux clauses in
     let%bind matching = match_clauses clauses' in
-    ok O.(e_match expr' matching)
+    ok O.(e_matching expr' matching)
 
 and record
   = fun r ->
@@ -244,7 +244,7 @@ and record
   in
   let%bind r' = bind_map_list (bind_map_location aux) r in
   let lst = List.map ((fun (x, y) -> unwrap x, unwrap y) >| unwrap) r' in
-  ok @@ O.(e_record lst)
+  ok @@ O.(e_ez_record lst)
 
 and expression_main : I.expression_main Location.wrap -> O.expression result = fun em ->
   let return x = ok @@ x in
@@ -334,13 +334,13 @@ and expression_main : I.expression_main Location.wrap -> O.expression result = f
 and identifier_application : (string Location.wrap) list * string Location.wrap -> O.expression option -> _ result = fun (lst , v) param_opt ->
   let constant_name = String.concat "." ((List.map unwrap lst) @ [unwrap v]) in
   match List.assoc_opt constant_name constants , param_opt with
-  | Some s , None -> ok O.(E_constant (s , []))
+  | Some s , None -> ok O.(e_constant s [])
   | Some s , Some param -> (
       let params =
-        match param with
+        match Location.unwrap param with
         | E_tuple lst -> lst
         | _ -> [ param ] in
-      ok O.(E_constant (s , params))
+      ok O.(e_constant s params)
     )
   | None , param_opt -> (
       let%bind () =

src/simplify/ligodity.ml

@@ -19,6 +19,35 @@ let get_value : 'a Raw.reg -> 'a = fun x -> x.value
 
 open Operators.Simplify.Ligodity
 
+let r_split = Location.r_split
+
+let rec pattern_to_var : Raw.pattern -> _ = fun p ->
+  match p with
+  | Raw.PPar p -> pattern_to_var p.value.inside
+  | Raw.PVar v -> ok v
+  | _ -> simple_fail "not a var"
+
+let rec pattern_to_typed_var : Raw.pattern -> _ = fun p ->
+  match p with
+  | Raw.PPar p -> pattern_to_typed_var p.value.inside
+  | Raw.PTyped tp -> (
+      let tp = tp.value in
+      let%bind v = pattern_to_var tp.pattern in
+      ok (v , Some tp.type_expr)
+    )
+  | Raw.PVar v -> ok (v , None)
+  | _ -> simple_fail "not a var"
+
+let rec expr_to_typed_expr : Raw.expr -> _ = fun e ->
+  match e with
+  | EPar e -> expr_to_typed_expr e.value.inside
+  | EAnnot a -> ok (fst a.value , Some (snd a.value))
+  | _ -> ok (e , None)
+
+let patterns_to_var : Raw.pattern list -> _ = fun ps ->
+  let%bind () = Assert.assert_list_size ps 1 in
+  pattern_to_var @@ List.hd ps
+
 let rec simpl_type_expression : Raw.type_expr -> type_expression result =
   function
   | TPar x -> simpl_type_expression x.value.inside
@@ -79,9 +108,10 @@ and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result
       ok @@ T_tuple lst
 
 let rec simpl_expression :
-  ?te_annot:type_expression -> Raw.expr -> expr result = fun ?te_annot t ->
+  Raw.expr -> expr result = fun t ->
-  let return x = ok @@ make_option_typed x te_annot in
+  let return x = ok x in
-  let simpl_projection = fun (p:Raw.projection) ->
+  let simpl_projection = fun (p:Raw.projection Region.reg) ->
+    let (p , loc) = r_split p in
     let var =
       let name = p.struct_name.value in
       e_variable name in
@@ -95,107 +125,136 @@ let rec simpl_expression :
             Access_tuple (Z.to_int (snd index.value))
       in
       List.map aux @@ npseq_to_list path in
-    return @@ E_accessor (var, path')
+    return @@ e_accessor ~loc var path'
   in
-  let mk_let_in binder rhs result =
-    E_let_in {binder; rhs; result} in
 
+  trace (
+    let title () = "simplifying expression" in
+    let message () = "" in
+    let data = [
+      ("expression" , thunk @@ Format.asprintf "%a" (PP_helpers.printer Raw.print_expr) t)
+    ] in
+    error ~data title message
+  ) @@
   match t with
   | Raw.ELetIn e -> (
-      let Raw.{binding; body; _} = e.value in
+      let Raw.{binding ; body ; _} = e.value in
-      let Raw.{variable; lhs_type; let_rhs; _} = binding in
+      let Raw.{bindings ; lhs_type ; let_rhs ; _} = binding in
-      let%bind type_annotation = bind_map_option
+      let%bind variable = patterns_to_var bindings in
-          (fun (_,type_expr) -> simpl_type_expression type_expr)
+      let%bind ty_opt =
+        bind_map_option
+          (fun (_ , type_expr) -> simpl_type_expression type_expr)
           lhs_type in
-      let%bind rhs = simpl_expression ?te_annot:type_annotation let_rhs in
+      let%bind rhs = simpl_expression let_rhs in
+      let rhs' =
+        match ty_opt with
+        | None -> rhs
+        | Some ty -> e_annotation rhs ty in
       let%bind body = simpl_expression body in
-      return @@ mk_let_in (variable.value , None) rhs body
+      return @@ e_let_in (variable.value , None) rhs' body
     )
   | Raw.EAnnot a -> (
-      let (expr , type_expr) = a.value in
+      let (a , loc) = r_split a in
-      match te_annot with
+      let (expr , type_expr) = a in
-      | None -> (
+      let%bind expr' = simpl_expression expr in
-          let%bind te_annot = simpl_type_expression type_expr in
+      let%bind type_expr' = simpl_type_expression type_expr in
-          let%bind expr' = simpl_expression ~te_annot expr in
+      return @@ e_annotation ~loc expr' type_expr'
-          ok expr'
-        )
-      | Some _ -> simple_fail "no double annotation"
     )
   | EVar c -> (
       let c' = c.value in
       match List.assoc_opt c' constants with
-      | None -> return @@ E_variable c.value
+      | None -> return @@ e_variable c.value
-      | Some s -> return @@ E_constant (s , [])
+      | Some s -> return @@ e_constant s []
     )
   | ECall x -> (
-      let (e1, e2) = x.value in
+      let ((e1 , e2) , loc) = r_split x in
       let%bind args = bind_map_list simpl_expression (nseq_to_list e2) in
       match e1 with
-      | EVar f ->
+      | EVar f -> (
-          (match List.assoc_opt f.value constants with
+          let (f , f_loc) = r_split f in
-          | None ->
+          match List.assoc_opt f constants with
+          | None -> (
               let%bind arg = simpl_tuple_expression (nseq_to_list e2) in
-              return @@ E_application (e_variable f.value, arg)
+              return @@ e_application ~loc (e_variable ~loc:f_loc f) arg
-          | Some s -> return @@ E_constant (s , args))
+            )
-      | e1 ->
+          | Some s -> return @@ e_constant ~loc s args
-        let%bind e1' = simpl_expression e1 in
+        )
-        let%bind arg = simpl_tuple_expression (nseq_to_list e2) in
+      | e1 -> (
-        return @@ E_application (e1' , arg)
+          let%bind e1' = simpl_expression e1 in
+          let%bind arg = simpl_tuple_expression (nseq_to_list e2) in
+          return @@ e_application ~loc e1' arg
+      )
     )
-  | EPar x -> simpl_expression ?te_annot x.value.inside
+  | EPar x -> simpl_expression x.value.inside
-  | EUnit _ -> return @@ E_literal Literal_unit
+  | EUnit reg -> (
-  | EBytes x -> return @@ E_literal (Literal_bytes (Bytes.of_string @@ fst x.value))
+      let (_ , loc) = r_split reg in
-  | ETuple tpl -> simpl_tuple_expression ?te_annot @@ (npseq_to_list tpl.value)
+      return @@ e_literal ~loc Literal_unit
-  | ERecord r ->
+    )
+  | EBytes x -> (
+      let (x , loc) = r_split x in
+      return @@ e_literal ~loc (Literal_bytes (Bytes.of_string @@ fst x))
+    )
+  | ETuple tpl -> simpl_tuple_expression @@ (npseq_to_list tpl.value)
+  | ERecord r -> (
+      let (r , loc) = r_split r in
       let%bind fields = bind_list
         @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = simpl_expression v in ok (k.value, v))
         @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
-        @@ pseq_to_list r.value.elements in
+        @@ pseq_to_list r.elements in
-      let aux prev (k, v) = SMap.add k v prev in
+      let map = SMap.of_list fields in
-      return @@ E_record (List.fold_left aux SMap.empty fields)
+      return @@ e_record ~loc map
-  | EProj p' -> (
-      let p = p'.value in
-      simpl_projection p
     )
-  | EConstr c ->
+  | EProj p -> simpl_projection p
-      let (c, args) = c.value in
+  | EConstr c -> (
+      let ((c_name , args) , loc) = r_split c in
+      let (c_name , _c_loc) = r_split c_name in
       let args =
         match args with
           None -> []
         | Some arg -> [arg] in
       let%bind arg = simpl_tuple_expression @@ args in
-      return @@ E_constructor (c.value, arg)
+      return @@ e_constructor ~loc c_name arg
+    )
   | EArith (Add c) ->
-      simpl_binop ?te_annot "ADD" c.value
+      simpl_binop "ADD" c
   | EArith (Sub c) ->
-      simpl_binop ?te_annot "SUB" c.value
+      simpl_binop "SUB" c
   | EArith (Mult c) ->
-      simpl_binop ?te_annot "TIMES" c.value
+      simpl_binop "TIMES" c
   | EArith (Div c) ->
-      simpl_binop ?te_annot "DIV" c.value
+      simpl_binop "DIV" c
   | EArith (Mod c) ->
-      simpl_binop ?te_annot "MOD" c.value
+      simpl_binop "MOD" c
-  | EArith (Int n) ->
+  | EArith (Int n) -> (
-      let n = Z.to_int @@ snd @@ n.value in
+      let (n , loc) = r_split n in
-      return @@ E_literal (Literal_int n)
+      let n = Z.to_int @@ snd @@ n in
-  | EArith (Nat n) ->
+      return @@ e_literal ~loc (Literal_int n)
-      let n = Z.to_int @@ snd @@ n.value in
+    )
-      return @@ E_literal (Literal_nat n)
+  | EArith (Nat n) -> (
-  | EArith (Mtz n) ->
+      let (n , loc) = r_split n in
-      let n = Z.to_int @@ snd @@ n.value in
+      let n = Z.to_int @@ snd @@ n in
-      return @@ E_literal (Literal_tez n)
+      return @@ e_literal ~loc (Literal_nat n)
+    )
+  | EArith (Mtz n) -> (
+      let (n , loc) = r_split n in
+      let n = Z.to_int @@ snd @@ n in
+      return @@ e_literal ~loc (Literal_tez n)
+    )
   | EArith _ -> simple_fail "arith: not supported yet"
-  | EString (String s) ->
+  | EString (String s) -> (
+      let (s , loc) = r_split s in
       let s' =
-        let s = s.value in
+        let s = s in
         String.(sub s 1 ((length s) - 2))
       in
-      return @@ E_literal (Literal_string s')
+      return @@ e_literal ~loc (Literal_string s')
+    )
   | EString _ -> simple_fail "string: not supported yet"
-  | ELogic l -> simpl_logic_expression ?te_annot l
+  | ELogic l -> simpl_logic_expression l
-  | EList l -> simpl_list_expression ?te_annot l
+  | EList l -> simpl_list_expression l
-  | ECase c ->
+  | ECase c -> (
-      let%bind e = simpl_expression c.value.expr in
+      let (c , loc) = r_split c in
+      let%bind e = simpl_expression c.expr in
       let%bind lst =
         let aux (x : Raw.expr Raw.case_clause) =
           let%bind expr = simpl_expression x.rhs in
@@ -203,96 +262,154 @@ let rec simpl_expression :
         bind_list
         @@ List.map aux
         @@ List.map get_value
-        @@ npseq_to_list c.value.cases.value in
+        @@ npseq_to_list c.cases.value in
-      let%bind cases = simpl_cases lst in
+      let default_action () =
-      return @@ E_matching (e, cases)
+        let%bind cases = simpl_cases lst in
-  | EFun lamb ->
+        return @@ e_matching ~loc e  cases in
-      let%bind input_type = bind_map_option
+      (* Hack to take care of patterns introduced by `parser/ligodity/Parser.mly` in "norm_fun_expr" *)
-        (fun (_,type_expr) -> simpl_type_expression type_expr)
+      match lst with
-        lamb.value.p_annot in
+      | [ (pattern , rhs) ] -> (
-      let body, body_type =
+          match pattern with
-        match lamb.value.body with
+          | Raw.PPar p -> (
-          EAnnot {value = expr, type_expr} -> expr, Some type_expr
+              let p' = p.value.inside in
-        | expr -> expr, None in
+              match p' with
-      let%bind output_type =
+              | Raw.PTyped x -> (
-        bind_map_option simpl_type_expression body_type in
+                  let x' = x.value in
-      let%bind result = simpl_expression body in
+                  match x'.pattern with
-      let binder = lamb.value.param.value, input_type in
+                  | Raw.PVar y ->
-      let lambda = {binder; input_type; output_type; result = result}
+                    let var_name = y.value in
-      in return @@ E_lambda lambda
+                    let%bind type_expr = simpl_type_expression x'.type_expr in
-  | ESeq s ->
+                    return @@ e_let_in (var_name , Some type_expr) e rhs
-      let items : Raw.expr list = pseq_to_list s.value.elements in
+                  | _ -> default_action ()
+                )
+              | _ -> default_action ()
+            )
+          | _ -> default_action ()
+        )
+      | _ -> default_action ()
+    )
+  | EFun lamb -> simpl_fun lamb
+  | ESeq s -> (
+      let (s , loc) = r_split s in
+      let items : Raw.expr list = pseq_to_list s.elements in
       (match items with
-         [] -> return @@ E_skip
+         [] -> return @@ e_skip ~loc ()
        | expr::more ->
           let expr' = simpl_expression expr in
           let apply (e1: Raw.expr) (e2: expression Trace.result) =
             let%bind a = simpl_expression e1 in
             let%bind e2' = e2 in
-            return @@ E_sequence (a, e2')
+            return @@ e_sequence a e2'
           in List.fold_right apply more expr')
-  | ECond c ->
+    )
-      let c = c.value in
+  | ECond c -> (
+      let (c , loc) = r_split c in
       let%bind expr = simpl_expression c.test in
       let%bind match_true = simpl_expression c.ifso in
       let%bind match_false = simpl_expression c.ifnot in
-      return @@ E_matching (expr, (Match_bool {match_true; match_false}))
+      return @@ e_matching ~loc expr (Match_bool {match_true; match_false})
+    )
+
+and simpl_fun lamb' : expr result =
+  let return x = ok x in
+  let (lamb , loc) = r_split lamb' in
+  let%bind args' =
+    let args = lamb.params in
+    let%bind p_args = bind_map_list pattern_to_typed_var args in
+    let aux ((var : Raw.variable) , ty_opt) =
+      match var.value , ty_opt with
+      | "storage" , None ->
+        ok (var , T_variable "storage")
+      | _ , None ->
+        simple_fail "untyped function parameter"
+      | _ , Some ty -> (
+        let%bind ty' = simpl_type_expression ty in
+        ok (var , ty')
+      )
+    in
+    bind_map_list aux p_args
+  in
+  let arguments_name = "arguments" in
+  let (binder , input_type) =
+    let type_expression = T_tuple (List.map snd args') in
+    (arguments_name , type_expression) in
+  let%bind (body , body_type) = expr_to_typed_expr lamb.body in
+  let%bind output_type =
+    bind_map_option simpl_type_expression body_type in
+  let%bind result = simpl_expression body in
+  let wrapped_result =
+    let aux = fun i ((name : Raw.variable) , ty) wrapped ->
+      let accessor = e_accessor (e_variable arguments_name) [ Access_tuple i ] in
+      e_let_in (name.value , Some ty) accessor wrapped
+    in
+    let wraps = List.mapi aux args' in
+    List.fold_right' (fun x f -> f x) result wraps in
+  return @@ e_lambda ~loc binder (Some input_type) output_type wrapped_result
+
+
 and simpl_logic_expression ?te_annot (t:Raw.logic_expr) : expr result =
   let return x = ok @@ make_option_typed x te_annot in
   match t with
-  | BoolExpr (False _) ->
+  | BoolExpr (False reg) -> (
-      return @@ E_literal (Literal_bool false)
+      let loc = Location.lift reg in
-  | BoolExpr (True _) ->
+      return @@ e_literal ~loc (Literal_bool false)
-      return @@ E_literal (Literal_bool true)
+    )
+  | BoolExpr (True reg) -> (
+      let loc = Location.lift reg in
+      return @@ e_literal ~loc (Literal_bool true)
+    )
   | BoolExpr (Or b) ->
-      simpl_binop ?te_annot "OR" b.value
+      simpl_binop "OR" b
   | BoolExpr (And b) ->
-      simpl_binop ?te_annot "AND" b.value
+      simpl_binop "AND" b
   | BoolExpr (Not b) ->
-      simpl_unop ?te_annot "NOT" b.value
+      simpl_unop "NOT" b
   | CompExpr (Lt c) ->
-      simpl_binop ?te_annot "LT" c.value
+      simpl_binop "LT" c
   | CompExpr (Gt c) ->
-      simpl_binop ?te_annot "GT" c.value
+      simpl_binop "GT" c
   | CompExpr (Leq c) ->
-      simpl_binop ?te_annot "LE" c.value
+      simpl_binop "LE" c
   | CompExpr (Geq c) ->
-      simpl_binop ?te_annot "GE" c.value
+      simpl_binop "GE" c
   | CompExpr (Equal c) ->
-      simpl_binop ?te_annot "EQ" c.value
+      simpl_binop "EQ" c
   | CompExpr (Neq c) ->
-      simpl_binop ?te_annot "NEQ" c.value
+      simpl_binop "NEQ" c
 
-and simpl_list_expression ?te_annot (t:Raw.list_expr) : expression result =
+and simpl_list_expression (t:Raw.list_expr) : expression result =
-  let return x = ok @@ make_option_typed x te_annot in
+  let return x = ok @@ x in
   match t with
-  | Cons c ->
+  | Cons c -> simpl_binop "CONS" c
-      simpl_binop ?te_annot "CONS" c.value
+  | List lst -> (
-  | List lst ->
+      let (lst , loc) = r_split lst in
       let%bind lst' =
         bind_map_list simpl_expression @@
-        pseq_to_list lst.value.elements in
+        pseq_to_list lst.elements in
-      return @@ E_list lst'
+      return @@ e_list ~loc lst'
+    )
 
-and simpl_binop ?te_annot (name:string) (t:_ Raw.bin_op) : expression result =
+and simpl_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result =
-  let return x = ok @@ make_option_typed x te_annot in
+  let return x = ok @@ x in
-  let%bind a = simpl_expression t.arg1 in
+  let (args , loc) = r_split t in
-  let%bind b = simpl_expression t.arg2 in
+  let%bind a = simpl_expression args.arg1 in
-  return @@ E_constant (name, [a;b])
+  let%bind b = simpl_expression args.arg2 in
+  return @@ e_constant ~loc name [ a ; b ]
 
-and simpl_unop ?te_annot (name:string) (t:_ Raw.un_op) : expression result =
+and simpl_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result =
-  let return x = ok @@ make_option_typed x te_annot in
+  let return x = ok @@ x in
+  let (t , loc) = r_split t in
   let%bind a = simpl_expression t.arg in
-  return @@ E_constant (name, [a])
+  return @@ e_constant ~loc name [ a ]
 
-and simpl_tuple_expression ?te_annot (lst:Raw.expr list) : expression result =
+and simpl_tuple_expression ?loc (lst:Raw.expr list) : expression result =
-  let return x = ok @@ make_option_typed x te_annot in
+  let return x = ok @@ x in
   match lst with
-  | [] -> return @@ E_literal Literal_unit
+  | [] -> return @@ e_literal ?loc Literal_unit
-  | [hd] -> simpl_expression ?te_annot hd
+  | [hd] -> simpl_expression hd
   | lst ->
       let%bind lst = bind_list @@ List.map simpl_expression lst in
-      return @@ E_tuple lst
+      return @@ e_tuple ?loc lst
 
 and simpl_declaration : Raw.declaration -> declaration Location.wrap result = fun t ->
   let open! Raw in
@@ -302,16 +419,37 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap result = fu
       let {name;type_expr} : Raw.type_decl = x.value in
       let%bind type_expression = simpl_type_expression type_expr in
       ok @@ loc x @@ Declaration_type (name.value , type_expression)
-  | LetEntry _ -> simple_fail "no entry point yet"
+  | LetEntry x (* -> simple_fail "no entry point yet" *)
   | Let x -> (
-      let _, binding = x.value in
+      let _ , binding = x.value in
-      let {variable ; lhs_type ; let_rhs} = binding in
+      let {bindings ; lhs_type ; let_rhs} = binding in
-      let%bind type_annotation = bind_map_option
+      let%bind (var , args) =
-        (fun (_,type_expr) -> simpl_type_expression type_expr)
+        let%bind (hd , tl) = match bindings with
-        lhs_type in
+          | [] -> simple_fail "let without bindgings"
-      let%bind rhs = simpl_expression ?te_annot:type_annotation let_rhs in
+          | hd :: tl -> ok (hd , tl)
-      let name = variable.value in
+        in
-      ok @@ loc x @@ (Declaration_constant (name , type_annotation , rhs))
+        let%bind var = pattern_to_var hd in
+        ok (var , tl)
+      in
+      match args with
+      | [] -> (
+          let%bind lhs_type' = bind_map_option
+              (fun (_ , te) -> simpl_type_expression te) lhs_type in
+          let%bind rhs' = simpl_expression let_rhs in
+          ok @@ loc x @@ (Declaration_constant (var.value , lhs_type' , rhs'))
+        )
+      | _ -> (
+          let fun_ = {
+            kwd_fun = Region.ghost ;
+            params = args ;
+            p_annot = lhs_type ;
+            arrow = Region.ghost ;
+            body = let_rhs ;
+          } in
+          let rhs = Raw.EFun {region=Region.ghost ; value=fun_} in
+          let%bind rhs' = simpl_expression rhs in
+          ok @@ loc x @@ (Declaration_constant (var.value , None , rhs'))
+        )
     )
 
 and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t ->
@@ -392,4 +530,4 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t -
     )
 
 let simpl_program : Raw.ast -> program result = fun t ->
-  bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl
+  bind_list @@ List.map simpl_declaration @@ List.rev @@ nseq_to_list t.decl

src/simplify/pascaligo.ml

@@ -16,16 +16,18 @@ let get_value : 'a Raw.reg -> 'a = fun x -> x.value
 
 open Operators.Simplify.Pascaligo
 
+let r_split = Location.r_split
+
 let return expr = ok @@ fun expr'_opt ->
   let expr = expr in
   match expr'_opt with
   | None -> ok @@ expr
   | Some expr' -> ok @@ e_sequence expr expr'
 
-let return_let_in binder rhs = ok @@ fun expr'_opt ->
+let return_let_in ?loc binder rhs = ok @@ fun expr'_opt ->
   match expr'_opt with
   | None -> simple_fail "missing return" (* Hard to explain. Shouldn't happen in prod. *)
-  | Some expr' -> ok @@ e_let_in binder rhs expr'
+  | Some expr' -> ok @@ e_let_in ?loc binder rhs expr'
 
 let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
   match t with
@@ -88,11 +90,12 @@ and simpl_list_type_expression (lst:Raw.type_expr list) : type_expression result
 
 let rec simpl_expression (t:Raw.expr) : expr result =
   let return x = ok x in
-  let simpl_projection = fun (p:Raw.projection) ->
+  let simpl_projection = fun (p : Raw.projection Region.reg) ->
+    let (p' , loc) = r_split p in
     let var =
-      let name = p.struct_name.value in
+      let name = p'.struct_name.value in
       e_variable name in
-    let path = p.field_path in
+    let path = p'.field_path in
     let path' =
       let aux (s:Raw.selection) =
         match s with
@@ -100,97 +103,112 @@ let rec simpl_expression (t:Raw.expr) : expr result =
         | Component index -> Access_tuple (Z.to_int (snd index.value))
       in
       List.map aux @@ npseq_to_list path in
-    return @@ E_accessor (var, path')
+    return @@ e_accessor ~loc var path'
   in
   match t with
   | EAnnot a -> (
-      let (expr , type_expr) = a.value in
+      let ((expr , type_expr) , loc) = r_split a in
       let%bind expr' = simpl_expression expr in
       let%bind type_expr' = simpl_type_expression type_expr in
-      return @@ e_annotation expr' type_expr'
+      return @@ e_annotation ~loc expr' type_expr'
     )
   | EVar c -> (
-      let c' = c.value in
+      let (c' , loc) = r_split c in
       match List.assoc_opt c' constants with
-      | None -> return @@ E_variable c.value
+      | None -> return @@ e_variable ~loc c.value
-      | Some s -> return @@ E_constant (s , [])
+      | Some s -> return @@ e_constant ~loc s []
     )
   | ECall x -> (
-      let (name, args) = x.value in
+      let ((name, args) , loc) = r_split x in
-      let f = name.value in
+      let (f , f_loc) = r_split name in
-      let args' = npseq_to_list args.value.inside in
+      let (args , args_loc) = r_split args in
+      let args' = npseq_to_list args.inside in
       match List.assoc_opt f constants with
       | None ->
-          let%bind arg = simpl_tuple_expression args' in
+          let%bind arg = simpl_tuple_expression ~loc:args_loc args' in
-          return @@ E_application (e_variable f, arg)
+          return @@ e_application ~loc (e_variable ~loc:f_loc f) arg
       | Some s ->
           let%bind lst = bind_map_list simpl_expression args' in
-          return @@ E_constant (s , lst)
+          return @@ e_constant ~loc s lst
     )
   | EPar x -> simpl_expression x.value.inside
-  | EUnit _ -> return @@ E_literal Literal_unit
+  | EUnit reg ->
-  | EBytes x -> return @@ E_literal (Literal_bytes (Bytes.of_string @@ fst x.value))
+    let loc = Location.lift reg in
+    return @@ e_literal ~loc Literal_unit
+  | EBytes x ->
+    let (x' , loc) = r_split x in
+    return @@ e_literal ~loc (Literal_bytes (Bytes.of_string @@ fst x'))
   | ETuple tpl ->
       let (Raw.TupleInj tpl') = tpl in
-      simpl_tuple_expression
+      let (tpl' , loc) = r_split tpl' in
-      @@ npseq_to_list tpl'.value.inside
+      simpl_tuple_expression ~loc @@ npseq_to_list tpl'.inside
   | ERecord r ->
       let%bind fields = bind_list
         @@ List.map (fun ((k : _ Raw.reg), v) -> let%bind v = simpl_expression v in ok (k.value, v))
         @@ List.map (fun (x:Raw.field_assign Raw.reg) -> (x.value.field_name, x.value.field_expr))
         @@ pseq_to_list r.value.elements in
       let aux prev (k, v) = SMap.add k v prev in
-      return @@ E_record (List.fold_left aux SMap.empty fields)
+      return @@ e_record (List.fold_left aux SMap.empty fields)
-  | EProj p' -> (
+  | EProj p -> simpl_projection p
-      let p = p'.value in
+  | EConstr (ConstrApp c) -> (
-      simpl_projection p
+      let ((c, args) , loc) = r_split c in
+      let (args , args_loc) = r_split args in
+      let%bind arg =
+        simpl_tuple_expression ~loc:args_loc
+        @@ npseq_to_list args.inside in
+      return @@ e_constructor ~loc c.value arg
     )
-  | EConstr (ConstrApp c) ->
-      let (c, args) = c.value in
-      let%bind arg =
-        simpl_tuple_expression
-        @@ npseq_to_list args.value.inside in
-      return @@ E_constructor (c.value, arg)
   | EConstr (SomeApp a) ->
-      let (_, args) = a.value in
+      let ((_, args) , loc) = r_split a in
+      let (args , args_loc) = r_split args in
       let%bind arg =
-        simpl_tuple_expression
+        simpl_tuple_expression ~loc:args_loc
-        @@ npseq_to_list args.value.inside in
+        @@ npseq_to_list args.inside in
-      return @@ E_constant ("SOME", [arg])
+      return @@ e_constant ~loc "SOME" [arg]
-  | EConstr (NoneExpr _) ->
+  | EConstr (NoneExpr reg) -> (
-      return @@ E_constant ("NONE" , [])
+      let loc = Location.lift reg in
+      return @@ e_none ~loc ()
+    )
   | EArith (Add c) ->
-      simpl_binop "ADD" c.value
+      simpl_binop "ADD" c
   | EArith (Sub c) ->
-      simpl_binop "SUB" c.value
+      simpl_binop "SUB" c
   | EArith (Mult c) ->
-      simpl_binop "TIMES" c.value
+      simpl_binop "TIMES" c
   | EArith (Div c) ->
-      simpl_binop "DIV" c.value
+      simpl_binop "DIV" c
   | EArith (Mod c) ->
-      simpl_binop "MOD" c.value
+      simpl_binop "MOD" c
-  | EArith (Int n) ->
+  | EArith (Int n) -> (
-      let n = Z.to_int @@ snd @@ n.value in
+      let (n , loc) = r_split n in
-      return @@ E_literal (Literal_int n)
+      let n = Z.to_int @@ snd n in
-  | EArith (Nat n) ->
+      return @@ e_literal ~loc (Literal_int n)
-      let n = Z.to_int @@ snd @@ n.value in
+    )
-      return @@ E_literal (Literal_nat n)
+  | EArith (Nat n) -> (
-  | EArith (Mtz n) ->
+      let (n , loc) = r_split n in
-      let n = Z.to_int @@ snd @@ n.value in
+      let n = Z.to_int @@ snd @@ n in
-      return @@ E_literal (Literal_tez n)
+      return @@ e_literal ~loc (Literal_nat n)
+    )
+  | EArith (Mtz n) -> (
+      let (n , loc) = r_split n in
+      let n = Z.to_int @@ snd @@ n in
+      return @@ e_literal ~loc (Literal_tez n)
+    )
   | EArith _ -> simple_fail "arith: not supported yet"
   | EString (String s) ->
+    let (s , loc) = r_split s in
       let s' =
-        let s = s.value in
+        (* S contains quotes *)
         String.(sub s 1 ((length s) - 2))
       in
-      return @@ E_literal (Literal_string s')
+      return @@ e_literal ~loc (Literal_string s')
   | EString _ -> simple_fail "string: not supported yet"
   | ELogic l -> simpl_logic_expression l
   | EList l -> simpl_list_expression l
   | ESet _ -> simple_fail "set: not supported yet"
-  | ECase c ->
+  | ECase c -> (
-      let%bind e = simpl_expression c.value.expr in
+      let (c , loc) = r_split c in
+      let%bind e = simpl_expression c.expr in
       let%bind lst =
         let aux (x : Raw.expr Raw.case_clause) =
           let%bind expr = simpl_expression x.rhs in
@@ -198,84 +216,103 @@ let rec simpl_expression (t:Raw.expr) : expr result =
         bind_list
         @@ List.map aux
         @@ List.map get_value
-        @@ npseq_to_list c.value.cases.value in
+        @@ npseq_to_list c.cases.value in
       let%bind cases = simpl_cases lst in
-      return @@ E_matching (e, cases)
+      return @@ e_matching ~loc e cases
-  | EMap (MapInj mi) ->
+    )
+  | EMap (MapInj mi) -> (
+      let (mi , loc) = r_split mi in
       let%bind lst =
-        let lst = List.map get_value @@ pseq_to_list mi.value.elements in
+        let lst = List.map get_value @@ pseq_to_list mi.elements in
         let aux : Raw.binding -> (expression * expression) result = fun b ->
           let%bind src = simpl_expression b.source in
           let%bind dst = simpl_expression b.image in
           ok (src, dst) in
         bind_map_list aux lst in
-      return (E_map lst)
+      return @@ e_map ~loc lst
-  | EMap (MapLookUp lu) ->
+    )
-      let%bind path = match lu.value.path with
+  | EMap (MapLookUp lu) -> (
-        | Name v -> return (E_variable v.value)
+      let (lu , loc) = r_split lu in
-        | Path p -> simpl_projection p.value
+      let%bind path = match lu.path with
+        | Name v -> (
+            let (v , loc) = r_split v in
+            return @@ e_variable ~loc v
+          )
+        | Path p -> simpl_projection p
       in
-      let%bind index = simpl_expression lu.value.index.value.inside in
+      let%bind index = simpl_expression lu.index.value.inside in
-      return (E_look_up (path, index))
+      return @@ e_look_up ~loc path index
+    )
 
 and simpl_logic_expression (t:Raw.logic_expr) : expression result =
   let return x = ok x in
   match t with
-  | BoolExpr (False _) ->
+  | BoolExpr (False reg) -> (
-      return @@ E_literal (Literal_bool false)
+      let loc = Location.lift reg in
-  | BoolExpr (True _) ->
+      return @@ e_literal ~loc (Literal_bool false)
-      return @@ E_literal (Literal_bool true)
+    )
+  | BoolExpr (True reg) -> (
+      let loc = Location.lift reg in
+      return @@ e_literal ~loc (Literal_bool true)
+    )
   | BoolExpr (Or b) ->
-      simpl_binop "OR" b.value
+      simpl_binop "OR" b
   | BoolExpr (And b) ->
-      simpl_binop "AND" b.value
+      simpl_binop "AND" b
   | BoolExpr (Not b) ->
-      simpl_unop "NOT" b.value
+      simpl_unop "NOT" b
   | CompExpr (Lt c) ->
-      simpl_binop "LT" c.value
+      simpl_binop "LT" c
   | CompExpr (Gt c) ->
-      simpl_binop "GT" c.value
+      simpl_binop "GT" c
   | CompExpr (Leq c) ->
-      simpl_binop "LE" c.value
+      simpl_binop "LE" c
   | CompExpr (Geq c) ->
-      simpl_binop "GE" c.value
+      simpl_binop "GE" c
   | CompExpr (Equal c) ->
-      simpl_binop "EQ" c.value
+      simpl_binop "EQ" c
   | CompExpr (Neq c) ->
-      simpl_binop "NEQ" c.value
+      simpl_binop "NEQ" c
 
 and simpl_list_expression (t:Raw.list_expr) : expression result =
   let return x = ok x in
   match t with
   | Cons c ->
-      simpl_binop "CONS" c.value
+      simpl_binop "CONS" c
-  | List lst ->
+  | List lst -> (
+      let (lst , loc) = r_split lst in
       let%bind lst' =
         bind_map_list simpl_expression @@
-        pseq_to_list lst.value.elements in
+        pseq_to_list lst.elements in
-      return @@ E_list lst'
+      return @@ e_list ~loc lst'
-  | Nil _ ->
+    )
-      return @@ E_list []
+  | Nil reg -> (
+      let loc = Location.lift reg in
+      return @@ e_list ~loc []
+    )
 
-and simpl_binop (name:string) (t:_ Raw.bin_op) : expression result =
+and simpl_binop (name:string) (t:_ Raw.bin_op Region.reg) : expression result =
   let return x = ok x in
+  let (t , loc) = r_split t in
   let%bind a = simpl_expression t.arg1 in
   let%bind b = simpl_expression t.arg2 in
-  return @@ E_constant (name, [a;b])
+  return @@ e_constant ~loc name [ a ; b ]
 
-and simpl_unop (name:string) (t:_ Raw.un_op) : expression result =
+and simpl_unop (name:string) (t:_ Raw.un_op Region.reg) : expression result =
   let return x = ok x in
+  let (t , loc) = r_split t in
   let%bind a = simpl_expression t.arg in
-  return @@ E_constant (name, [a])
+  return @@ e_constant ~loc name [ a ]
 
-and simpl_tuple_expression (lst:Raw.expr list) : expression result =
+and simpl_tuple_expression ?loc (lst:Raw.expr list) : expression result =
   let return x = ok x in
   match lst with
-  | [] -> return @@ E_literal Literal_unit
+  | [] -> return @@ e_literal Literal_unit
   | [hd] -> simpl_expression hd
-  | lst ->
+  | lst -> (
       let%bind lst = bind_list @@ List.map simpl_expression lst in
-      return @@ E_tuple lst
+      return @@ e_tuple ?loc lst
+    )
 
 and simpl_local_declaration : Raw.local_decl -> _ result = fun t ->
   match t with
@@ -284,26 +321,28 @@ and simpl_local_declaration : Raw.local_decl -> _ result = fun t ->
 
 and simpl_lambda_declaration : Raw.lambda_decl -> _ result = fun l ->
   match l with
-  | FunDecl f ->
+  | FunDecl f -> (
-      let%bind (name , e) = simpl_fun_declaration (f.value) in
+      let (f , loc) = r_split f in
-      return_let_in name e
+      let%bind (name , e) = simpl_fun_declaration ~loc f in
+      return_let_in ~loc name e
+    )
   | ProcDecl _ -> simple_fail "no local procedure yet"
   | EntryDecl _ -> simple_fail "no local entry-point yet"
 
 and simpl_data_declaration : Raw.data_decl -> _ result = fun t ->
   match t with
   | LocalVar x ->
-      let x = x.value in
+      let (x , loc) = r_split x in
       let name = x.name.value in
       let%bind t = simpl_type_expression x.var_type in
       let%bind expression = simpl_expression x.init in
-      return_let_in (name , Some t) expression
+      return_let_in ~loc (name , Some t) expression
   | LocalConst x ->
-      let x = x.value in
+      let (x , loc) = r_split x in
       let name = x.name.value in
       let%bind t = simpl_type_expression x.const_type in
       let%bind expression = simpl_expression x.init in
-      return_let_in (name , Some t) expression
+      return_let_in ~loc (name , Some t) expression
 
 and simpl_param : Raw.param_decl -> (type_name * type_expression) result = fun t ->
   match t with
@@ -318,7 +357,7 @@ and simpl_param : Raw.param_decl -> (type_name * type_expression) result = fun t
       let%bind type_expression = simpl_type_expression c.param_type in
       ok (type_name , type_expression)
 
-and simpl_fun_declaration : Raw.fun_decl -> ((name * type_expression option) * expression) result = fun x ->
+and simpl_fun_declaration : loc:_ -> Raw.fun_decl -> ((name * type_expression option) * expression) result = fun ~loc x ->
   let open! Raw in
   let {name;param;ret_type;local_decls;block;return} : fun_decl = x in
   (match npseq_to_list param.value.inside with
@@ -338,12 +377,8 @@ and simpl_fun_declaration : Raw.fun_decl -> ((name * type_expression option) * e
        let%bind result =
          let aux prec cur = cur (Some prec) in
          bind_fold_right_list aux result body in
-       let expression = E_lambda {
+       let expression : expression = e_lambda ~loc binder (Some input_type)
-           binder = (binder , Some input_type) ;
+           (Some output_type) result in
-           input_type = Some input_type ;
-           output_type = Some output_type ;
-           result
-         } in
        let type_annotation = Some (T_function (input_type, output_type)) in
        ok ((name , type_annotation) , expression)
      )
@@ -355,7 +390,7 @@ and simpl_fun_declaration : Raw.fun_decl -> ((name * type_expression option) * e
          (arguments_name , type_expression) in
        let%bind tpl_declarations =
          let aux = fun i x ->
-           let expr = E_accessor (E_variable arguments_name , [ Access_tuple i ]) in
+           let expr = e_accessor (e_variable arguments_name) [ Access_tuple i ] in
            let type_ = Some (snd x) in
            let ass = return_let_in (fst x , type_) expr in
            ass
@@ -372,24 +407,20 @@ and simpl_fun_declaration : Raw.fun_decl -> ((name * type_expression option) * e
        let%bind result =
          let aux prec cur = cur (Some prec) in
          bind_fold_right_list aux result body in
-       let expression = E_lambda {
+       let expression = e_lambda ~loc binder (Some input_type) (Some output_type) result in
-           binder = (binder , Some input_type) ;
-           input_type = Some input_type ;
-           output_type = Some output_type ;
-           result
-         } in
        let type_annotation = Some (T_function (input_type, output_type)) in
        ok ((name.value , type_annotation) , expression)
      )
   )
 and simpl_declaration : Raw.declaration -> declaration Location.wrap result = fun t ->
   let open! Raw in
-  let loc : 'a . 'a Raw.reg -> _ -> _ = fun x v -> Location.wrap ~loc:(File x.region) v in
   match t with
-  | TypeDecl x ->
+  | TypeDecl x -> (
-      let {name;type_expr} : Raw.type_decl = x.value in
+      let (x , loc) = r_split x in
+      let {name;type_expr} : Raw.type_decl = x in
       let%bind type_expression = simpl_type_expression type_expr in
-      ok @@ loc x @@ Declaration_type (name.value , type_expression)
+      ok @@ Location.wrap ~loc (Declaration_type (name.value , type_expression))
+    )
   | ConstDecl x ->
       let simpl_const_decl = fun {name;const_type;init} ->
         let%bind expression = simpl_expression init in
@@ -398,11 +429,11 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap result = fu
         ok @@ Declaration_constant (name.value , type_annotation , expression)
       in
       bind_map_location simpl_const_decl (Location.lift_region x)
-  | LambdaDecl (FunDecl x) ->
+  | LambdaDecl (FunDecl x) -> (
-      let aux f x =
+      let (x , loc) = r_split x in
-        let%bind ((name , ty_opt) , expr) = f x in
+      let%bind ((name , ty_opt) , expr) = simpl_fun_declaration ~loc x in
-        ok @@ Declaration_constant (name , ty_opt , expr) in
+      ok @@ Location.wrap ~loc (Declaration_constant (name , ty_opt , expr))
-      bind_map_location (aux simpl_fun_declaration) (Location.lift_region x)
+    )
   | LambdaDecl (ProcDecl _) -> simple_fail "no proc declaration yet"
   | LambdaDecl (EntryDecl _)-> simple_fail "no entry point yet"
 
@@ -418,7 +449,10 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
       let%bind expr = simpl_expression e.value.fail_expr in
       return @@ e_failwith expr
     )
-  | Skip _ -> return @@ e_skip
+  | Skip reg -> (
+      let loc = Location.lift reg in
+      return @@ e_skip ~loc ()
+    )
   | Loop (While l) ->
       let l = l.value in
       let%bind cond = simpl_expression l.cond in
@@ -427,8 +461,8 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
       return @@ e_loop cond body
   | Loop (For _) ->
       simple_fail "no for yet"
-  | Cond c ->
+  | Cond c -> (
-      let c = c.value in
+      let (c , loc) = r_split c in
       let%bind expr = simpl_expression c.test in
       let%bind match_true = match c.ifso with
         | ClauseInstr i -> simpl_instruction_block i
@@ -438,9 +472,10 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
         | ClauseBlock b -> simpl_statements @@ fst b.value.inside in
       let%bind match_true = match_true None in
       let%bind match_false = match_false None in
-      return @@ E_matching (expr, (Match_bool {match_true; match_false}))
+      return @@ e_matching expr ~loc (Match_bool {match_true; match_false})
+    )
   | Assign a -> (
-      let a = a.value in
+      let (a , loc) = r_split a in
       let%bind value_expr = match a.rhs with
         | Expr e -> simpl_expression e
         | NoneExpr _ -> simple_fail "no none assignments yet"
@@ -448,7 +483,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
       match a.lhs with
         | Path path -> (
             let (name , path') = simpl_path path in
-            return @@ E_assign (name , path' , value_expr)
+            return @@ e_assign ~loc name path' value_expr
           )
         | MapPath v -> (
             let v' = v.value in
@@ -458,11 +493,11 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
             let%bind key_expr = simpl_expression v'.index.value.inside in
             let old_expr = e_variable name.value in
             let expr' = e_map_update key_expr value_expr old_expr in
-            return @@ E_assign (name.value , [] , expr')
+            return @@ e_assign ~loc name.value [] expr'
           )
     )
   | CaseInstr c -> (
-      let c = c.value in
+      let (c , loc) = r_split c in
       let%bind expr = simpl_expression c.expr in
       let%bind cases =
         let aux (x : Raw.instruction Raw.case_clause Raw.reg) =
@@ -473,25 +508,25 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
         @@ List.map aux
         @@ npseq_to_list c.cases.value in
       let%bind m = simpl_cases cases in
-      return @@ E_matching (expr, m)
+      return @@ e_matching ~loc expr m
     )
   | RecordPatch r -> (
       let r = r.value in
       let (name , access_path) = simpl_path r.path in
       let%bind inj = bind_list
-        @@ List.map (fun (x:Raw.field_assign) -> let%bind e = simpl_expression x.field_expr in ok (x.field_name.value, e))
+        @@ List.map (fun (x:Raw.field_assign Region.reg) ->
-        @@ List.map (fun (x:_ Raw.reg) -> x.value)
+            let (x , loc) = r_split x in
+            let%bind e = simpl_expression x.field_expr in ok (x.field_name.value, e , loc)
+          )
         @@ pseq_to_list r.record_inj.value.elements in
       let%bind expr =
-        let aux = fun (access , v) ->
+        let aux = fun (access , v , loc) ->
-          E_assign (name , access_path @ [ Access_record access ] , v) in
+          e_assign ~loc name (access_path @ [ Access_record access ]) v in
         let assigns = List.map aux inj in
         match assigns with
         | [] -> simple_fail "empty record patch"
         | hd :: tl -> (
-            let aux acc cur =
+            let aux acc cur = e_sequence (acc) (cur) in
-              e_sequence (acc) (cur)
-            in
             ok @@ List.fold_left aux hd tl
           )
       in
@@ -499,15 +534,16 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
     )
   | MapPatch _ -> simple_fail "no map patch yet"
   | SetPatch _ -> simple_fail "no set patch yet"
-  | MapRemove r ->
+  | MapRemove r -> (
-      let v = r.value in
+      let (v , loc) = r_split r in
       let key = v.key in
       let%bind map = match v.map with
         | Name v -> ok v.value
         | _ -> simple_fail "no complex map remove yet" in
       let%bind key' = simpl_expression key in
-      let expr = E_constant ("MAP_REMOVE", [key' ; e_variable map]) in
+      let expr = e_constant ~loc "MAP_REMOVE" [key' ; e_variable map] in
-      return @@ E_assign (map , [] , expr)
+      return @@ e_assign ~loc map [] expr
+    )
   | SetRemove _ -> simple_fail "no set remove yet"
 
 and simpl_path : Raw.path -> string * Ast_simplified.access_path = fun p ->

src/simplify/simplify.ml

@@ -1,3 +1,3 @@
 module Pascaligo = Pascaligo
 module Camligo = Camligo
-(*module Ligodity = Ligodity*)
+module Ligodity = Ligodity

src/test/bin_tests.ml

@@ -1,10 +1,10 @@
 open Trace
-open Ligo
+open Ligo.Run
 open Test_helpers
 
 let compile_contract_basic () : unit result =
   let%bind _ =
-    Contract.compile_contract_file "./contracts/dispatch-counter.ligo" "main"
+    compile_contract_file "./contracts/dispatch-counter.ligo" "main" "pascaligo"
   in
   ok ()
 

src/test/coase_tests.ml

@@ -1,9 +1,11 @@
 (* Copyright Coase, Inc 2019 *)
 
 open Trace
-open Ligo
+open Ligo.Run
 open Test_helpers
 
+let type_file = type_file "pascaligo"
+
 let get_program =
   let s = ref None in
   fun () -> match !s with
@@ -31,7 +33,7 @@ let card_ez owner = card (e_address owner)
 
 let make_cards assoc_lst =
   let card_id_ty = t_nat in
-  e_map assoc_lst card_id_ty card_ty
+  e_typed_map assoc_lst card_id_ty card_ty
 
 let card_pattern (coeff , qtt) =
   ez_e_record [
@@ -51,7 +53,7 @@ let card_pattern_ez (coeff , qtt) =
 let make_card_patterns lst =
   let card_pattern_id_ty = t_nat  in
   let assoc_lst = List.mapi (fun i x -> (e_nat i , x)) lst in
-  e_map assoc_lst card_pattern_id_ty card_pattern_ty
+  e_typed_map assoc_lst card_pattern_id_ty card_pattern_ty
 
 let storage cards_patterns cards next_id =
   ez_e_record [
@@ -208,9 +210,9 @@ let sell () =
       e_pair sell_action storage
     in
     let make_expecter : int -> expression -> unit result = fun n result ->
-      let%bind (ops , storage) = get_e_pair result in
+      let%bind (ops , storage) = get_e_pair @@ Location.unwrap result in
       let%bind () =
-        let%bind lst = get_e_list ops in
+        let%bind lst = get_e_list @@ Location.unwrap ops in
         Assert.assert_list_size lst 1 in
       let expected_storage =
         let cards = List.hds @@ cards_ez first_owner n in

src/test/heap_tests.ml

@@ -1,7 +1,9 @@
 open Trace
-open Ligo
+open Ligo.Run
 open Test_helpers
 
+let type_file = type_file "pascaligo"
+
 let get_program =
   let s = ref None in
   fun () -> match !s with
@@ -12,8 +14,8 @@ let get_program =
         ok program
       )
 
-let a_heap_ez ?value_type (content:(int * AST_Typed.ae) list) =
+let a_heap_ez ?value_type (content:(int * Ast_typed.ae) list) =
-  let open AST_Typed.Combinators in
+  let open Ast_typed.Combinators in
   let content =
     let aux = fun (x, y) -> e_a_empty_nat x, y in
     List.map aux content in
@@ -24,7 +26,7 @@ let a_heap_ez ?value_type (content:(int * AST_Typed.ae) list) =
   e_a_empty_map content (t_nat ()) value_type
 
 let ez lst =
-  let open AST_Typed.Combinators in
+  let open Ast_typed.Combinators in
   let value_type = t_pair
       (t_int ())
       (t_string ())
@@ -46,11 +48,11 @@ let dummy n =
 let is_empty () : unit result =
   let%bind program = get_program () in
   let aux n =
-    let open AST_Typed.Combinators in
+    let open Ast_typed.Combinators in
     let input = dummy n in
-    let%bind result = easy_run_typed "is_empty" program input in
+    let%bind result = run_typed "is_empty" program input in
     let expected = e_a_empty_bool (n = 0) in
-    AST_Typed.assert_value_eq (expected, result)
+    Ast_typed.assert_value_eq (expected, result)
   in
   let%bind _ = bind_list
     @@ List.map aux
@@ -60,15 +62,15 @@ let is_empty () : unit result =
 let get_top () : unit result =
   let%bind program = get_program () in
   let aux n =
-    let open AST_Typed.Combinators in
+    let open Ast_typed.Combinators in
     let input = dummy n in
-    match n, easy_run_typed "get_top" program input with
+    match n, run_typed "get_top" program input with
     | 0, Trace.Ok _ -> simple_fail "unexpected success"
     | 0, _ -> ok ()
     | _, result ->
         let%bind result' = result in
         let expected = e_a_empty_pair (e_a_empty_int 1) (e_a_empty_string "1") in
-        AST_Typed.assert_value_eq (expected, result')
+        Ast_typed.assert_value_eq (expected, result')
   in
   let%bind _ = bind_list
     @@ List.map aux
@@ -79,7 +81,7 @@ let pop_switch () : unit result =
   let%bind program = get_program () in
   let aux n =
     let input = dummy n in
-    match n, easy_run_typed "pop_switch" program input with
+    match n, run_typed "pop_switch" program input with
     | 0, Trace.Ok _ -> simple_fail "unexpected success"
     | 0, _ -> ok ()
     | _, result ->
@@ -89,7 +91,7 @@ let pop_switch () : unit result =
             @@ tl
             @@ range (n + 1)
           ) in
-        AST_Typed.assert_value_eq (expected, result')
+        Ast_typed.assert_value_eq (expected, result')
   in
   let%bind _ = bind_list
     @@ List.map aux
@@ -100,9 +102,9 @@ let pop () : unit result =
   let%bind program = get_program () in
   let aux n =
     let input = dummy n in
-    (match easy_run_typed "pop" program input with
+    (match run_typed "pop" program input with
     | Trace.Ok (output , _) -> (
-        Format.printf "\nPop output on %d : %a\n" n AST_Typed.PP.annotated_expression output ;
+        Format.printf "\nPop output on %d : %a\n" n Ast_typed.PP.annotated_expression output ;
       )
     | Errors errs -> (
         Format.printf "\nPop output on %d : error\n" n) ;

src/test/integration_tests.ml

@@ -1,14 +1,15 @@
 open Trace
-open Ligo
+open Ligo.Run
 open Test_helpers
 
 open Ast_simplified.Combinators
 
-let mtype_file path : Ast_typed.program result =
+let mtype_file ?debug_simplify ?debug_typed = type_file ?debug_simplify ?debug_typed "cameligo"
-  let%bind raw = Parser.Camligo.User.parse_file path in
+let type_file = type_file "pascaligo"
-  let%bind simpl = Simplify.Camligo.main raw in
+
-  let%bind typed = Ligo.Typer.type_program (Location.unwrap simpl) in
+let type_alias () : unit result =
-  ok typed
+  let%bind program = type_file "./contracts/type-alias.ligo" in
+  expect_eq_evaluate program "foo" (e_int 23)
 
 let function_ () : unit result =
   let%bind program = type_file "./contracts/function.ligo" in
@@ -148,6 +149,9 @@ let include_ () : unit result =
 let record_ez_int names n =
   ez_e_record @@ List.map (fun x -> x, e_int n) names
 
+let tuple_ez_int names n =
+  e_tuple @@ List.map (fun _ -> e_int n) names
+
 let multiple_parameters () : unit result  =
   let%bind program = type_file "./contracts/multiple-parameters.ligo" in
   let aux ((name : string) , make_input , make_output) =
@@ -155,9 +159,9 @@ let multiple_parameters () : unit result  =
     expect_eq_n program name make_input make_output'
   in
   let%bind _ = bind_list @@ List.map aux [
-      ("ab", record_ez_int ["a";"b"], fun n -> 2 * n) ;
+      ("ab", tuple_ez_int ["a";"b"], fun n -> 2 * n) ;
-      ("abcd", record_ez_int ["a";"b";"c";"d"], fun n -> 4 * n + 2) ;
+      ("abcd", tuple_ez_int ["a";"b";"c";"d"], fun n -> 4 * n + 2) ;
-      ("abcde", record_ez_int ["a";"b";"c";"d";"e"], fun n -> 2 * n + 3) ;
+      ("abcde", tuple_ez_int ["a";"b";"c";"d";"e"], fun n -> 2 * n + 3) ;
     ] in
   ok ()
 
@@ -249,7 +253,7 @@ let map () : unit result =
   let ez lst =
     let open Ast_simplified.Combinators in
     let lst' = List.map (fun (x, y) -> e_int x, e_int y) lst in
-    e_map lst' t_int t_int
+    e_typed_map lst' t_int t_int
   in
   let%bind () =
     let make_input = fun n -> ez [(23, n) ; (42, 4)] in
@@ -436,8 +440,8 @@ let dispatch_counter_contract () : unit result =
   expect_eq_n program "main" make_input make_expected
 
 let basic_mligo () : unit result =
-  let%bind typed = mtype_file "./contracts/basic.mligo" in
+  let%bind typed = mtype_file ~debug_simplify:true "./contracts/basic.mligo" in
-  let%bind result = Ligo.easy_evaluate_typed "foo" typed in
+  let%bind result = evaluate_typed "foo" typed in
   Ligo.AST_Typed.assert_value_eq (Ligo.AST_Typed.Combinators.e_a_empty_int (42 + 127), result)
 
 let counter_mligo () : unit result =
@@ -453,6 +457,7 @@ let guess_the_hash_mligo () : unit result =
   expect_eq_n program "main" make_input make_expected
 
 let main = "Integration (End to End)", [
+    test "type alias" type_alias ;
     test "function" function_ ;
     test "assign" assign ;
     test "declaration local" declaration_local ;

src/test/test_helpers.ml

@@ -3,7 +3,7 @@ open! Trace
 let test name f =
   Alcotest.test_case name `Quick @@ fun () ->
   let result =
-    trace (fun () -> error (thunk "running test") (fun () -> name) ()) @@
+    trace (fun () -> error (thunk "running test") (thunk name) ()) @@
     f () in
   match result with
   | Ok ((), annotations) -> ignore annotations; ()
@@ -20,7 +20,7 @@ let expect ?options program entry_point input expecter =
       let content () = Format.asprintf "Entry_point: %s" entry_point in
       error title content in
     trace run_error @@
-    Ligo.easy_run_typed_simplified ~debug_michelson:true ?options entry_point program input in
+    Ligo.Run.run_simplityped ~debug_michelson:true ?options program entry_point input in
   expecter result
 
 let expect_eq ?options program entry_point input expected =
@@ -41,7 +41,7 @@ let expect_evaluate program entry_point expecter =
     let content () = Format.asprintf "Entry_point: %s" entry_point in
     error title content in
   trace error @@
-  let%bind result = Ligo.easy_evaluate_typed_simplified entry_point program in
+  let%bind result = Ligo.Run.evaluate_simplityped program entry_point in
   expecter result
 
 let expect_eq_evaluate program entry_point expected =

src/transpiler/transpiler.ml

@@ -469,7 +469,7 @@ let translate_main (l:AST.lambda) : anon_function result =
   | E_literal (D_function f) -> ok f
   | _ -> simple_fail "main is not a function"
 
-(* From a non-functional expression [expr], build the functional expression [fun () -> expr] *)
+(* From an expression [expr], build the expression [fun () -> expr] *)
 let functionalize (e:AST.annotated_expression) : AST.lambda * AST.type_value =
   let t = e.type_annotation in
   let open! AST in
@@ -511,16 +511,6 @@ let translate_entry (lst:AST.program) (name:string) : anon_function result =
 
 open Combinators
 
-let rec exp x n =
-  if n = 0
-  then 1
-  else
-    let exp' = exp (x * x) (n / 2) in
-    let m = if n mod 2 = 0 then 1 else x in
-    m * exp'
-
-let exp2 = exp 2
-
 let extract_constructor (v : value) (tree : _ Append_tree.t') : (string * value * AST.type_value) result =
   let open Append_tree in
   let rec aux tv : (string * value * AST.type_value) result=

src/typer/typer.ml

@@ -29,7 +29,7 @@ module Errors = struct
   let wrong_arity (n:string) (expected:int) (actual:int) () =
     let title () = "wrong arity" in
     let full () =
-      Format.asprintf "Wrong number of args passed to [%s]. Expected was %d, received was %d."
+      Format.asprintf "Wrong number of args passed to [%s]. Expected was %d, received was %d"
         n expected actual
     in
     error title full ()
@@ -204,13 +204,20 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
       match tv_opt with
       | None -> ok ()
       | Some tv' -> O.assert_type_value_eq (tv' , tv) in
-    ok @@ make_a_e expr tv e in
+    let location = Location.get_location ae in
+    ok @@ make_a_e ~location expr tv e in
   let main_error =
     let title () = "typing expression" in
-    let content () = Format.asprintf "Expression: %a\nLog: %s\n" I.PP.expression ae (L.get()) in
+    let content () =
+      match L.get () with
+      | "" ->
+        Format.asprintf "Expression: %a\n" I.PP.expression ae
+      | l ->
+        Format.asprintf "Expression: %a\nLog: %s\n" I.PP.expression ae l
+    in
     error title content in
   trace main_error @@
-  match ae with
+  match Location.unwrap ae with
   (* Basic *)
   | E_failwith _ -> simple_fail "can't type failwith in isolation"
   | E_variable name ->
@@ -357,16 +364,31 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
     } -> (
       let%bind input_type =
         let%bind input_type =
-          trace_option (simple_error "no input type provided") @@
+          (* Hack to take care of let_in introduced by `simplify/ligodity.ml` in ECase's hack *)
-          input_type in
+          let default_action () = simple_fail "no input type provided" in
+          match input_type with
+          | Some ty -> ok ty
+          | None -> (
+              match Location.unwrap result with
+              | I.E_let_in li -> (
+                  match Location.unwrap li.rhs with
+                  | I.E_variable name when name = (fst binder) -> (
+                      match snd li.binder with
+                      | Some ty -> ok ty
+                      | None -> default_action ()
+                    )
+                  | _ -> default_action ()
+                )
+              | _ -> default_action ()
+            )
+        in
         evaluate_type e input_type in
       let%bind output_type =
-        let%bind output_type =
+        bind_map_option (evaluate_type e) output_type
-          trace_option (simple_error "no output type provided") @@
+      in
-          output_type in
-        evaluate_type e output_type in
       let e' = Environment.add_ez_binder (fst binder) input_type e in
-      let%bind result = type_expression ~tv_opt:output_type e' result in
+      let%bind result = type_expression ?tv_opt:output_type e' result in
+      let output_type = result.type_annotation in
       return (E_lambda {binder = fst binder;input_type;output_type;result}) (t_function input_type output_type ())
     )
   | E_constant (name, lst) ->
@@ -394,7 +416,8 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a
       let%bind ex' = type_expression e ex in
       match m with
       (* Special case for assert-like failwiths. TODO: CLEAN THIS. *)
-      | I.Match_bool { match_false ; match_true = E_failwith fw } -> (
+      | I.Match_bool { match_false ; match_true } when I.is_e_failwith match_true -> (
+          let%bind fw = I.get_e_failwith match_true in
           let%bind fw' = type_expression e fw in
           let%bind mf' = type_expression e match_false in
           let%bind () =
@@ -526,55 +549,54 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
   match e.expression with
   | E_literal l ->
       let%bind l = untype_literal l in
-      return (E_literal l)
+      return (e_literal l)
   | E_constant (n, lst) ->
-      let%bind lst' = bind_list
+      let%bind lst' = bind_map_list untype_expression lst in
-        @@ List.map untype_expression lst in
+      return (e_constant n lst')
-      return (E_constant (n, lst'))
   | E_variable n ->
-      return (E_variable n)
+      return (e_variable n)
   | E_application (f, arg) ->
       let%bind f' = untype_expression f in
       let%bind arg' = untype_expression arg in
-      return (E_application (f', arg'))
+      return (e_application f' arg')
   | E_lambda {binder;input_type;output_type;result} ->
       let%bind input_type = untype_type_value input_type in
       let%bind output_type = untype_type_value output_type in
       let%bind result = untype_expression result in
-      return (E_lambda {binder = (binder , Some input_type);input_type = Some input_type;output_type = Some output_type;result})
+      return (e_lambda binder (Some input_type) (Some output_type) result)
   | E_tuple lst ->
       let%bind lst' = bind_list
         @@ List.map untype_expression lst in
-      return (E_tuple lst')
+      return (e_tuple lst')
   | E_tuple_accessor (tpl, ind)  ->
       let%bind tpl' = untype_expression tpl in
-      return (E_accessor (tpl', [Access_tuple ind]))
+      return (e_accessor tpl' [Access_tuple ind])
   | E_constructor (n, p) ->
       let%bind p' = untype_expression p in
-      return (E_constructor (n, p'))
+      return (e_constructor n p')
   | E_record r ->
       let%bind r' = bind_smap
         @@ SMap.map untype_expression r in
-      return (E_record r')
+      return (e_record r')
   | E_record_accessor (r, s) ->
       let%bind r' = untype_expression r in
-      return (E_accessor (r', [Access_record s]))
+      return (e_accessor r' [Access_record s])
   | E_map m ->
       let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
-      return (E_map m')
+      return (e_map m')
   | E_list lst ->
       let%bind lst' = bind_map_list untype_expression lst in
-      return (E_list lst')
+      return (e_list lst')
   | E_look_up dsi ->
-      let%bind dsi' = bind_map_pair untype_expression dsi in
+      let%bind (a , b) = bind_map_pair untype_expression dsi in
-      return (E_look_up dsi')
+      return (e_look_up a b)
   | E_matching (ae, m) ->
       let%bind ae' = untype_expression ae in
       let%bind m' = untype_matching untype_expression m in
-      return (E_matching (ae', m'))
+      return (e_matching ae' m')
   | E_failwith ae ->
       let%bind ae' = untype_expression ae in
-      return (E_failwith ae')
+      return (e_failwith ae')
   | E_sequence _
   | E_loop _
   | E_assign _ -> simple_fail "not possible to untranspile statements yet"
@@ -582,7 +604,7 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
       let%bind tv = untype_type_value rhs.type_annotation in
       let%bind rhs = untype_expression rhs in
       let%bind result = untype_expression result in
-      return (E_let_in {binder = (binder , Some tv);rhs;result})
+      return (e_let_in (binder , (Some tv)) rhs result)
 
 and untype_matching : type o i . (o -> i result) -> o O.matching -> (i I.matching) result = fun f m ->
   let open I in

vendors/ligo-utils/simple-utils/location.ml

@@ -22,16 +22,22 @@ let make (start_pos:Lexing.position) (end_pos:Lexing.position) : t =
 
 let virtual_location s = Virtual s
 let dummy = virtual_location "dummy"
+let generated = virtual_location "generated"
 
 type 'a wrap = {
   wrap_content : 'a ;
   location : t ;
 }
 
-let wrap ~loc wrap_content = { wrap_content ; location = loc }
+let wrap ?(loc = generated) wrap_content = { wrap_content ; location = loc }
+let get_location x = x.location
 let unwrap { wrap_content ; _ } = wrap_content
 let map f x = { x with wrap_content = f x.wrap_content }
 let pp_wrap f ppf { wrap_content ; _ } = Format.fprintf ppf "%a" f wrap_content
 
 let lift_region : 'a Region.reg -> 'a wrap = fun x ->
   wrap ~loc:(File x.region) x.value
+let lift : Region.region -> t = fun x -> File x
+
+let r_extract : 'a Region.reg -> t = fun x -> File x.region
+let r_split : 'a Region.reg -> ('a * t) = fun x -> x.value , File x.region

vendors/ligo-utils/simple-utils/trace.ml

@@ -131,10 +131,10 @@ let mk_error
   let data' =
     let aux (key , value) = (key , `String (value ())) in
     X_option.map (fun x -> ("data" , `Assoc (List.map aux x))) data in
-  let message' = X_option.map (fun x -> ("message " , `String (x ()))) message in
+  let message' = X_option.map (fun x -> ("message" , `String (x ()))) message in
   `Assoc (X_option.collapse_list [ error_code' ; title' ; message' ; data' ])
 
-let error title message () = mk_error ~title:(title) ~message:(message) ()
+let error ?data ?error_code title message () = mk_error ?data ?error_code ~title:(title) ~message:(message) ()
 
 (**
    Helpers that ideally shouldn't be used in production.
@@ -467,12 +467,27 @@ module Assert = struct
 end
 
 let json_of_error = J.to_string
+
 let error_pp out (e : error) =
   let open JSON_string_utils in
-  let message    = e |> member "message"    |> string || "(no message)" in
+  let message =
-  let title      = e |> member "title"      |> string || "(no title)" in
+    let opt = e |> member "message" |> string in
-  let error_code = e |> member "error_code" |> int |> string_of_int || "no error code" in
+    X_option.unopt ~default:"" opt in
-  Format.fprintf out "%s (%s): %s" title error_code message
+  let error_code =
+    let error_code = e |> member "error_code" in
+    match error_code with
+    | `Null -> ""
+    | _ -> " (" ^ (J.to_string error_code) ^ ")" in
+  let title =
+    let opt = e |> member "title" |> string in
+    X_option.unopt ~default:"" opt in
+  let data =
+    let data = e |> member "data" in
+    match data with
+    | `Null -> ""
+    | _ -> J.to_string data in
+  Format.fprintf out "%s (%s): %s. %s" title error_code message data
+
 
 let error_pp_short out (e : error) =
   let open JSON_string_utils in

vendors/ligo-utils/simple-utils/x_option.ml

@@ -27,8 +27,7 @@ let to_list = function
   | None -> []
   | Some x -> [ x ]
 let collapse_list = fun l ->
-  List.concat
+  List.concat @@ List.map to_list l
-  @@ List.map to_list l
 
 (* Combinators *)
 let bind_eager_or = fun a b -> match (a , b) with