Merge branch 'less-dippy' into 'dev'
Less dippy compiler See merge request ligolang/ligo!528
This commit is contained in:
commit
877c86b6e4
File diff suppressed because it is too large
Load Diff
@ -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
|
||||||
|
@ -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 ;
|
||||||
|
Loading…
Reference in New Issue
Block a user