more refactoring

src/bin/cli_helpers.ml

@@ -4,6 +4,6 @@ let toplevel x =
   match x with
   | Trace.Ok ((), annotations) -> ignore annotations; ()
   | Error ss -> (
-      Format.printf "%a%!" Ligo.Display.error_pp (ss ())
+      Format.printf "%a%!" Display.error_pp (ss ())
     )
 

src/main/compile/of_mini_c.ml

@@ -10,3 +10,6 @@ let compile_expression : expression -> Michelson.t result = fun e ->
 
 let compile_function : anon_function -> type_value -> type_value -> Compiler.Program.compiled_program result = fun f in_ty out_ty ->
   Compiler.Program.translate_entry f (in_ty , out_ty)
+
+let uncompile_value : Proto_alpha_utils.Memory_proto_alpha.X.ex_typed_value -> value result = fun x ->
+  Compiler.Uncompiler.translate_value x

src/main/compile/of_simplified.ml

@@ -10,6 +10,23 @@ let compile_expression_entry (program : program) entry_point : Compiler.Program.
   let%bind typed_program = Typer.type_program program in
   Of_typed.compile_expression_entry typed_program entry_point
 
-let compile_expression ae : Michelson.t result =
+let compile_expression ?(env = Ast_typed.Environment.full_empty) ae : Michelson.t result =
-  let%bind typed = Typer.type_expression Ast_typed.Environment.full_empty ae in
+  let%bind typed = Typer.type_expression env ae in
   Of_typed.compile_expression typed
+
+let uncompile_typed_program_entry_expression_result program entry ex_ty_value =
+  let%bind output_type =
+    let%bind (entry_expression , _ ) = Of_typed.get_entry program entry in
+    ok entry_expression.type_annotation
+  in
+  let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in
+  Typer.untype_expression typed
+
+let uncompile_typed_program_entry_function_result program entry ex_ty_value =
+  let%bind output_type =
+    let%bind (entry_expression , _ ) = Of_typed.get_entry program entry in
+    let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in
+    ok output_type
+  in
+  let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in
+  Typer.untype_expression typed

src/main/compile/of_source.ml

@@ -17,3 +17,38 @@ let compile_file_parameter : string -> string -> string -> s_syntax -> Michelson
   let%bind syntax = syntax_to_variant syntax (Some source_filename) in
   let%bind simplified = parsify_expression syntax expression in
   Of_simplified.compile_expression simplified
+
+let compile_file_expression : string -> string -> string -> s_syntax -> Michelson.t result =
+  fun source_filename _entry_point expression syntax ->
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified
+
+let compile_file_storage : string -> string -> string -> s_syntax -> Michelson.t result =
+  fun source_filename _entry_point expression syntax ->
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simplified = parsify_expression syntax expression in
+  Of_simplified.compile_expression simplified
+
+let compile_file_contract_args =
+  fun source_filename _entry_point storage parameter syntax ->
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind storage_simplified = parsify_expression syntax storage in
+  let%bind parameter_simplified = parsify_expression syntax parameter in
+  let args = Ast_simplified.e_pair storage_simplified parameter_simplified in
+  Of_simplified.compile_expression args
+
+let type_file ?(debug_simplify = false) ?(debug_typed = false)
+    syntax (source_filename:string) : Ast_typed.program result =
+  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
+  let%bind simpl = parsify syntax source_filename 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/compile/of_typed.ml

@@ -51,6 +51,27 @@ let compile_function expr =
   in
   Of_mini_c.compile_function f in_ty out_ty
 
