Merge branch 'fix/not-totally-understood-issue' into 'dev'

[Refactoring] build the application at the ast_simplified level

See merge request ligolang/ligo!246

src/bin/cli.ml

@@ -153,7 +153,7 @@ let compile_parameter =
     let%bind simplified_param = Compile.Of_source.compile_expression v_syntax expression in
     let%bind (typed_param,_)  = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
     let%bind mini_c_param     = Compile.Of_typed.compile_expression typed_param in
-    let%bind compiled_param   = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Expression mini_c_param) [] in
+    let%bind compiled_param   = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg mini_c_param in
     let%bind value            = Run.evaluate_expression compiled_param.expr compiled_param.expr_ty in
     ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
   in
@@ -235,10 +235,11 @@ let run_function =
     let%bind mini_c_prg      = Compile.Of_typed.compile typed_prg in
 
     let%bind simplified_param = Compile.Of_source.compile_expression v_syntax parameter in
-    let%bind (typed_param,_)  = Compile.Of_simplified.compile_expression ~env ~state simplified_param in
-    let%bind compiled_param   = Compile.Of_typed.compile_expression typed_param in
+    let%bind app              = Compile.Of_simplified.apply entry_point simplified_param in
+    let%bind (typed_app,_)    = Compile.Of_simplified.compile_expression ~env ~state app in
+    let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in
 
-    let%bind michelson         = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [compiled_param] in
+    let%bind michelson         = Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied in
     let%bind options           = Run.make_dry_run_options {amount ; sender ; source } in
     let%bind michelson_output  = Run.run ~options michelson.expr michelson.expr_ty in
     let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_prg entry_point michelson_output in
@@ -257,7 +258,7 @@ let evaluate_value =
     let%bind typed_prg,_       = Compile.Of_simplified.compile simplified in
     let%bind mini_c            = Compile.Of_typed.compile typed_prg in
     let%bind (exp,_)           = Mini_c.get_entry mini_c entry_point in
-    let%bind compiled          = Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Expression exp) [] in
+    let%bind compiled          = Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
     let%bind options           = Run.make_dry_run_options {amount ; sender ; source } in
     let%bind michelson_output  = Run.run ~options compiled.expr compiled.expr_ty in
     let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_prg entry_point michelson_output in

src/main/compile/of_mini_c.ml

@@ -27,32 +27,23 @@ let aggregate_and_compile = fun program form ->
   | ExpressionForm _ -> compile_expression aggregated'
 
 let aggregate_and_compile_contract = fun program name ->
-  let%bind (exp, idx) = get_entry program name in
-  aggregate_and_compile program (ContractForm (exp, idx))
+  let%bind (exp, _) = get_entry program name in
+  aggregate_and_compile program (ContractForm exp)
 
-type compiled_expression_t =
-  | Expression of expression
-  | Entry_name of string 
-
-let aggregate_and_compile_expression = fun program exp args ->
-  match exp with
-  | Expression exp ->
-    aggregate_and_compile program (ExpressionForm ((exp,List.length program), args))
-  | Entry_name name -> 
-    let%bind (exp, idx) = get_entry program name in
-    aggregate_and_compile program (ExpressionForm ((exp,idx), args))
+let aggregate_and_compile_expression = fun program exp ->
+  aggregate_and_compile program (ExpressionForm exp)
 
 let build_contract : Compiler.compiled_expression -> Michelson.michelson result =
   fun compiled ->
-  let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_lambda_parameters compiled.expr_ty in
+  let%bind ((Ex_ty _param_ty),(Ex_ty _storage_ty)) = Self_michelson.fetch_contract_inputs compiled.expr_ty in
   let%bind param_michelson =
-    Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's parameter") @@
+    Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse parameter") @@
     Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _param_ty in
   let%bind storage_michelson =
