move predicate compilation

This commit is contained in:
Galfour 2019-04-19 18:25:32 +00:00
parent 01bb951d3d
commit 168251ff0e
2 changed files with 29 additions and 16 deletions

View File

@ -182,10 +182,31 @@ and translate_expression (expr:expression) : michelson result =
let%bind lst' = bind_list @@ List.map translate_expression lst in let%bind lst' = bind_list @@ List.map translate_expression lst in
let%bind predicate = get_predicate str lst in let%bind predicate = get_predicate str 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 @@ lst' @ [c]) | Constant c, 0 -> ok (seq @@ lst' @ [
| Unary f, 1 -> ok (seq @@ lst' @ [f]) c ; i_pair ;
| Binary f, 2 -> ok (seq @@ lst' @ [f]) ])
| Ternary f, 3 -> ok (seq @@ lst' @ [f]) | Unary f, 1 -> ok (seq @@ lst' @ [
i_unpair ;
f ;
i_pair ;
])
| Binary f, 2 -> ok (seq @@ lst' @ [
i_unpair ;
dip i_unpair ;
i_swap ;
f ;
i_pair ;
])
| Ternary f, 3 -> ok (seq @@ lst' @ [
i_unpair ;
dip i_unpair ;
dip (dip i_unpair) ;
i_swap ;
dip i_swap ;
i_swap ;
f ;
i_pair ;
])
| _ -> simple_fail "bad arity" | _ -> simple_fail "bad arity"
in in
return code return code

View File

@ -201,21 +201,13 @@ module Compiler = struct
| Binary of michelson | Binary of michelson
| Ternary of michelson | Ternary of michelson
let simple_constant c = Constant ( seq [ let simple_constant c = Constant c
c ; i_pair ;
])
let simple_unary c = Unary ( seq [ let simple_unary c = Unary c
i_unpair ; c ; i_pair ;
])
let simple_binary c = Binary ( seq [ let simple_binary c = Binary c
i_unpair ; dip i_unpair ; i_swap ; c ; i_pair ;
])
let simple_ternary c = Ternary ( seq [ let simple_ternary c = Ternary c
i_unpair ; dip i_unpair ; dip (dip i_unpair) ; i_swap ; dip i_swap ; i_swap ; c ; i_pair ;
])
let predicates = Map.String.of_list [ let predicates = Map.String.of_list [
("ADD_INT" , simple_binary @@ prim I_ADD) ; ("ADD_INT" , simple_binary @@ prim I_ADD) ;