+
+let get_entry (lst : program) (name : string) : (annotated_expression * int) result =
+  let%bind entry_expression =
+    trace_option (Errors.missing_entry_point name) @@
+    let aux x =
+      let (Declaration_constant (an , _)) = Location.unwrap x in
+      if (an.name = name)
+      then Some an.annotated_expression
+      else None
+    in
+    List.find_map aux lst
+  in
+  let entry_index =
+    let aux x =
+      let (Declaration_constant (an , _)) = Location.unwrap x in
+      an.name = name
+    in
+    List.find_index aux lst
+  in
+  ok (entry_expression , entry_index)
+
 (*
    Assume the following code:
    ```
@@ -68,50 +89,61 @@ let compile_function expr =
        x + y
    ```
 
-   To do so, each declaration `const variable = expr` is translated in
-   a function `body -> let variable = expr in body`. Those functions are
-   then applied in order, which yields `let x = 42 in let y = 120 in ...`.
-
    The entry-point can be an expression, which is then functionalized if
    `to_functionalize` is set to true.
 *)
-let aggregate_declarations_for_entry (lst : program) (name : string) (to_functionalize : bool) : annotated_expression result =
+let get_aggregated_entry (lst : program) (name : string) (to_functionalize : bool) : annotated_expression result =
-  let rec aux acc (lst : program) =
+  let%bind (entry_expression , entry_index) = get_entry lst name in
-    let%bind acc = acc in
+  let pre_declarations =
-    match lst with
+    let sub_program = List.until entry_index lst in
-    | [] -> fail @@ Errors.missing_entry_point name
+    let aux x = Location.unwrap x in
-    | hd :: tl -> (
+    List.map aux sub_program
-        let (Declaration_constant (an , (pre_env , _))) = Location.unwrap hd in
+  in
-        if (an.name <> name) then (
+  let wrapper =
-          let next = fun expr ->
+    let aux prec cur =
-            let cur = e_a_let_in an.name an.annotated_expression expr pre_env in
+      let (Declaration_constant (an , (pre_env , _))) = cur in
-            acc cur in
+      e_a_let_in an.name an.annotated_expression prec pre_env
-          aux (ok next) tl
+    in
-        ) else (
+    fun expr -> List.fold_right' aux expr pre_declarations
-          match (an.annotated_expression.expression , to_functionalize) with
+  in
+  match (entry_expression.expression , to_functionalize) with
   | (E_lambda l , false) -> (
-            let l' = { l with body = acc l.body } in
+      let l' = { l with body = wrapper l.body } in
-            let e' = { an.annotated_expression with expression = E_lambda l' } in
+      let e' = { entry_expression with expression = E_lambda l' } in
       ok e'
     )
   | (_ , true) -> (
-              ok @@ functionalize @@ acc an.annotated_expression
+      ok @@ functionalize @@ wrapper entry_expression
     )
-          | _ -> fail @@ Errors.not_functional_main an.annotated_expression.location
+  | _ -> fail @@ Errors.not_functional_main entry_expression.location
-        )
-      )
-  in
-  let%bind l = aux (ok (fun x -> x)) lst in
-  ok l
 
 let compile_function_entry : program -> string -> _ = fun p entry ->
-  let%bind expr = aggregate_declarations_for_entry p entry false in
+  let%bind expr = get_aggregated_entry p entry false in
   compile_function expr
 
 let compile_expression_entry : program -> string -> _ = fun p entry ->
-  let%bind expr = aggregate_declarations_for_entry p entry true in
+  let%bind expr = get_aggregated_entry p entry true in
   compile_function expr
 
 let compile_expression_as_function : annotated_expression -> Compiler.Program.compiled_program result = fun e ->
   let expr = functionalize e in
   compile_function expr
+
+let uncompile_value : _ -> _ -> annotated_expression result = fun x ty ->
+  let%bind mini_c = Of_mini_c.uncompile_value x in
+  Transpiler.untranspile mini_c ty
+
+let uncompile_entry_function_result = fun program entry ex_ty_value ->
+  let%bind output_type =
+    let%bind (entry_expression , _ ) = get_entry program entry in
+    let%bind (_ , output_type) = get_t_function entry_expression.type_annotation in
+    ok output_type
+  in
+  uncompile_value ex_ty_value output_type
+
+let uncompile_entry_expression_result = fun program entry ex_ty_value ->
+  let%bind output_type =
+    let%bind (entry_expression , _ ) = get_entry program entry in
+    ok entry_expression.type_annotation
+  in
+  uncompile_value ex_ty_value output_type