-    Trace.trace_tzresult_lwt (simple_error "Could not unparse contract lambda's storage") @@
+    Trace.trace_tzresult_lwt (simple_error "Invalid contract: Could not unparse storage") @@
     Proto_alpha_utils.Memory_proto_alpha.unparse_ty_michelson _storage_ty in
   let contract = Michelson.contract param_michelson storage_michelson compiled.expr in
   let%bind () = 
-    Trace.trace_tzresult_lwt (simple_error "Invalid contract") @@
+    Trace.trace_tzresult_lwt (simple_error "Invalid contract: Contract did not typecheck") @@
     Proto_alpha_utils.Memory_proto_alpha.typecheck_contract contract in
   ok contract

src/main/compile/of_simplified.ml

@@ -5,5 +5,16 @@ let compile (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solv
   let () = Typer.Solver.discard_state state in
   ok @@ (prog_typed, state)
 
-let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) : (Ast_typed.value * Typer.Solver.state) result =
+let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression)
+    : (Ast_typed.value * Typer.Solver.state) result =
   Typer.type_expression env state ae
+
+let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result =
+  let name = Var.of_name entry_point in
+  let entry_point_var : Ast_simplified.expression =
+    { expression = Ast_simplified.E_variable name ;
+      location = Virtual "generated entry-point variable" } in
+  let applied : Ast_simplified.expression = 
+    { expression = Ast_simplified.E_application (entry_point_var, param) ;
+      location = Virtual "generated application" } in
+  ok applied

src/passes/9-self_michelson/helpers.ml

@@ -19,9 +19,8 @@ let rec map_expression : mapper -> michelson -> michelson result = fun f e ->
   | x -> ok x
 
 open Memory_proto_alpha.Protocol.Script_ir_translator
