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 predicate = get_predicate str lst in
let%bind code = match (predicate, List.length lst) with
| Constant c, 0 -> ok (seq @@ lst' @ [c])
| Unary f, 1 -> ok (seq @@ lst' @ [f])
| Binary f, 2 -> ok (seq @@ lst' @ [f])
| Ternary f, 3 -> ok (seq @@ lst' @ [f])
| Constant c, 0 -> ok (seq @@ lst' @ [
c ; i_pair ;
])
| 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"
in
return code

View File

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