src/main/run/dune

@@ -13,6 +13,7 @@
     mini_c
     operators
     compiler
+    compile
   )
   (preprocess
     (pps ppx_let)

src/main/run/main.ml

@@ -1,137 +0,0 @@
-module Run_mini_c = Run_mini_c
-
-(* open Trace *)
-module Parser = Parser
-module AST_Raw = Parser.Pascaligo.AST
-module AST_Simplified = Ast_simplified
-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 Display = Display
-
-(* 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_expr (e:AST_Raw.expr) : Ast_simplified.expression result = Simplify.Pascaligo.simpl_expression e
- * let unparse_simplified_expr (e:AST_Simplified.expression) : string result =
- *   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_expression ?(env:Typer.Environment.t = Typer.Environment.full_empty)
- *     (e:AST_Simplified.expression) : AST_Typed.annotated_expression result =
- *   Typer.type_expression env 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_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 untranspile_value (v : Mini_c.value) (e:AST_Typed.type_value) : AST_Typed.annotated_expression result =
- *   Transpiler.untranspile v e
- * 
- * let compile : Mini_c.program -> string -> Compiler.Program.compiled_program result = Compiler.Program.translate_program
- * 
- * let easy_evaluate_typed (entry:string) (program:AST_Typed.program) : AST_Typed.annotated_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
- *   ok typed_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/of_mini_c.ml

@@ -16,7 +16,7 @@ type options = {
   input_type : type_value ;
   output_type : type_value ;
   input : value ;
-  michelson_options : From_michelson.options ;
+  michelson_options : Of_michelson.options ;
 }
 
 let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (input:value) : value result =
@@ -31,7 +31,7 @@ let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (in
     Format.printf "Input Type: %a\n" PP.type_ (fst ty) ;
     Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ;
   ) ;
-  let%bind ex_ty_value = From_michelson.run ?options compiled input_michelson in
+  let%bind ex_ty_value = Of_michelson.run ?options compiled input_michelson in
   if debug_michelson then (
     let (Ex_typed_value (ty , v)) = ex_ty_value in
     ignore @@
@@ -41,5 +41,5 @@ let run_entry ?(debug_michelson = false) ?options (entry : anon_function) ty (in
     Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ;
     ok ()
   ) ;
-  let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
+  let%bind (result : value) = Compile.Of_mini_c.uncompile_value ex_ty_value in
   ok result

src/main/run/of_simplified.ml

@@ -0,0 +1,31 @@
+open Trace
+open Ast_simplified
+
+let get_final_environment program =
+  let last_declaration = Location.unwrap List.(hd @@ rev program) in
+  let (Ast_typed.Declaration_constant (_ , (_ , post_env))) = last_declaration in
+  post_env
+
+let run_typed_program
+    ?options
+    (program : Ast_typed.program) (entry : string)
+    (input : expression) : expression result =
+  let%bind code = Compile.Of_typed.compile_function_entry program entry in
+  let%bind input =
+    let env = get_final_environment program in
+    Compile.Of_simplified.compile_expression ~env input
+  in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value
+
+let evaluate_typed_program_entry
+    ?options
+    (program : Ast_typed.program) (entry : string)
+  : Ast_simplified.expression result =
+  let%bind code = Compile.Of_typed.compile_expression_entry program entry in
+  let%bind input =
+    let fake_input = Ast_typed.(e_a_unit Environment.full_empty) in
+    Compile.Of_typed.compile_expression fake_input
+  in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry ex_ty_value

src/main/run/of_source.ml

@@ -0,0 +1,92 @@
+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 identical 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 run_contract ?amount source_filename entry_point storage parameter syntax =
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
+  let%bind args = Compile.Of_source.compile_file_contract_args source_filename entry_point storage parameter syntax in
+  let%bind ex_value_ty =
+    let options =
+      let open Proto_alpha_utils.Memory_proto_alpha in
+      let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
+      (make_options ?amount ())
+    in
+    Of_michelson.run ~options code args
+  in
+  Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
+
+let run_function ?amount source_filename entry_point input syntax =
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
+  let%bind args = Compile.Of_source.compile_file_expression source_filename entry_point input syntax in
+  let%bind ex_value_ty =
+    let options =
+      let open Proto_alpha_utils.Memory_proto_alpha in
+      let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
+      (make_options ?amount ())
+    in
+    Of_michelson.run ~options code args
+  in
+  Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
+
+let evaluate ?amount source_filename entry_point syntax =
+  let%bind program = Compile.Of_source.type_file syntax source_filename in
+  let%bind code = Compile.Of_typed.compile_expression_entry program entry_point in
+  let%bind input =
+    let fake_input = Ast_simplified.e_unit () in
+    Compile.Of_simplified.compile_expression fake_input
+  in
+  let%bind ex_value_ty =
+    let options =
+      let open Proto_alpha_utils.Memory_proto_alpha in
+      let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
+      (make_options ?amount ())
+    in
+    Of_michelson.run ~options code input
+  in
+  Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry_point ex_value_ty

src/main/run/of_typed.ml

@@ -0,0 +1,34 @@
+open Trace
+open Ast_typed
+
+let run_function ?options f input =
+  let%bind code = Compile.Of_typed.compile_function f in
+  let%bind input = Compile.Of_typed.compile_expression input in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  let%bind ty =
+    let%bind (_ , output_ty) = get_t_function f.type_annotation in
+    ok output_ty
+  in
+  Compile.Of_typed.uncompile_value ex_ty_value ty
+
+let run_entry
+    ?options (entry : string)
+    (program : Ast_typed.program) (input : Ast_typed.annotated_expression) : Ast_typed.annotated_expression result =
+  let%bind code = Compile.Of_typed.compile_function_entry program entry in
+  let%bind input = Compile.Of_typed.compile_expression input in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_typed.uncompile_entry_function_result program entry ex_ty_value
+
+let evaluate ?options (e : annotated_expression) : annotated_expression result =
+  let%bind code = Compile.Of_typed.compile_expression_as_function e in
+  let fake_input = e_a_unit Environment.full_empty in
+  let%bind input = Compile.Of_typed.compile_expression fake_input in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_typed.uncompile_value ex_ty_value e.type_annotation
+
+let evaluate_entry ?options program entry =
+  let%bind code = Compile.Of_typed.compile_expression_entry program entry in
+  let fake_input = e_a_unit Environment.full_empty in
+  let%bind input = Compile.Of_typed.compile_expression fake_input in
+  let%bind ex_ty_value = Of_michelson.run ?options code input in
+  Compile.Of_typed.uncompile_entry_expression_result program entry ex_ty_value

src/main/run/run.ml

@@ -0,0 +1,4 @@
+module Of_typed = Of_typed
+module Of_simplified = Of_simplified
+module Of_mini_c = Of_mini_c
+module Of_michelson = Of_michelson

src/main/run/run_simplified.ml

@@ -1,27 +0,0 @@
-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
-    ?options
-    ?(debug_mini_c = false) ?(debug_michelson = false)
-    (program : Ast_typed.program) (entry : string)
-  : Ast_simplified.expression result =
-  let%bind typed_result = Run_typed.evaluate_typed ?options ~debug_mini_c ~debug_michelson entry program in
-  let%bind annotated_result = Typer.untype_expression typed_result in
-  ok annotated_result

src/main/run/run_source.ml

@@ -1,207 +0,0 @@
-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 identical 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 , ty) =
-    let open Transpiler in
-    let (f , _) = functionalize e in
-    let%bind main = translate_main f e.location in
-    ok main
-  in
-
-  let input = Mini_c.Combinators.d_unit in
-  let%bind r = Run_mini_c.run_entry f ty input in
-  ok (r , snd ty)
-
-open Helpers
-
-let compile_contract_file : string -> string -> s_syntax -> string result = fun source_filename entry_point syntax ->
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind simplified = parsify syntax source_filename 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 , mini_c_ty) =
-    trace (simple_error "transpiling") @@
-    Transpiler.translate_entry typed entry_point in
-  let%bind michelson =
-    trace (simple_error "compiling") @@
-    Compiler.translate_contract mini_c mini_c_ty in
-  let str =
-    Format.asprintf "%a" Michelson.pp_stripped michelson in
-  ok str
-
-let compile_contract_parameter : string -> string -> string -> s_syntax -> string result = fun source_filename entry_point expression syntax ->
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind (program , parameter_tv) =
-    let%bind simplified = parsify syntax source_filename 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 , mini_c_ty) =
-      trace (simple_error "transpiling expression") @@
-      transpile_value typed in
-    let%bind michelson =
-      trace (simple_error "compiling expression") @@
-      Compiler.translate_value mini_c mini_c_ty in
-    let str =
-      Format.asprintf "%a" Michelson.pp_stripped michelson in
-    ok str
-  in
-  ok expr
-
-
-let compile_contract_storage : string -> string -> string -> s_syntax -> string result = fun source_filename entry_point expression syntax ->
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind (program , storage_tv) =
-    let%bind simplified = parsify syntax source_filename 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 , mini_c_ty) =
-      trace (simple_error "transpiling expression") @@
-      transpile_value typed in
-    let%bind michelson =
-      trace (simple_error "compiling expression") @@
-      Compiler.translate_value mini_c mini_c_ty 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 (source_filename:string) : Ast_typed.program result =
-  let%bind simpl = parsify syntax source_filename 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
-
-let run_contract ?amount source_filename entry_point storage input syntax =
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind typed =
-    type_file syntax source_filename in
-  let%bind storage_simpl =
-    parsify_expression syntax storage in
-  let%bind input_simpl =
-    parsify_expression syntax input in
-  let options =
-    let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
-    (make_options ?amount ()) in
-  Run_simplified.run_simplityped ~options typed entry_point (Ast_simplified.e_pair storage_simpl input_simpl)
-
-let run_function ?amount source_filename entry_point parameter syntax =
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind typed =
-    type_file syntax source_filename in
-  let%bind parameter' =
-    parsify_expression syntax parameter in
-  let options =
-    let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
-    (make_options ?amount ()) in
-  Run_simplified.run_simplityped ~options typed entry_point parameter'
-
-let evaluate_value ?amount source_filename entry_point syntax =
-  let%bind syntax = syntax_to_variant syntax (Some source_filename) in
-  let%bind typed =
-    type_file syntax source_filename in
-  let options =
-    let open Proto_alpha_utils.Memory_proto_alpha in
-    let amount = Option.bind (fun amount -> Protocol.Alpha_context.Tez.of_string amount) amount in
-    (make_options ?amount ()) in
-  Run_simplified.evaluate_simplityped ~options typed entry_point

src/main/run/run_typed.ml

@@ -1,71 +0,0 @@
-open Trace
-open Ast_typed
-
-let evaluate (e : annotated_expression) : annotated_expression result =
-  let%bind (f , ty) =
-    let open Transpiler in
-    let (f , _) = functionalize e in
-    let%bind main = translate_main f e.location in
-    ok main
-  in
-
-  let input = Mini_c.Combinators.d_unit in
-  let%bind r = Run_mini_c.run_entry f ty input in
-  ok r
-
-let evaluate_typed
-    ?(debug_mini_c = false) ?(debug_michelson = false)
-    ?options (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 , ty) =
-      Transpiler.translate_entry program entry in
-    (if debug_mini_c then
-       Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main)
-    ) ;
-    Run_mini_c.run_entry ?options ~debug_michelson mini_c_main ty (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%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 , ty) =
-    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 ty 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