CLI clean

src/bin/cli.ml

@@ -125,12 +125,17 @@ let measure_contract =
   (term , Term.info ~doc cmdname)
 
 let compile_parameter =
-  let f source_file _entry_point expression syntax display_format michelson_format =
+  let f source_file entry_point expression syntax display_format michelson_format =
     toplevel ~display_format @@
     let%bind v_syntax      = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
-    let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
+    (*
-    let%bind compiled_exp  = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in
+      TODO:
-    let%bind value         = Run.evaluate_michelson compiled_exp in
+      source_to_michelson_contract will fail if the entry_point does not point to a michelson contract
+      but we do not check that the type of the parameter matches the type of the given expression
+    *)
+    let%bind (_,(_,state,env)) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
+    let%bind compiled_exp      = Compile.source_expression_to_michelson ~env ~state expression v_syntax in
+    let%bind value             = Run.evaluate_expression compiled_exp.expr compiled_exp.expr_ty in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
   in
   let term =
@@ -140,12 +145,17 @@ let compile_parameter =
   (term , Term.info ~doc cmdname)
 
 let compile_storage =
-  let f source_file _entry_point expression syntax display_format michelson_format =
+  let f source_file entry_point expression syntax display_format michelson_format =
     toplevel ~display_format @@
     let%bind v_syntax          = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
-    let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
+    (*
-    let%bind compiled      = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in
+      TODO:
-    let%bind value         = Run.evaluate_michelson compiled in
+      source_to_michelson_contract will fail if the entry_point does not point to a michelson contract
+      but we do not check that the type of the storage matches the type of the given expression
+    *)
+    let%bind (_,(_,state,env)) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
+    let%bind compiled_exp      = Compile.source_expression_to_michelson ~env ~state expression v_syntax in
+    let%bind value             = Run.evaluate_expression compiled_exp.expr compiled_exp.expr_ty in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
   in
   let term =
@@ -159,11 +169,11 @@ let dry_run =
     toplevel ~display_format @@
     let%bind v_syntax                      = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
     let%bind (_,(typed_program,state,env)) = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
-    let%bind compiled_param                = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in
+    let%bind compiled_parameter            = Compile.source_contract_param_to_michelson ~env ~state (storage,input) v_syntax in
-    let%bind michelson                     = Compile.typed_to_michelson_contract_as_exp typed_program entry_point in
+    let%bind michelson                     = Compile.typed_to_michelson_fun typed_program entry_point in
-    let%bind args_michelson                = Run.evaluate_michelson compiled_param in
+    let%bind args_michelson                = Run.evaluate_expression compiled_parameter.expr compiled_parameter.expr_ty in
     let%bind options                       = Run.make_dry_run_options {amount ; sender ; source } in
-    let%bind michelson_output              = Run.run_contract ~options michelson.expr michelson.expr_ty args_michelson true in
+    let%bind michelson_output              = Run.run_function ~options michelson.expr michelson.expr_ty args_michelson true in
     let%bind simplified_output             = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
