balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

application at ast_simplified level

Browse Source
This commit is contained in:
Lesenechal Remi 2019-12-11 19:15:25 +01:00
parent ebd073f5e2
commit c0472629b9
9 changed files with 40 additions and 223 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/bin/cli.ml
View File

@ -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

17
src/main/compile/of_mini_c.ml
View File

@ -27,20 +27,11 @@ 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 ->

12
src/main/compile/of_simplified.ml
View File

@ -5,5 +5,17 @@ let compile (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solv
let () = Typer.Solver.discard_state state in
ok @@ (prog_typed, state)
(* let apply (program : Ast_simplified.program) (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result = *)
let apply (entry_point : string) (param : Ast_simplified.expression) : Ast_simplified.expression result =
(* let%bind (exp,_) = Ast_simplified.Misc.get_entry program entry_point in *)
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
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

55
src/stages/mini_c/misc.ml
View File

@ -140,41 +140,20 @@ 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) = match form with
| ContractForm (exp,i) -> (exp,i)
| ExpressionForm ((exp,i),_) -> (exp,i) 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 form with
| ContractForm _ -> (
| ContractForm entry_expression -> (
match (entry_expression.content) with
| (E_closure l) -> (
let l' = { l with body = wrapper l.body } in
@ -189,29 +168,5 @@ let aggregate_entry (lst : program) (form : form_t) : expression result =
ok e'
)
| _ -> simple_fail "a contract must be a closure" )
| ExpressionForm (_,arg_lst) -> (
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' ;
}
)
{
content = E_application (entry_expression, hd) ;
type_value = type_value' ;
} tl in
ok @@ wrapper entry_expression'
)
| (_ , _) -> (
| ExpressionForm entry_expression ->
ok @@ wrapper entry_expression
)
)

2
src/test/contracts/balance_constant.ligo
View File

@ -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)

143
src/test/heap_tests.ml
View File

@ -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 ; *)
]

1
src/test/test.ml
View File

@ -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 ;

10
src/test/test_helpers.ml
View File

@ -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