various refactorings to prepare tests; tests for ligodity don't pass

src/main/contract.ml

@@ -98,7 +98,7 @@ let parsify_expression_ligodity = fun source ->
 let parsify = fun syntax source ->
   let%bind parsify = match syntax with
     | "pascaligo" -> ok parsify_pascaligo
-    | "cameligo"
+    | "cameligo" -> ok parsify_ligodity
     | _ -> simple_fail "unrecognized parser"
   in
   parsify source
@@ -106,7 +106,7 @@ let parsify = fun syntax source ->
 let parsify_expression = fun syntax source ->
   let%bind parsify = match syntax with
     | "pascaligo" -> ok parsify_expression_pascaligo
-    | "cameligo"
+    | "cameligo" -> ok parsify_expression_ligodity
     | _ -> simple_fail "unrecognized parser"
   in
   parsify source

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,159 +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.Pascaligo.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
-
-
-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

@@ -0,0 +1,218 @@
+open Trace
+
+include struct
+  open Ast_simplified
+
+  let assert_entry_point_defined : program -> string -> unit result =
+    fun program entry_point ->
+      let aux : declaration -> bool = fun declaration ->
+        match declaration with
+        | Declaration_type _ -> false
+        | Declaration_constant (name , _ , _) -> name = entry_point
+      in
+      trace_strong (simple_error "no entry-point with given name") @@
+      Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program
+end
+
+include struct
+  open Ast_typed
+  open Combinators
+
+  let get_entry_point_type : type_value -> (type_value * type_value) result = fun t ->
+    let%bind (arg , result) =
+      trace_strong (simple_error "entry-point doesn't have a function type") @@
+      get_t_function t in
+    let%bind (arg' , storage_param) =
+      trace_strong (simple_error "entry-point doesn't have 2 parameters") @@
+      get_t_pair arg in
+    let%bind (ops , storage_result) =
+      trace_strong (simple_error "entry-point doesn't have 2 results") @@
+      get_t_pair result in
+    let%bind () =
+      trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@
+      assert_t_list_operation ops in
+    let%bind () =
+      trace_strong (simple_error "entry-point doesn't identitcal type (storage) for second parameter and second result") @@
+      assert_type_value_eq (storage_param , storage_result) in
+    ok (arg' , storage_param)
+
+  let get_entry_point : program -> string -> (type_value * type_value) result = fun p e ->
+    let%bind declaration = get_declaration_by_name p e in
+    match declaration with
+    | Declaration_constant (d , _) -> get_entry_point_type d.annotated_expression.type_annotation
+
+  let assert_valid_entry_point = fun p e ->
+    let%bind _ = get_entry_point p e in
+    ok ()
+end
+
+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 parsify_pascaligo = fun source ->
+  let%bind raw =
+    trace (simple_error "parsing") @@
+    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 =
+    trace (simple_error "typing") @@
+    Typer.type_program simplified in
+  let%bind mini_c =
+    trace (simple_error "transpiling") @@
+    Transpiler.translate_entry typed entry_point in
+  let%bind michelson =
+    trace (simple_error "compiling") @@
+    Compiler.translate_contract mini_c in
+  let str =
+    Format.asprintf "%a" Michelson.pp_stripped michelson in
+  ok str
+
+let compile_contract_parameter : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
+  let%bind (program , parameter_tv) =
+    let%bind simplified = parsify syntax source in
+    let%bind () =
+      assert_entry_point_defined simplified entry_point in
+    let%bind typed =
+      trace (simple_error "typing file") @@
+      Typer.type_program simplified in
+    let%bind (param_ty , _) =
+      get_entry_point typed entry_point in
+    ok (typed , param_ty)
+  in
+  let%bind expr =
+    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
+        | Declaration_constant (_ , (_ , post_env)) -> post_env
+      in
+      trace (simple_error "typing expression") @@
+      Typer.type_expression env simplified in
+    let%bind () =
+      trace (simple_error "expression type doesn't match type parameter") @@
+      Ast_typed.assert_type_value_eq (parameter_tv , typed.type_annotation) in
+    let%bind mini_c =
+      trace (simple_error "transpiling expression") @@
+      transpile_value typed in
+    let%bind michelson =
+      trace (simple_error "compiling expression") @@
+      Compiler.translate_value mini_c in
+    let str =
+      Format.asprintf "%a" Michelson.pp_stripped michelson in
+    ok str
+  in
+  ok expr
+
+
+let compile_contract_storage : string -> string -> string -> string -> string result = fun source entry_point expression syntax ->
+  let%bind (program , storage_tv) =
+    let%bind simplified = parsify syntax source in
+    let%bind () =
+      assert_entry_point_defined simplified entry_point in
+    let%bind typed =
+      trace (simple_error "typing file") @@
+      Typer.type_program simplified in
+    let%bind (_ , storage_ty) =
+      get_entry_point typed entry_point in
+    ok (typed , storage_ty)
+  in
+  let%bind expr =
+    let%bind simplified = parsify_expression syntax expression in
+    let%bind typed =
+      let env =
+        let last_declaration = Location.unwrap List.(hd @@ rev program) in
+        match last_declaration with
+        | Declaration_constant (_ , (_ , post_env)) -> post_env
+      in
+      trace (simple_error "typing expression") @@
+      Typer.type_expression env simplified in
+    let%bind () =
+      trace (simple_error "expression type doesn't match type storage") @@
+      Ast_typed.assert_type_value_eq (storage_tv , typed.type_annotation) in
+    let%bind mini_c =
+      trace (simple_error "transpiling expression") @@
+      transpile_value typed in
+    let%bind michelson =
+      trace (simple_error "compiling expression") @@
+      Compiler.translate_value mini_c in
+    let str =
+      Format.asprintf "%a" Michelson.pp_stripped michelson in
+    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/simplify/pascaligo.ml

@@ -351,6 +351,7 @@ and simpl_fun_declaration : Raw.fun_decl -> ((name * type_expression option) * e
        let arguments_name = "arguments" in
        let%bind params = bind_map_list simpl_param lst in
        let (binder , input_type) =
+         (* let type_expression = T_record (SMap.of_list params) in *)
          let type_expression = T_tuple (List.map snd params) in
          (arguments_name , type_expression) in
        let%bind tpl_declarations =

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" "pascaligo"
+    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

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,11 @@
 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 = type_file "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
-  ok typed
 
 let function_ () : unit result =
   let%bind program = type_file "./contracts/function.ligo" in
@@ -148,6 +145,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 +155,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 ()
 
@@ -437,7 +437,7 @@ let dispatch_counter_contract () : unit result =
 
 let basic_mligo () : unit result =
   let%bind typed = mtype_file "./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 =

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=

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

@@ -131,7 +131,7 @@ 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) ()
@@ -467,12 +467,26 @@ 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    = e |> member "message"    |> J.to_string in
-  let title      = e |> member "title"      |> string || "(no title)" in
+  let error_code =
-  let error_code = e |> member "error_code" |> int |> string_of_int || "no error code" in
+    let error_code = e |> member "error_code" in
-  Format.fprintf out "%s (%s): %s" title error_code message
+    match error_code with
+    | `Null -> ""
+    | _ -> " (" ^ (J.to_string error_code) ^ ")" in
+  let title      = e |> member "title"      |> J.to_string 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 out (e : error) =
+ *   Format.fprintf out "%s" @@ json_of_error e *)
+
 
 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