-(* fetches lambda first and second parameter (parameter,storage) *)
-let fetch_lambda_parameters : ex_ty -> (ex_ty * ex_ty) result =
-  let error ()  = simple_fail "failed to fetch lambda parameters" in
+let fetch_contract_inputs : ex_ty -> (ex_ty * ex_ty) result =
+  let error ()  = simple_fail "Invalid contract: Failed to fetch parameter and storage" in
   function
   | Ex_ty (Lambda_t (in_ty, _, _)) -> (
     match in_ty with

src/stages/mini_c/misc.ml

@@ -140,60 +140,29 @@ let get_entry (lst : program) (name : string) : (expression * int) result =
   in
   ok (entry_expression , entry_index)
 
-(*
-  Assume the following program:
-  ```
-    const x = 42
-    const y = 120
-    const f = () -> x + y
-  ```
-  aggregate_entry program "f" (Some [unit]) would return:
-  ```
-    let x = 42 in
-    let y = 120 in
-    const f = () -> x + y
-    f(unit)
-  ```
-
-  if arg_lst is None, it means that the entry point is not an arbitrary expression
-*)
 type form_t =
-  | ContractForm of (expression * int)
-  | ExpressionForm of ((expression * int) * expression list)
+  | ContractForm of expression
+  | ExpressionForm of expression
 
 let aggregate_entry (lst : program) (form : form_t) : expression result =
-  let (entry_expression , entry_index, arg_lst) = match form with
-    | ContractForm (exp,i) -> (exp,i,[])
-    | ExpressionForm ((exp,i),argl) -> (exp,i,argl) in
-  let pre_declarations = List.until entry_index lst in
   let wrapper =
     let aux prec cur =
       let (((name , expr) , _)) = cur in
       e_let_in name expr.type_value expr prec
     in
-    fun expr -> List.fold_right' aux expr pre_declarations
+    fun expr -> List.fold_right' aux expr lst
   in
-  match (entry_expression.content , arg_lst) with
-  | (E_closure _ , (hd::tl)) -> (
-      let%bind type_value' = match entry_expression.type_value with
-        | T_function (_,t) -> ok t
-        | _ -> simple_fail "Trying to aggregate closure which does not have function type" in
-      let entry_expression' = List.fold_left
-        (fun acc el ->
-          let type_value' = match acc.type_value with
-            | T_function (_,t) -> t
-            | e -> e in
-          {
-            content = E_application (acc,el) ;
-            type_value = type_value' ;
-          }
+  match form with
+  | ContractForm entry_expression -> (
+    match (entry_expression.content) with
+    | (E_closure l) -> (
+        let l' = { l with body = wrapper l.body } in
+        let e' = {
+          content = E_closure l' ;
+          type_value = entry_expression.type_value ;
+        } in
+        ok e'
       )
-        {
-          content = E_application (entry_expression, hd) ;
-          type_value = type_value' ;
-        } tl in
-      ok @@ wrapper entry_expression'
-    )
-  | (_ , _) -> (
+    | _ -> simple_fail "a contract must be a closure" )
+  | ExpressionForm entry_expression ->
     ok @@ wrapper entry_expression
-    )

src/test/contracts/balance_constant.ligo

@@ -7,5 +7,5 @@ It's there to detect a regression of: https://gitlab.com/ligolang/ligo/issues/68
 
 type storage is tez
 
-function main (const p : unit; const s: int) : list(operation) * storage is
+function main (const p : unit; const s: tez) : list(operation) * storage is
   ((nil : list(operation)), balance)

src/test/heap_tests.ml

@@ -1,143 +0,0 @@
-open Trace
-open Test_helpers
-
-let type_file f =
-  let%bind simplified  = Ligo.Compile.Of_source.compile f (Syntax_name "pascaligo") in
-  let%bind typed,state = Ligo.Compile.Of_simplified.compile simplified in
-  ok @@ (typed,state)
-
-let get_program =
-  let s = ref None in
-  fun () -> match !s with
-    | Some s -> ok s
-    | None -> (
-        let%bind (program , state) = type_file "./contracts/heap-instance.ligo" in
-        let () = Typer.Solver.discard_state state in
-        s := Some program ;
-        ok program
-      )
-
-let a_heap_ez ?value_type (content:(int * Ast_typed.ae) list) =
-  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
-  let value_type = match value_type, content with
-    | None, hd :: _ -> (snd hd).type_annotation
-    | Some s, _ -> s
-    | _ -> raise (Failure "no value type and heap empty when building heap") in
-  e_a_empty_map content (t_nat ()) value_type
-
-let ez lst =
-  let open Ast_typed.Combinators in
-  let value_type = t_pair
-      (t_int ())
-      (t_string ())
-      ()
-  in
-  let lst' =
-    let aux (i, (j, s)) =
-      (i, e_a_empty_pair (e_a_empty_int j) (e_a_empty_string s)) in
-    List.map aux lst in
-  a_heap_ez ~value_type lst'
-
-let dummy n =
-  ez List.(
-    map (fun n -> (n, (n, string_of_int n)))
-    @@ tl
-    @@ range (n + 1)
-  )
-
-let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) =
-  let%bind input_mini_c = Compile.Of_typed.compile_expression input in
-  let%bind mini_c = Compile.Of_typed.compile program in
-  let%bind program_mich = Compile.Of_mini_c.aggregate_and_compile_expression
-      mini_c (Entry_name entry_point) [input_mini_c] in
-  let%bind res = Run.Of_michelson.run program_mich.expr program_mich.expr_ty in
-  let%bind output_type =
-    let%bind entry_expression = Ast_typed.get_entry program entry_point in
-    let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in
-    ok output_type
-  in
-  let%bind mini_c = Compiler.Uncompiler.translate_value res in
-  Transpiler.untranspile mini_c output_type
-
-let is_empty () : unit result =
-  let%bind program = get_program () in
-  let aux n =
-    let open Ast_typed.Combinators in
-    let input = dummy n 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)
-  in
-  let%bind _ = bind_list
-    @@ List.map aux
-    @@ [0 ; 2 ; 7 ; 12] in
-  ok ()
-
-let get_top () : unit result =
-  let%bind program = get_program () in
-  let aux n =
-    let open Ast_typed.Combinators in
-    let input = dummy n in
-    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')
-  in
-  let%bind _ = bind_list
-    @@ List.map aux
-    @@ [0 ; 2 ; 7 ; 12] in
-  ok ()
-
-let pop_switch () : unit result =
-  let%bind program = get_program () in
-  let aux n =
-    let input = dummy n in
-    match n, run_typed "pop_switch" program input with
-    | 0, Trace.Ok _ -> simple_fail "unexpected success"
-    | 0, _ -> ok ()
-    | _, result ->
-        let%bind result' = result in
-        let expected = ez List.(
-            map (fun i -> if i = 1 then (1, (n, string_of_int n)) else (i, (i, string_of_int i)))
-            @@ tl
-            @@ range (n + 1)
-          ) in
-        Ast_typed.assert_value_eq (expected, result')
-  in
-  let%bind _ = bind_list
-    @@ List.map aux
-    @@ [0 ; 2 ; 7 ; 12] in
-  ok ()
-
-let pop () : unit result =
-  let%bind program = get_program () in
-  let aux n =
-    let input = dummy n in
-    (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 ;
-      )
-    | Trace.Error err -> (
-        Format.printf "\nPop output on %d : error\n" n) ;
-        Format.printf "Errors : {\n%a}\n%!" error_pp (err ()) ;
-    ) ;
-    ok ()
-  in
-  let%bind _ = bind_list
-    @@ List.map aux
-    @@ [2 ; 7 ; 12] in
-  simple_fail "display"
-  (* ok () *)
-
-let main = test_suite "Heap (End to End)" [
-    test "is_empty" is_empty ;
-    test "get_top" get_top ;
-    test "pop_switch" pop_switch ;
-    (* test "pop" pop ; *)
-  ]

