Merge branch 'less-dippy' into 'dev'

Less dippy compiler

See merge request ligolang/ligo!528
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-28 11:07:18 +00:00
commit 877c86b6e4
3 changed files with 1177 additions and 805 deletions

File diff suppressed because it is too large Load Diff

View File

@ -15,22 +15,15 @@ let get : environment -> expression_variable -> michelson result = fun e s ->
error title content in error title content in
generic_try error @@ generic_try error @@
(fun () -> Environment.get_i s e) in (fun () -> Environment.get_i s e) in
let rec aux_bubble = fun n ->
match n with
| 0 -> i_dup
| n -> seq [
dip @@ aux_bubble (n - 1) ;
i_swap ;
]
in
let aux_dig = fun n -> seq [ let aux_dig = fun n -> seq [
dipn n i_dup ;
i_dig n ; i_dig n ;
i_dup ;
i_dug (n + 1) ;
] ]
in in
let code = let code =
if position < 2 if position < 1
then aux_bubble position then i_dup
else aux_dig position in else aux_dig position in
ok code ok code

View File

@ -251,11 +251,12 @@ and translate_expression (expr:expression) (env:environment) : michelson result
) )
| E_application (f , arg) -> ( | E_application (f , arg) -> (
trace (simple_error "Compiling quote application") @@ trace (simple_error "Compiling quote application") @@
let%bind f = translate_expression f env in let%bind f = translate_expression f (Environment.add (Var.fresh (), arg.type_value) env) in
let%bind arg = translate_expression arg env in let%bind arg = translate_expression arg env in
return @@ seq [ return @@ seq [
arg ; arg ;
dip f ; f ;
i_swap ;
prim I_EXEC ; prim I_EXEC ;
] ]
) )
@ -273,15 +274,18 @@ and translate_expression (expr:expression) (env:environment) : michelson result
) )
| E_constant{cons_name=str;arguments= lst} -> | E_constant{cons_name=str;arguments= lst} ->
let module L = Logger.Stateful() in let module L = Logger.Stateful() in
let%bind pre_code = let%bind (pre_code, _env) =
let aux code expr = let aux (code, env) expr =
let%bind expr_code = translate_expression expr env in let%bind expr_code = translate_expression expr env in
L.log @@ Format.asprintf "\n%a -> %a in %a\n" L.log @@ Format.asprintf "\n%a -> %a in %a\n"
PP.expression expr PP.expression expr
Michelson.pp expr_code Michelson.pp expr_code
PP.environment env ; PP.environment env ;
ok (seq [ expr_code ; dip code ]) in let env = Environment.add (Var.fresh (), expr.type_value) env in
bind_fold_right_list aux (seq []) lst in let code = code @ [expr_code] in
ok (code, env) in
bind_fold_right_list aux ([], env) lst in
let pre_code = seq pre_code in
let%bind predicate = get_operator str ty lst in let%bind predicate = get_operator str ty lst in
let%bind code = match (predicate, List.length lst) with let%bind code = match (predicate, List.length lst) with
| Constant c, 0 -> ok @@ seq [ | Constant c, 0 -> ok @@ seq [
@ -426,12 +430,15 @@ and translate_expression (expr:expression) (env:environment) : michelson result
) )
) )
| E_fold ((v , body) , collection , initial) -> ( | E_fold ((v , body) , collection , initial) -> (
let%bind collection' = translate_expression collection env in let%bind collection' =
translate_expression
collection
(Environment.add (Var.fresh (), initial.type_value) env) in
let%bind initial' = translate_expression initial env in let%bind initial' = translate_expression initial env in
let%bind body' = translate_expression body (Environment.add v env) in let%bind body' = translate_expression body (Environment.add v env) in
let code = seq [ let code = seq [
initial' ;
collection' ; collection' ;
dip initial' ;
i_iter (seq [ i_iter (seq [
i_swap ; i_swap ;
i_pair ; body' ; dip i_drop ; i_pair ; body' ; dip i_drop ;