@@ -178,11 +188,11 @@ let run_function =
     toplevel ~display_format @@
     let%bind v_syntax                  = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
     let%bind (typed_program,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
-    let%bind compiled_parameter        = Compile.source_expression_to_michelson_value_as_function ~env ~state parameter v_syntax in
+    let%bind compiled_parameter        = Compile.source_expression_to_michelson ~env ~state parameter v_syntax in
-    let%bind michelson                 = Compile.typed_to_michelson_program typed_program entry_point in
+    let%bind michelson                 = Compile.typed_to_michelson_fun typed_program entry_point in
-    let%bind args_michelson            = Run.evaluate_michelson compiled_parameter in
+    let%bind args_michelson            = Run.evaluate_expression compiled_parameter.expr compiled_parameter.expr_ty in
     let%bind options                   = Run.make_dry_run_options {amount ; sender ; source } in
-    let%bind michelson_output          = Run.run ~options michelson args_michelson in
+    let%bind michelson_output          = Run.run_function ~options michelson.expr michelson.expr_ty args_michelson false in
     let%bind simplified_output         = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
@@ -196,9 +206,9 @@ let evaluate_value =
   let f source_file entry_point amount sender source syntax display_format =
     toplevel ~display_format @@
     let%bind (typed_program,_,_) = Compile.source_to_typed (Syntax_name syntax) source_file in
-    let%bind contract            = Compile.typed_to_michelson_value_as_function typed_program entry_point in
+    let%bind compiled            = Compile.typed_to_michelson_expression typed_program entry_point in
     let%bind options             = Run.make_dry_run_options {amount ; sender ; source } in
-    let%bind michelson_output    = Run.evaluate ~options contract in
+    let%bind michelson_output    = Run.run_exp ~options compiled.expr compiled.expr_ty in
     let%bind simplified_output   = Uncompile.uncompile_typed_program_entry_expression_result typed_program entry_point michelson_output in
     ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
   in
@@ -212,10 +222,10 @@ let compile_expression =
   let f expression syntax display_format michelson_format =
     toplevel ~display_format @@
     let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (None) in
-    let%bind compiled = Compile.source_expression_to_michelson_value_as_function
+    let%bind compiled = Compile.source_expression_to_michelson
       ~env:(Ast_typed.Environment.full_empty) ~state:(Typer.Solver.initial_state)
       expression v_syntax in
-    let%bind value    = Run.evaluate_michelson compiled in
+    let%bind value    = Run.evaluate_expression compiled.expr compiled.expr_ty in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
   in
   let term =

src/main/compile/of_mini_c.ml

@@ -33,19 +33,32 @@ let compile_function_entry = fun program name ->
 
 (* new *)
 
-let compile_contract : expression -> Compiler.compiled_expression result = fun e ->
+(*TODO rename to compile_function ; see if can be merge with compile expression ? do the same match as in get_t_function and done. ? *)
-  let%bind (input , _) = get_t_function e.type_value in
+let compile_function_expression : expression -> Compiler.compiled_expression result = fun e ->
+  let%bind (input_ty , _) = get_t_function e.type_value in
   let%bind body = get_function e in
-  let%bind body = Compiler.Program.translate_function_body body [] input in
+  let%bind body = Compiler.Program.translate_function_body body [] input_ty in
   let expr = Self_michelson.optimize body in
   let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in
   let open! Compiler.Program in
   ok { expr_ty ; expr }
 
-let compile_contract_as_exp = fun program name ->
+let compile_expression : expression -> Compiler.compiled_expression result = fun e ->
+  let%bind expr = Compiler.Program.translate_expression e Compiler.Environment.empty in
+  let expr = Self_michelson.optimize expr in
+  let%bind expr_ty = Compiler.Type.Ty.type_ e.type_value in
+  let open! Compiler.Program in
+  ok { expr_ty ; expr }
+
+let aggregate_and_compile_function = fun program name ->
   let%bind aggregated = aggregate_entry program name false in
   let aggregated = Self_mini_c.all_expression aggregated in
-  compile_contract aggregated
+  compile_function_expression aggregated
+
+let aggregate_and_compile_expression = fun program name ->
+  let%bind aggregated = aggregate_entry program name true in
+  let aggregated = Self_mini_c.all_expression aggregated in
+  compile_expression aggregated
 
 let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
   fun compiled ->

src/main/compile/wrapper.ml

@@ -1,5 +1,6 @@
 open Trace
 
+(* will keep *)
 let source_to_typed syntax source_file =
   let%bind simplified  = Of_source.compile source_file syntax in
   let%bind typed,state = Of_simplified.compile simplified in
@@ -10,6 +11,7 @@ let source_to_typed_expression ~env ~state parameter syntax =
   let%bind simplified = Of_source.compile_expression syntax parameter in
   let%bind (typed,_) = Of_simplified.compile_expression ~env ~state simplified in
   ok typed
+(* will keep *)
 
 let typed_to_michelson_program
     (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result =
@@ -42,14 +44,31 @@ let source_contract_input_to_michelson_value_as_function ~env ~state (storage,pa
   typed_expression_to_michelson_value_as_function typed
 
 (* new *)
-let typed_to_michelson_contract_as_exp
+let typed_to_michelson_fun
     (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_expression result =
   let%bind mini_c = Of_typed.compile typed in
-  Of_mini_c.compile_contract_as_exp mini_c entry_point
+  Of_mini_c.aggregate_and_compile_function mini_c entry_point
 
-(* produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code *)
+let typed_to_michelson_expression
+    (typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_expression result =
+  let%bind mini_c = Of_typed.compile typed in
+  Of_mini_c.aggregate_and_compile_expression mini_c entry_point
+
+let source_expression_to_michelson ~env ~state parameter syntax =
+  let%bind typed  = source_to_typed_expression ~env ~state parameter syntax in
+  let%bind mini_c = Of_typed.compile_expression typed in
+  Of_mini_c.compile_expression mini_c
+
+let source_contract_param_to_michelson ~env ~state (storage,parameter) syntax =
+  let%bind simplified = Of_source.compile_contract_input storage parameter syntax in
+  let%bind typed,_    = Of_simplified.compile_expression ~env ~state simplified in
+  let%bind mini_c = Of_typed.compile_expression typed in
+  Of_mini_c.compile_expression mini_c
+
+(*  produce a michelson contract e.g. the following sequence K_param ; K_storage ; K_code.
+    and fails if the produced contract isn't valid                                         *)
 let source_to_michelson_contract syntax source_file entry_point =
   let%bind (typed,state,env) = source_to_typed syntax source_file in
-  let%bind michelson = typed_to_michelson_contract_as_exp typed entry_point in
+  let%bind michelson = typed_to_michelson_fun typed entry_point in
   let%bind contract = Of_mini_c.build_contract michelson in
   ok (contract, (typed,state,env))

src/main/run/of_michelson.ml

@@ -124,37 +124,14 @@ let pack_payload (payload:Michelson.t) ty =
     Memory_proto_alpha.pack ty payload in
   ok @@ data
 
-
+(* new *)
-(*
-type ex_option =
-Ex_option : 'a option -> ex_option
-
-let f : ex_option -> _ = fun exo ->
-  let (Ex_option x) = exo in
-  match x with
-  | None -> 0
-  | Some x' -> 1 (*x' varialbe de tpy existentiel*)
-   (* Some x' : j'essaie defenir x', et je le sors pas de la function, donc c bon*)
-*)
-
-(*
-type ex = Ex : 'a -> ex
-let f = fun x -> let (Ex x') = x in x' (* la ca sort *)
-*)
-
-  (* | Pair_t :
-      ('a ty * field_annot option * var_annot option) *
-      ('b ty * field_annot option * var_annot option) *
-      type_annot option *
-      bool -> ('a, 'b) pair ty *)
 let fetch_lambda_types (contract_ty:ex_ty) =
   match contract_ty with
   | Ex_ty (Lambda_t (in_ty, out_ty, _)) -> ok (Ex_ty in_ty, Ex_ty out_ty)
   | _ -> simple_fail "failed to fetch lambda types"
 
-(* type run_res = Failwith of failwith_res | Success of ex_typed_value
+(* type run_res = Failwith of failwith_res | Success of ex_typed_value *)
-let run_bis ?options (exp:Michelson.t) (input_michelson:Michelson.t) (is_contract:bool) : run_res result = *)
+let run_function ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result =
-let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) (is_contract:bool) : ex_typed_value result =
   let open! Tezos_raw_protocol_005_PsBabyM1 in
   let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_lambda_types exp_type in
   let%bind input =
@@ -180,20 +157,13 @@ let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Mi
       in
   ok (Ex_typed_value (output_ty, output))
 
- (*
+let run_exp ?options (exp:Michelson.t) (exp_type:ex_ty) : ex_typed_value result =
-let run_exp ?options (exp:Michelson.t) (*add the type*) : ex_typed_value result =
-  let%bind exp_type =
-    Trace.trace_tzresult_lwt (simple_error "error getting expression type") @@
-    Memory_proto_alpha.parse_michelson_ty exp in
   let open! Tezos_raw_protocol_005_PsBabyM1 in
   let (Ex_ty exp_type') = exp_type in
-  let%bind ((top_level : tc_context), ty_stack_before, ty_stack_after) =
-    ok @@ (
-      Script_ir_translator.Lambda,
-      Script_typed_ir.Empty_t,
-      Script_typed_ir.Item_t (exp_type', Empty_t, None) )
-  in
   let exp = Michelson.strip_annots exp in
+  let top_level = Script_ir_translator.Lambda
+  and ty_stack_before = Script_typed_ir.Empty_t
+  and ty_stack_after = Script_typed_ir.Item_t (exp_type', Empty_t, None) in
   let%bind descr =
     Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
     Memory_proto_alpha.parse_michelson ~top_level exp ty_stack_before ty_stack_after in
@@ -201,6 +171,8 @@ let run_exp ?options (exp:Michelson.t) (*add the type*) : ex_typed_value result
   let%bind (Item(output, Empty)) =
     Trace.trace_tzresult_lwt (simple_error "error of execution") @@
     Memory_proto_alpha.interpret ?options descr Empty in
-    (* TODO stack type : unit::empty *)
   ok (Ex_typed_value (exp_type', output))
-  *)
+
+let evaluate_expression ?options exp exp_type =
+  let%bind etv = run_exp ?options exp exp_type in
+  ex_value_ty_to_michelson etv

src/stages/mini_c/misc.ml

@@ -122,11 +122,11 @@ end
 
 (*
    Converts `expr` in `fun () -> expr`.
-*)
 let functionalize (body : expression) : expression =
   let content = E_closure { binder = Var.fresh () ; body } in
   let type_value = t_function t_unit body.type_value in
   { content ; type_value }
+*)
 
 let get_entry (lst : program) (name : string) : (expression * int) result =
   let%bind entry_expression =
@@ -166,10 +166,21 @@ let get_entry (lst : program) (name : string) : (expression * int) result =
        x + y
    ```
 
-   The entry-point can be an expression, which is then functionalized if
+   The entry-point can be an expression. In that case the following code:
-   `to_functionalize` is set to true.
+   ```
+     const x = 42
+     const y = 120
+     const z = 423
+     const some_exp = x+y
+   ```
+   Is transformed in:
+     let x = 42 in
+     let y = 120 in
+     let z = 423 in
+     x+y
+   ```
 *)
-let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : expression result =
+let aggregate_entry (lst : program) (name : string) (is_exp : bool) : expression result =
   let%bind (entry_expression , entry_index) = get_entry lst name in
   let pre_declarations = List.until entry_index lst in
   let wrapper =
@@ -179,7 +190,7 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) :
     in
     fun expr -> List.fold_right' aux expr pre_declarations
   in
-  match (entry_expression.content , to_functionalize) with
+  match (entry_expression.content , is_exp) with
   | (E_closure l , false) -> (
       let l' = { l with body = wrapper l.body } in
       let%bind t' =
@@ -193,7 +204,7 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) :
       ok e'
     )
   | (_ , true) -> (
-      ok @@ functionalize @@ wrapper entry_expression
+      ok @@ wrapper entry_expression
     )
   | _ -> (
       Format.printf "Not functional: %a\n" PP.expression entry_expression ;

src/test/multisig_tests.ml

@@ -16,9 +16,8 @@ let get_program =
       )
 
 let compile_main () = 
-  let%bind program,_ = get_program () in
+  let%bind _ = Compile.Wrapper.source_to_michelson_contract
-  let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in
+      (Syntax_name "pascaligo") "./contracts/multisig.ligo" "main" in
-  let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson in
   ok ()
 
 open Ast_simplified

src/test/multisig_v2_tests.ml

@@ -16,9 +16,7 @@ let get_program =
       )
 
 let compile_main () = 
-  let%bind program,_ = get_program () in
+  let%bind _ = Compile.Wrapper.source_to_michelson_contract (Syntax_name "pascaligo") "./contracts/multisig-v2.ligo" "main" in
-  let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in
-  let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson in
   ok ()
 
 open Ast_simplified

src/test/test_helpers.ml

@@ -97,8 +97,8 @@ let expect_fail_typed_program_with_simplified_input ?options
 
 let run_typed_value_as_function
     (program: Ast_typed.program) (entry_point:string) : Ast_simplified.expression result =
-  let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_value_as_function program entry_point in
+  let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_expression program entry_point in
-  let%bind result = Ligo.Run.Of_michelson.evaluate michelson_value_as_f in
+  let%bind result = Ligo.Run.Of_michelson.run_exp michelson_value_as_f.expr michelson_value_as_f.expr_ty in
   Uncompile.uncompile_typed_program_entry_expression_result program entry_point result
 
 let expect ?options program entry_point input expecter =