src/test/test.ml

@@ -8,7 +8,6 @@ let () =
     Integration_tests.main ;
     Transpiler_tests.main ;
     Typer_tests.main ;
-    Heap_tests.main ;
     Coase_tests.main ;
     Vote_tests.main ;
     Multisig_tests.main ;

src/test/test_helpers.ml

@@ -83,10 +83,11 @@ let typed_program_with_simplified_input_to_michelson
     (input: Ast_simplified.expression) : Compiler.compiled_expression result =
   let env = Ast_typed.program_environment program in
   let state = Typer.Solver.initial_state in
-  let%bind (typed_in,_) = Compile.Of_simplified.compile_expression ~env ~state input in
-  let%bind mini_c_in    = Compile.Of_typed.compile_expression typed_in in
+  let%bind app              = Compile.Of_simplified.apply entry_point input in
+  let%bind (typed_app,_)    = Compile.Of_simplified.compile_expression ~env ~state app in
+  let%bind compiled_applied = Compile.Of_typed.compile_expression typed_app in
   let%bind mini_c_prg       = Compile.Of_typed.compile program in
-  Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg (Entry_name entry_point) [mini_c_in]
+  Compile.Of_mini_c.aggregate_and_compile_expression mini_c_prg compiled_applied
 
 let run_typed_program_with_simplified_input ?options
     (program: Ast_typed.program) (entry_point: string)
@@ -144,7 +145,8 @@ let expect_evaluate program entry_point expecter =
     error title content in
   trace error @@
   let%bind mini_c          = Ligo.Compile.Of_typed.compile program in
-  let%bind michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile_expression mini_c (Entry_name entry_point) [] in
+  let%bind (exp,_)         = Mini_c.get_entry mini_c entry_point in
+  let%bind michelson_value = Ligo.Compile.Of_mini_c.aggregate_and_compile_expression mini_c exp in
   let%bind res_michelson   = Ligo.Run.Of_michelson.run michelson_value.expr michelson_value.expr_ty in
   let%bind res_simpl       = Uncompile.uncompile_typed_program_entry_expression_result program entry_point res_michelson in
   expecter res_simpl