Merge branch 'dev' of gitlab.com:ligolang/ligo into rinderknecht@michelson
This commit is contained in:
commit
de7864a500
File diff suppressed because it is too large
Load Diff
@ -13,8 +13,8 @@ let apply_comparison : Ast_typed.constant' -> value list -> value result =
|
|||||||
| ( comp , [ V_Ct (C_mutez a' ) ; V_Ct (C_mutez b' ) ] )
|
| ( comp , [ V_Ct (C_mutez a' ) ; V_Ct (C_mutez b' ) ] )
|
||||||
| ( comp , [ V_Ct (C_timestamp a') ; V_Ct (C_timestamp b') ] ) ->
|
| ( comp , [ V_Ct (C_timestamp a') ; V_Ct (C_timestamp b') ] ) ->
|
||||||
let f_op = match comp with
|
let f_op = match comp with
|
||||||
| C_EQ -> Int.equal
|
| C_EQ -> Z.equal
|
||||||
| C_NEQ -> fun a b -> not (Int.equal a b)
|
| C_NEQ -> fun a b -> not (Z.equal a b)
|
||||||
| C_LT -> (<)
|
| C_LT -> (<)
|
||||||
| C_LE -> (<=)
|
| C_LE -> (<=)
|
||||||
| C_GT -> (>)
|
| C_GT -> (>)
|
||||||
@ -68,17 +68,17 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
|
|||||||
raise (Temporary_hack a')
|
raise (Temporary_hack a')
|
||||||
(*TODO This raise is here until we properly implement effects*)
|
(*TODO This raise is here until we properly implement effects*)
|
||||||
|
|
||||||
| ( C_SIZE , [(V_Set l | V_List l)] ) -> return_ct @@ C_nat (List.length l)
|
| ( C_SIZE , [(V_Set l | V_List l)] ) -> return_ct @@ C_nat (Z.of_int @@ List.length l)
|
||||||
| ( C_SIZE , [ V_Map l ] ) -> return_ct @@ C_nat (List.length l)
|
| ( C_SIZE , [ V_Map l ] ) -> return_ct @@ C_nat (Z.of_int @@ List.length l)
|
||||||
| ( C_SIZE , [ V_Ct (C_string s ) ] ) -> return_ct @@ C_nat (String.length s)
|
| ( C_SIZE , [ V_Ct (C_string s ) ] ) -> return_ct @@ C_nat (Z.of_int @@ String.length s)
|
||||||
| ( C_SIZE , [ V_Ct (C_bytes b ) ] ) -> return_ct @@ C_nat (Bytes.length b)
|
| ( C_SIZE , [ V_Ct (C_bytes b ) ] ) -> return_ct @@ C_nat (Z.of_int @@ Bytes.length b)
|
||||||
| ( C_NOT , [ V_Ct (C_bool a' ) ] ) -> return_ct @@ C_bool (not a')
|
| ( C_NOT , [ V_Ct (C_bool a' ) ] ) -> return_ct @@ C_bool (not a')
|
||||||
| ( C_INT , [ V_Ct (C_nat a') ] ) -> return_ct @@ C_int a'
|
| ( C_INT , [ V_Ct (C_nat a') ] ) -> return_ct @@ C_int a'
|
||||||
| ( C_ABS , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (abs a')
|
| ( C_ABS , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (Z.abs a')
|
||||||
| ( C_NEG , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (-a')
|
| ( C_NEG , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (Z.neg a')
|
||||||
| ( C_SOME , [ v ] ) -> return_some v
|
| ( C_SOME , [ v ] ) -> return_some v
|
||||||
| ( C_IS_NAT , [ V_Ct (C_int a') ] ) ->
|
| ( C_IS_NAT , [ V_Ct (C_int a') ] ) ->
|
||||||
if a' > 0 then return_some @@ V_Ct (C_nat a')
|
if a' > Z.zero then return_some @@ V_Ct (C_nat a')
|
||||||
else return_none ()
|
else return_none ()
|
||||||
| ( C_FOLD_CONTINUE , [ v ] ) -> ok @@ v_pair (v_bool true , v)
|
| ( C_FOLD_CONTINUE , [ v ] ) -> ok @@ v_pair (v_bool true , v)
|
||||||
| ( C_FOLD_STOP , [ v ] ) -> ok @@ v_pair (v_bool false , v)
|
| ( C_FOLD_STOP , [ v ] ) -> ok @@ v_pair (v_bool false , v)
|
||||||
@ -96,24 +96,24 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
|
|||||||
)
|
)
|
||||||
(* binary *)
|
(* binary *)
|
||||||
| ( (C_EQ | C_NEQ | C_LT | C_LE | C_GT | C_GE) , _ ) -> apply_comparison c operands
|
| ( (C_EQ | C_NEQ | C_LT | C_LE | C_GT | C_GE) , _ ) -> apply_comparison c operands
|
||||||
| ( C_SUB , [ V_Ct (C_int a' | C_nat a') ; V_Ct (C_int b' | C_nat b') ] ) -> return_ct @@ C_int (a' - b')
|
| ( C_SUB , [ V_Ct (C_int a' | C_nat a') ; V_Ct (C_int b' | C_nat b') ] ) -> return_ct @@ C_int (Z.sub a' b')
|
||||||
| ( C_CONS , [ v ; V_List vl ] ) -> ok @@ V_List (v::vl)
|
| ( C_CONS , [ v ; V_List vl ] ) -> ok @@ V_List (v::vl)
|
||||||
| ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' + b')
|
| ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.add a' b')
|
||||||
| ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (a' + b')
|
| ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (Z.add a' b')
|
||||||
| ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' + b')
|
| ( C_ADD , [ V_Ct (C_nat a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.add a' b')
|
||||||
| ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_int (a' + b')
|
| ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_int (Z.add a' b')
|
||||||
| ( C_MUL , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' * b')
|
| ( C_MUL , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.mul a' b')
|
||||||
| ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (a' * b')
|
| ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (Z.mul a' b')
|
||||||
| ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (a' * b')
|
| ( C_MUL , [ V_Ct (C_nat a' ) ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (Z.mul a' b')
|
||||||
| ( C_MUL , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (a' * b')
|
| ( C_MUL , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (Z.mul a' b')
|
||||||
| ( C_DIV , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (a' / b')
|
| ( C_DIV , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (Z.div a' b')
|
||||||
| ( C_DIV , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (a' / b')
|
| ( C_DIV , [ V_Ct (C_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (Z.div a' b')
|
||||||
| ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_mutez (a' / b')
|
| ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_mutez (Z.div a' b')
|
||||||
| ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_nat (a' / b')
|
| ( C_DIV , [ V_Ct (C_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_nat (Z.div a' b')
|
||||||
| ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (a' mod b')
|
| ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (Z.rem a' b')
|
||||||
| ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (a' mod b')
|
| ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (Z.rem a' b')
|
||||||
| ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (a' mod b')
|
| ( C_MOD , [ V_Ct (C_nat a') ; V_Ct (C_int b') ] ) -> return_ct @@ C_nat (Z.rem a' b')
|
||||||
| ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (a' mod b')
|
| ( C_MOD , [ V_Ct (C_int a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (Z.rem a' b')
|
||||||
| ( C_CONCAT , [ V_Ct (C_string a') ; V_Ct (C_string b') ] ) -> return_ct @@ C_string (a' ^ b')
|
| ( C_CONCAT , [ V_Ct (C_string a') ; V_Ct (C_string b') ] ) -> return_ct @@ C_string (a' ^ b')
|
||||||
| ( C_CONCAT , [ V_Ct (C_bytes a' ) ; V_Ct (C_bytes b' ) ] ) -> return_ct @@ C_bytes (Bytes.cat a' b')
|
| ( C_CONCAT , [ V_Ct (C_bytes a' ) ; V_Ct (C_bytes b' ) ] ) -> return_ct @@ C_bytes (Bytes.cat a' b')
|
||||||
| ( C_OR , [ V_Ct (C_bool a' ) ; V_Ct (C_bool b' ) ] ) -> return_ct @@ C_bool (a' || b')
|
| ( C_OR , [ V_Ct (C_bool a' ) ; V_Ct (C_bool b' ) ] ) -> return_ct @@ C_bool (a' || b')
|
||||||
@ -161,7 +161,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
|
|||||||
(* tertiary *)
|
(* tertiary *)
|
||||||
| ( C_SLICE , [ V_Ct (C_nat st) ; V_Ct (C_nat ed) ; V_Ct (C_string s) ] ) ->
|
| ( C_SLICE , [ V_Ct (C_nat st) ; V_Ct (C_nat ed) ; V_Ct (C_string s) ] ) ->
|
||||||
generic_try (simple_error "bad slice") @@ (fun () ->
|
generic_try (simple_error "bad slice") @@ (fun () ->
|
||||||
V_Ct (C_string (String.sub s st ed))
|
V_Ct (C_string (String.sub s (Z.to_int st) (Z.to_int ed)))
|
||||||
)
|
)
|
||||||
| ( C_LIST_FOLD , [ V_Func_val (arg_name, body, env) ; V_List elts ; init ] ) ->
|
| ( C_LIST_FOLD , [ V_Func_val (arg_name, body, env) ; V_List elts ; init ] ) ->
|
||||||
bind_fold_list
|
bind_fold_list
|
||||||
|
@ -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
|
||||||
|
@ -170,10 +170,10 @@ let rec get_operator : constant' -> type_value -> expression list -> predicate r
|
|||||||
|
|
||||||
and translate_value (v:value) ty : michelson result = match v with
|
and translate_value (v:value) ty : michelson result = match v with
|
||||||
| D_bool b -> ok @@ prim (if b then D_True else D_False)
|
| D_bool b -> ok @@ prim (if b then D_True else D_False)
|
||||||
| D_int n -> ok @@ int (Z.of_int n)
|
| D_int n -> ok @@ int n
|
||||||
| D_nat n -> ok @@ int (Z.of_int n)
|
| D_nat n -> ok @@ int n
|
||||||
| D_timestamp n -> ok @@ int (Z.of_int n)
|
| D_timestamp n -> ok @@ int n
|
||||||
| D_mutez n -> ok @@ int (Z.of_int n)
|
| D_mutez n -> ok @@ int n
|
||||||
| D_string s -> ok @@ string s
|
| D_string s -> ok @@ string s
|
||||||
| D_bytes s -> ok @@ bytes s
|
| D_bytes s -> ok @@ bytes s
|
||||||
| D_unit -> ok @@ prim D_Unit
|
| D_unit -> ok @@ prim D_Unit
|
||||||
@ -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 ;
|
||||||
|
@ -22,14 +22,10 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
|
|||||||
ok @@ D_right b
|
ok @@ D_right b
|
||||||
)
|
)
|
||||||
| (Int_t _), n ->
|
| (Int_t _), n ->
|
||||||
let%bind n =
|
let n = Alpha_context.Script_int.to_zint n in
|
||||||
trace_option (simple_error "too big to fit an int") @@
|
|
||||||
Alpha_context.Script_int.to_int n in
|
|
||||||
ok @@ D_int n
|
ok @@ D_int n
|
||||||
| (Nat_t _), n ->
|
| (Nat_t _), n ->
|
||||||
let%bind n =
|
let n = Alpha_context.Script_int.to_zint n in
|
||||||
trace_option (simple_error "too big to fit an int") @@
|
|
||||||
Alpha_context.Script_int.to_int n in
|
|
||||||
ok @@ D_nat n
|
ok @@ D_nat n
|
||||||
| (Chain_id_t _), id ->
|
| (Chain_id_t _), id ->
|
||||||
let str = Tezos_crypto.Base58.simple_encode
|
let str = Tezos_crypto.Base58.simple_encode
|
||||||
@ -43,14 +39,12 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
|
|||||||
| (Signature_t _ ), n ->
|
| (Signature_t _ ), n ->
|
||||||
ok @@ D_string (Signature.to_b58check n)
|
ok @@ D_string (Signature.to_b58check n)
|
||||||
| (Timestamp_t _), n ->
|
| (Timestamp_t _), n ->
|
||||||
let n =
|
let n = Alpha_context.Script_timestamp.to_zint n in
|
||||||
Z.to_int @@
|
|
||||||
Alpha_context.Script_timestamp.to_zint n in
|
|
||||||
ok @@ D_timestamp n
|
ok @@ D_timestamp n
|
||||||
| (Mutez_t _), n ->
|
| (Mutez_t _), n ->
|
||||||
let%bind n =
|
let%bind n =
|
||||||
generic_try (simple_error "too big to fit an int") @@
|
generic_try (simple_error "too big to fit an int") @@
|
||||||
(fun () -> Int64.to_int @@ Alpha_context.Tez.to_mutez n) in
|
(fun () -> Z.of_int64 @@ Alpha_context.Tez.to_mutez n) in
|
||||||
ok @@ D_mutez n
|
ok @@ D_mutez n
|
||||||
| (Bool_t _), b ->
|
| (Bool_t _), b ->
|
||||||
ok @@ D_bool b
|
ok @@ D_bool b
|
||||||
|
@ -565,17 +565,17 @@ let rec compile_expression :
|
|||||||
compile_binop "MOD" c
|
compile_binop "MOD" c
|
||||||
| EArith (Int n) -> (
|
| EArith (Int n) -> (
|
||||||
let (n , loc) = r_split n in
|
let (n , loc) = r_split n in
|
||||||
let n = Z.to_int @@ snd @@ n in
|
let n = snd @@ n in
|
||||||
return @@ e_literal ~loc (Literal_int n)
|
return @@ e_literal ~loc (Literal_int n)
|
||||||
)
|
)
|
||||||
| EArith (Nat n) -> (
|
| EArith (Nat n) -> (
|
||||||
let (n , loc) = r_split n in
|
let (n , loc) = r_split n in
|
||||||
let n = Z.to_int @@ snd @@ n in
|
let n = snd @@ n in
|
||||||
return @@ e_literal ~loc (Literal_nat n)
|
return @@ e_literal ~loc (Literal_nat n)
|
||||||
)
|
)
|
||||||
| EArith (Mutez n) -> (
|
| EArith (Mutez n) -> (
|
||||||
let (n , loc) = r_split n in
|
let (n , loc) = r_split n in
|
||||||
let n = Z.to_int @@ snd @@ n in
|
let n = snd @@ n in
|
||||||
return @@ e_literal ~loc (Literal_mutez n)
|
return @@ e_literal ~loc (Literal_mutez n)
|
||||||
)
|
)
|
||||||
| EArith (Neg e) -> compile_unop "NEG" e
|
| EArith (Neg e) -> compile_unop "NEG" e
|
||||||
|
@ -364,17 +364,17 @@ let rec compile_expression (t:Raw.expr) : expr result =
|
|||||||
compile_binop "MOD" c
|
compile_binop "MOD" c
|
||||||
| EArith (Int n) -> (
|
| EArith (Int n) -> (
|
||||||
let (n , loc) = r_split n in
|
let (n , loc) = r_split n in
|
||||||
let n = Z.to_int @@ snd n in
|
let n = snd n in
|
||||||
return @@ e_literal ~loc (Literal_int n)
|
return @@ e_literal ~loc (Literal_int n)
|
||||||
)
|
)
|
||||||
| EArith (Nat n) -> (
|
| EArith (Nat n) -> (
|
||||||
let (n , loc) = r_split n in
|
let (n , loc) = r_split n in
|
||||||
let n = Z.to_int @@ snd @@ n in
|
let n = snd @@ n in
|
||||||
return @@ e_literal ~loc (Literal_nat n)
|
return @@ e_literal ~loc (Literal_nat n)
|
||||||
)
|
)
|
||||||
| EArith (Mutez n) -> (
|
| EArith (Mutez n) -> (
|
||||||
let (n , loc) = r_split n in
|
let (n , loc) = r_split n in
|
||||||
let n = Z.to_int @@ snd @@ n in
|
let n = snd @@ n in
|
||||||
return @@ e_literal ~loc (Literal_mutez n)
|
return @@ e_literal ~loc (Literal_mutez n)
|
||||||
)
|
)
|
||||||
| EArith (Neg e) -> compile_unop "NEG" e
|
| EArith (Neg e) -> compile_unop "NEG" e
|
||||||
@ -818,7 +818,7 @@ and compile_single_instruction : Raw.instruction -> (_ -> expression result) res
|
|||||||
let%bind start = compile_expression fi.assign.value.expr in
|
let%bind start = compile_expression fi.assign.value.expr in
|
||||||
let%bind bound = compile_expression fi.bound in
|
let%bind bound = compile_expression fi.bound in
|
||||||
let%bind step = match fi.step with
|
let%bind step = match fi.step with
|
||||||
| None -> ok @@ e_int 1
|
| None -> ok @@ e_int_z Z.one
|
||||||
| Some step -> compile_expression step in
|
| Some step -> compile_expression step in
|
||||||
let%bind body = compile_block fi.block.value in
|
let%bind body = compile_block fi.block.value in
|
||||||
let%bind body = body @@ None in
|
let%bind body = body @@ None in
|
||||||
|
@ -25,7 +25,7 @@ let peephole_expression : expression -> expression result = fun e ->
|
|||||||
let%bind time =
|
let%bind time =
|
||||||
trace_option (bad_string_timestamp str e'.location)
|
trace_option (bad_string_timestamp str e'.location)
|
||||||
@@ Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation str in
|
@@ Memory_proto_alpha.Protocol.Alpha_context.Timestamp.of_notation str in
|
||||||
let itime = Int64.to_int @@ Tezos_utils.Time.Protocol.to_seconds time in
|
let itime = Z.of_int64 @@ Tezos_utils.Time.Protocol.to_seconds time in
|
||||||
return @@ E_literal (Literal_timestamp itime)
|
return @@ E_literal (Literal_timestamp itime)
|
||||||
| (E_literal (Literal_string str) , T_constant (TC_address)) -> return @@ E_literal (Literal_address str)
|
| (E_literal (Literal_string str) , T_constant (TC_address)) -> return @@ E_literal (Literal_address str)
|
||||||
| (E_literal (Literal_string str) , T_constant (TC_bytes)) -> (
|
| (E_literal (Literal_string str) , T_constant (TC_bytes)) -> (
|
||||||
|
@ -82,13 +82,17 @@ let make_e ?(loc = Location.generated) expression_content =
|
|||||||
|
|
||||||
let e_literal ?loc l : expression = make_e ?loc @@ E_literal l
|
let e_literal ?loc l : expression = make_e ?loc @@ E_literal l
|
||||||
let e_unit ?loc () : expression = make_e ?loc @@ E_literal (Literal_unit)
|
let e_unit ?loc () : expression = make_e ?loc @@ E_literal (Literal_unit)
|
||||||
let e_int ?loc n : expression = make_e ?loc @@ E_literal (Literal_int n)
|
let e_int_z ?loc n : expression = make_e ?loc @@ E_literal (Literal_int n)
|
||||||
let e_nat ?loc n : expression = make_e ?loc @@ E_literal (Literal_nat n)
|
let e_int ?loc n : expression = e_int_z ?loc @@ Z.of_int n
|
||||||
let e_timestamp ?loc n : expression = make_e ?loc @@ E_literal (Literal_timestamp n)
|
let e_nat_z ?loc n : expression = make_e ?loc @@ E_literal (Literal_nat n)
|
||||||
|
let e_nat ?loc n : expression = e_nat_z ?loc @@ Z.of_int n
|
||||||
|
let e_timestamp_z ?loc n : expression = make_e ?loc @@ E_literal (Literal_timestamp n)
|
||||||
|
let e_timestamp ?loc n : expression = e_timestamp_z ?loc @@ Z.of_int n
|
||||||
let e_bool ?loc b : expression = make_e ?loc @@ E_literal (Literal_bool b)
|
let e_bool ?loc b : expression = make_e ?loc @@ E_literal (Literal_bool b)
|
||||||
let e_string ?loc s : expression = make_e ?loc @@ E_literal (Literal_string s)
|
let e_string ?loc s : expression = make_e ?loc @@ E_literal (Literal_string s)
|
||||||
let e_address ?loc s : expression = make_e ?loc @@ E_literal (Literal_address s)
|
let e_address ?loc s : expression = make_e ?loc @@ E_literal (Literal_address s)
|
||||||
let e_mutez ?loc s : expression = make_e ?loc @@ E_literal (Literal_mutez s)
|
let e_mutez_z ?loc s : expression = make_e ?loc @@ E_literal (Literal_mutez s)
|
||||||
|
let e_mutez ?loc s : expression = e_mutez_z ?loc @@ Z.of_int s
|
||||||
let e_signature ?loc s : expression = make_e ?loc @@ E_literal (Literal_signature s)
|
let e_signature ?loc s : expression = make_e ?loc @@ E_literal (Literal_signature s)
|
||||||
let e_key ?loc s : expression = make_e ?loc @@ E_literal (Literal_key s)
|
let e_key ?loc s : expression = make_e ?loc @@ E_literal (Literal_key s)
|
||||||
let e_key_hash ?loc s : expression = make_e ?loc @@ E_literal (Literal_key_hash s)
|
let e_key_hash ?loc s : expression = make_e ?loc @@ E_literal (Literal_key_hash s)
|
||||||
|
@ -54,6 +54,9 @@ val make_e : ?loc:Location.t -> expression_content -> expression
|
|||||||
|
|
||||||
val e_literal : ?loc:Location.t -> literal -> expression
|
val e_literal : ?loc:Location.t -> literal -> expression
|
||||||
val e_unit : ?loc:Location.t -> unit -> expression
|
val e_unit : ?loc:Location.t -> unit -> expression
|
||||||
|
val e_int_z : ?loc:Location.t -> Z.t -> expression
|
||||||
|
val e_nat_z : ?loc:Location.t -> Z.t -> expression
|
||||||
|
val e_timestamp_z : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_int : ?loc:Location.t -> int -> expression
|
val e_int : ?loc:Location.t -> int -> expression
|
||||||
val e_nat : ?loc:Location.t -> int -> expression
|
val e_nat : ?loc:Location.t -> int -> expression
|
||||||
val e_timestamp : ?loc:Location.t -> int -> expression
|
val e_timestamp : ?loc:Location.t -> int -> expression
|
||||||
@ -64,6 +67,7 @@ val e_signature : ?loc:Location.t -> string -> expression
|
|||||||
val e_key : ?loc:Location.t -> string -> expression
|
val e_key : ?loc:Location.t -> string -> expression
|
||||||
val e_key_hash : ?loc:Location.t -> string -> expression
|
val e_key_hash : ?loc:Location.t -> string -> expression
|
||||||
val e_chain_id : ?loc:Location.t -> string -> expression
|
val e_chain_id : ?loc:Location.t -> string -> expression
|
||||||
|
val e_mutez_z : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_mutez : ?loc:Location.t -> int -> expression
|
val e_mutez : ?loc:Location.t -> int -> expression
|
||||||
val e'_bytes : string -> expression_content result
|
val e'_bytes : string -> expression_content result
|
||||||
val e_bytes_hex : ?loc:Location.t -> string -> expression result
|
val e_bytes_hex : ?loc:Location.t -> string -> expression result
|
||||||
|
@ -49,9 +49,9 @@ val t_set : ?loc:Location.t -> type_expression -> type_expression
|
|||||||
val make_e : ?loc:Location.t -> expression_content -> expression
|
val make_e : ?loc:Location.t -> expression_content -> expression
|
||||||
val e_literal : ?loc:Location.t -> literal -> expression
|
val e_literal : ?loc:Location.t -> literal -> expression
|
||||||
val e_unit : ?loc:Location.t -> unit -> expression
|
val e_unit : ?loc:Location.t -> unit -> expression
|
||||||
val e_int : ?loc:Location.t -> int -> expression
|
val e_int : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_nat : ?loc:Location.t -> int -> expression
|
val e_nat : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_timestamp : ?loc:Location.t -> int -> expression
|
val e_timestamp : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_bool : ?loc:Location.t -> bool -> expression
|
val e_bool : ?loc:Location.t -> bool -> expression
|
||||||
val e_string : ?loc:Location.t -> string -> expression
|
val e_string : ?loc:Location.t -> string -> expression
|
||||||
val e_address : ?loc:Location.t -> string -> expression
|
val e_address : ?loc:Location.t -> string -> expression
|
||||||
@ -59,7 +59,7 @@ val e_signature : ?loc:Location.t -> string -> expression
|
|||||||
val e_key : ?loc:Location.t -> string -> expression
|
val e_key : ?loc:Location.t -> string -> expression
|
||||||
val e_key_hash : ?loc:Location.t -> string -> expression
|
val e_key_hash : ?loc:Location.t -> string -> expression
|
||||||
val e_chain_id : ?loc:Location.t -> string -> expression
|
val e_chain_id : ?loc:Location.t -> string -> expression
|
||||||
val e_mutez : ?loc:Location.t -> int -> expression
|
val e_mutez : ?loc:Location.t -> Z.t -> expression
|
||||||
val e'_bytes : string -> expression_content result
|
val e'_bytes : string -> expression_content result
|
||||||
val e_bytes_hex : ?loc:Location.t -> string -> expression result
|
val e_bytes_hex : ?loc:Location.t -> string -> expression result
|
||||||
val e_bytes_raw : ?loc:Location.t -> bytes -> expression
|
val e_bytes_raw : ?loc:Location.t -> bytes -> expression
|
||||||
|
@ -50,9 +50,9 @@ val make_e : ?loc:Location.t -> expression_content -> expression
|
|||||||
val e_var : ?loc:Location.t -> string -> expression
|
val e_var : ?loc:Location.t -> string -> expression
|
||||||
val e_literal : ?loc:Location.t -> literal -> expression
|
val e_literal : ?loc:Location.t -> literal -> expression
|
||||||
val e_unit : ?loc:Location.t -> unit -> expression
|
val e_unit : ?loc:Location.t -> unit -> expression
|
||||||
val e_int : ?loc:Location.t -> int -> expression
|
val e_int : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_nat : ?loc:Location.t -> int -> expression
|
val e_nat : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_timestamp : ?loc:Location.t -> int -> expression
|
val e_timestamp : ?loc:Location.t -> Z.t -> expression
|
||||||
val e_bool : ?loc:Location.t -> bool -> expression
|
val e_bool : ?loc:Location.t -> bool -> expression
|
||||||
val e_string : ?loc:Location.t -> string -> expression
|
val e_string : ?loc:Location.t -> string -> expression
|
||||||
val e_address : ?loc:Location.t -> string -> expression
|
val e_address : ?loc:Location.t -> string -> expression
|
||||||
@ -60,7 +60,7 @@ val e_signature : ?loc:Location.t -> string -> expression
|
|||||||
val e_key : ?loc:Location.t -> string -> expression
|
val e_key : ?loc:Location.t -> string -> expression
|
||||||
val e_key_hash : ?loc:Location.t -> string -> expression
|
val e_key_hash : ?loc:Location.t -> string -> expression
|
||||||
val e_chain_id : ?loc:Location.t -> string -> expression
|
val e_chain_id : ?loc:Location.t -> string -> expression
|
||||||
val e_mutez : ?loc:Location.t -> int -> expression
|
val e_mutez : ?loc:Location.t -> Z.t -> expression
|
||||||
val e'_bytes : string -> expression_content result
|
val e'_bytes : string -> expression_content result
|
||||||
val e_bytes_hex : ?loc:Location.t -> string -> expression result
|
val e_bytes_hex : ?loc:Location.t -> string -> expression result
|
||||||
val e_bytes_raw : ?loc:Location.t -> bytes -> expression
|
val e_bytes_raw : ?loc:Location.t -> bytes -> expression
|
||||||
|
@ -181,10 +181,10 @@ let literal ppf (l : literal) =
|
|||||||
| Literal_unit -> fprintf ppf "unit"
|
| Literal_unit -> fprintf ppf "unit"
|
||||||
| Literal_void -> fprintf ppf "void"
|
| Literal_void -> fprintf ppf "void"
|
||||||
| Literal_bool b -> fprintf ppf "%b" b
|
| Literal_bool b -> fprintf ppf "%b" b
|
||||||
| Literal_int n -> fprintf ppf "%d" n
|
| Literal_int z -> fprintf ppf "%a" Z.pp_print z
|
||||||
| Literal_nat n -> fprintf ppf "+%d" n
|
| Literal_nat z -> fprintf ppf "+%a" Z.pp_print z
|
||||||
| Literal_timestamp n -> fprintf ppf "+%d" n
|
| Literal_timestamp z -> fprintf ppf "+%a" Z.pp_print z
|
||||||
| Literal_mutez n -> fprintf ppf "%dmutez" n
|
| Literal_mutez z -> fprintf ppf "%amutez" Z.pp_print z
|
||||||
| Literal_string s -> fprintf ppf "%S" s
|
| Literal_string s -> fprintf ppf "%S" s
|
||||||
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
|
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
|
||||||
| Literal_address s -> fprintf ppf "@%S" s
|
| Literal_address s -> fprintf ppf "@%S" s
|
||||||
|
@ -12,7 +12,7 @@ let needs_parens = {
|
|||||||
);
|
);
|
||||||
type_variable = (fun _ _ _ -> false) ;
|
type_variable = (fun _ _ _ -> false) ;
|
||||||
bool = (fun _ _ _ -> false) ;
|
bool = (fun _ _ _ -> false) ;
|
||||||
int = (fun _ _ _ -> false) ;
|
z = (fun _ _ _ -> false) ;
|
||||||
string = (fun _ _ _ -> false) ;
|
string = (fun _ _ _ -> false) ;
|
||||||
bytes = (fun _ _ _ -> false) ;
|
bytes = (fun _ _ _ -> false) ;
|
||||||
packed_internal_operation = (fun _ _ _ -> false) ;
|
packed_internal_operation = (fun _ _ _ -> false) ;
|
||||||
@ -46,7 +46,7 @@ let op ppf = {
|
|||||||
);
|
);
|
||||||
type_variable = (fun _visitor () type_variable -> fprintf ppf "%a" Var.pp type_variable) ;
|
type_variable = (fun _visitor () type_variable -> fprintf ppf "%a" Var.pp type_variable) ;
|
||||||
bool = (fun _visitor () b -> fprintf ppf "%s" (if b then "true" else "false")) ;
|
bool = (fun _visitor () b -> fprintf ppf "%s" (if b then "true" else "false")) ;
|
||||||
int = (fun _visitor () i -> fprintf ppf "%d" i) ;
|
z = (fun _visitor () i -> fprintf ppf "%a" Z.pp_print i) ;
|
||||||
string = (fun _visitor () str -> fprintf ppf "\"%s\"" str) ;
|
string = (fun _visitor () str -> fprintf ppf "\"%s\"" str) ;
|
||||||
bytes = (fun _visitor () _bytes -> fprintf ppf "bytes...") ;
|
bytes = (fun _visitor () _bytes -> fprintf ppf "bytes...") ;
|
||||||
packed_internal_operation = (fun _visitor () _op -> fprintf ppf "Operation(...bytes)") ;
|
packed_internal_operation = (fun _visitor () _op -> fprintf ppf "Operation(...bytes)") ;
|
||||||
|
@ -111,13 +111,13 @@ val ez_e_record : ( string * expression ) list -> expression
|
|||||||
val e_some : expression -> expression_content
|
val e_some : expression -> expression_content
|
||||||
val e_none : unit -> expression_content
|
val e_none : unit -> expression_content
|
||||||
val e_unit : unit -> expression_content
|
val e_unit : unit -> expression_content
|
||||||
val e_int : int -> expression_content
|
val e_int : Z.t -> expression_content
|
||||||
val e_nat : int -> expression_content
|
val e_nat : Z.t -> expression_content
|
||||||
val e_mutez : int -> expression_content
|
val e_mutez : Z.t -> expression_content
|
||||||
val e_bool : bool -> expression_content
|
val e_bool : bool -> expression_content
|
||||||
val e_string : string -> expression_content
|
val e_string : string -> expression_content
|
||||||
val e_bytes : bytes -> expression_content
|
val e_bytes : bytes -> expression_content
|
||||||
val e_timestamp : int -> expression_content
|
val e_timestamp : Z.t -> expression_content
|
||||||
val e_address : string -> expression_content
|
val e_address : string -> expression_content
|
||||||
val e_signature : string -> expression_content
|
val e_signature : string -> expression_content
|
||||||
val e_key : string -> expression_content
|
val e_key : string -> expression_content
|
||||||
@ -131,9 +131,9 @@ val e_variable : expression_variable -> expression_content
|
|||||||
val e_let_in : expression_variable -> inline -> expression -> expression -> expression_content
|
val e_let_in : expression_variable -> inline -> expression -> expression -> expression_content
|
||||||
|
|
||||||
val e_a_unit : full_environment -> expression
|
val e_a_unit : full_environment -> expression
|
||||||
val e_a_int : int -> full_environment -> expression
|
val e_a_int : Z.t -> full_environment -> expression
|
||||||
val e_a_nat : int -> full_environment -> expression
|
val e_a_nat : Z.t -> full_environment -> expression
|
||||||
val e_a_mutez : int -> full_environment -> expression
|
val e_a_mutez : Z.t -> full_environment -> expression
|
||||||
val e_a_bool : bool -> full_environment -> expression
|
val e_a_bool : bool -> full_environment -> expression
|
||||||
val e_a_string : string -> full_environment -> expression
|
val e_a_string : string -> full_environment -> expression
|
||||||
val e_a_address : string -> full_environment -> expression
|
val e_a_address : string -> full_environment -> expression
|
||||||
@ -147,7 +147,7 @@ val e_a_variable : expression_variable -> type_expression -> full_environment ->
|
|||||||
val ez_e_a_record : ( label * expression ) list -> full_environment -> expression
|
val ez_e_a_record : ( label * expression ) list -> full_environment -> expression
|
||||||
val e_a_let_in : expression_variable -> bool -> expression -> expression -> full_environment -> expression
|
val e_a_let_in : expression_variable -> bool -> expression -> expression -> full_environment -> expression
|
||||||
|
|
||||||
val get_a_int : expression -> int result
|
val get_a_int : expression -> Z.t result
|
||||||
val get_a_unit : expression -> unit result
|
val get_a_unit : expression -> unit result
|
||||||
val get_a_bool : expression -> bool result
|
val get_a_bool : expression -> bool result
|
||||||
val get_a_record_accessor : expression -> (expression * label) result
|
val get_a_record_accessor : expression -> (expression * label) result
|
||||||
|
@ -3,9 +3,9 @@ open Types
|
|||||||
val make_a_e_empty : expression_content -> type_expression -> expression
|
val make_a_e_empty : expression_content -> type_expression -> expression
|
||||||
|
|
||||||
val e_a_empty_unit : expression
|
val e_a_empty_unit : expression
|
||||||
val e_a_empty_int : int -> expression
|
val e_a_empty_int : Z.t -> expression
|
||||||
val e_a_empty_nat : int -> expression
|
val e_a_empty_nat : Z.t -> expression
|
||||||
val e_a_empty_mutez : int -> expression
|
val e_a_empty_mutez : Z.t -> expression
|
||||||
val e_a_empty_bool : bool -> expression
|
val e_a_empty_bool : bool -> expression
|
||||||
val e_a_empty_string : string -> expression
|
val e_a_empty_string : string -> expression
|
||||||
val e_a_empty_address : string -> expression
|
val e_a_empty_address : string -> expression
|
||||||
|
@ -78,10 +78,10 @@ and type_expression = {
|
|||||||
type literal =
|
type literal =
|
||||||
| Literal_unit
|
| Literal_unit
|
||||||
| Literal_bool of bool
|
| Literal_bool of bool
|
||||||
| Literal_int of int
|
| Literal_int of z
|
||||||
| Literal_nat of int
|
| Literal_nat of z
|
||||||
| Literal_timestamp of int
|
| Literal_timestamp of z
|
||||||
| Literal_mutez of int
|
| Literal_mutez of z
|
||||||
| Literal_string of string
|
| Literal_string of string
|
||||||
| Literal_bytes of bytes
|
| Literal_bytes of bytes
|
||||||
| Literal_address of string
|
| Literal_address of string
|
||||||
|
@ -10,6 +10,7 @@ type expression_ = Stage_common.Types.expression_
|
|||||||
type expression_variable = Stage_common.Types.expression_variable
|
type expression_variable = Stage_common.Types.expression_variable
|
||||||
type type_ = Stage_common.Types.type_
|
type type_ = Stage_common.Types.type_
|
||||||
type type_variable = Stage_common.Types.type_variable
|
type type_variable = Stage_common.Types.type_variable
|
||||||
|
type z = Z.t
|
||||||
|
|
||||||
type constructor' =
|
type constructor' =
|
||||||
| Constructor of string
|
| Constructor of string
|
||||||
|
@ -52,10 +52,10 @@ and type_constant ppf (tc:type_constant) : unit =
|
|||||||
let rec value ppf : value -> unit = function
|
let rec value ppf : value -> unit = function
|
||||||
| D_bool b -> fprintf ppf "%b" b
|
| D_bool b -> fprintf ppf "%b" b
|
||||||
| D_operation _ -> fprintf ppf "operation[...bytes]"
|
| D_operation _ -> fprintf ppf "operation[...bytes]"
|
||||||
| D_int n -> fprintf ppf "%d" n
|
| D_int n -> fprintf ppf "%a" Z.pp_print n
|
||||||
| D_nat n -> fprintf ppf "+%d" n
|
| D_nat n -> fprintf ppf "+%a" Z.pp_print n
|
||||||
| D_timestamp n -> fprintf ppf "+%d" n
|
| D_timestamp n -> fprintf ppf "+%a" Z.pp_print n
|
||||||
| D_mutez n -> fprintf ppf "%dmutez" n
|
| D_mutez n -> fprintf ppf "%amutez" Z.pp_print n
|
||||||
| D_unit -> fprintf ppf "unit"
|
| D_unit -> fprintf ppf "unit"
|
||||||
| D_string s -> fprintf ppf "\"%s\"" s
|
| D_string s -> fprintf ppf "\"%s\"" s
|
||||||
| D_bytes x ->
|
| D_bytes x ->
|
||||||
|
@ -17,10 +17,10 @@ module Expression : sig
|
|||||||
end
|
end
|
||||||
|
|
||||||
val get_bool : value ->bool result
|
val get_bool : value ->bool result
|
||||||
val get_int : value -> int result
|
val get_int : value -> Z.t result
|
||||||
val get_nat : value -> int result
|
val get_nat : value -> Z.t result
|
||||||
val get_mutez : value -> int result
|
val get_mutez : value -> Z.t result
|
||||||
val get_timestamp : value -> int result
|
val get_timestamp : value -> Z.t result
|
||||||
val get_string : value -> string result
|
val get_string : value -> string result
|
||||||
val get_bytes : value -> bytes result
|
val get_bytes : value -> bytes result
|
||||||
val get_unit : value -> unit result
|
val get_unit : value -> unit result
|
||||||
|
@ -32,10 +32,10 @@ type inline = bool
|
|||||||
type value =
|
type value =
|
||||||
| D_unit
|
| D_unit
|
||||||
| D_bool of bool
|
| D_bool of bool
|
||||||
| D_nat of int
|
| D_nat of Z.t
|
||||||
| D_timestamp of int
|
| D_timestamp of Z.t
|
||||||
| D_mutez of int
|
| D_mutez of Z.t
|
||||||
| D_int of int
|
| D_int of Z.t
|
||||||
| D_string of string
|
| D_string of string
|
||||||
| D_bytes of bytes
|
| D_bytes of bytes
|
||||||
| D_pair of value * value
|
| D_pair of value * value
|
||||||
|
@ -131,10 +131,10 @@ let literal ppf (l : literal) =
|
|||||||
| Literal_unit -> fprintf ppf "unit"
|
| Literal_unit -> fprintf ppf "unit"
|
||||||
| Literal_void -> fprintf ppf "void"
|
| Literal_void -> fprintf ppf "void"
|
||||||
| Literal_bool b -> fprintf ppf "%b" b
|
| Literal_bool b -> fprintf ppf "%b" b
|
||||||
| Literal_int n -> fprintf ppf "%d" n
|
| Literal_int z -> fprintf ppf "%a" Z.pp_print z
|
||||||
| Literal_nat n -> fprintf ppf "+%d" n
|
| Literal_nat z -> fprintf ppf "+%a" Z.pp_print z
|
||||||
| Literal_timestamp n -> fprintf ppf "+%d" n
|
| Literal_timestamp z -> fprintf ppf "+%a" Z.pp_print z
|
||||||
| Literal_mutez n -> fprintf ppf "%dmutez" n
|
| Literal_mutez z -> fprintf ppf "%amutez" Z.pp_print z
|
||||||
| Literal_string s -> fprintf ppf "%S" s
|
| Literal_string s -> fprintf ppf "%S" s
|
||||||
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
|
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
|
||||||
| Literal_address s -> fprintf ppf "@%S" s
|
| Literal_address s -> fprintf ppf "@%S" s
|
||||||
|
@ -163,10 +163,10 @@ end
|
|||||||
type literal =
|
type literal =
|
||||||
| Literal_unit
|
| Literal_unit
|
||||||
| Literal_bool of bool
|
| Literal_bool of bool
|
||||||
| Literal_int of int
|
| Literal_int of Z.t
|
||||||
| Literal_nat of int
|
| Literal_nat of Z.t
|
||||||
| Literal_timestamp of int
|
| Literal_timestamp of Z.t
|
||||||
| Literal_mutez of int
|
| Literal_mutez of Z.t
|
||||||
| Literal_string of string
|
| Literal_string of string
|
||||||
| Literal_bytes of bytes
|
| Literal_bytes of bytes
|
||||||
| Literal_address of string
|
| Literal_address of string
|
||||||
|
@ -1,14 +1,14 @@
|
|||||||
open Types
|
open Types
|
||||||
|
|
||||||
let rec pp_value : value -> string = function
|
let rec pp_value : value -> string = function
|
||||||
| V_Ct (C_int i) -> Format.asprintf "%i : int" i
|
| V_Ct (C_int i) -> Format.asprintf "%a : int" Z.pp_print i
|
||||||
| V_Ct (C_nat n) -> Format.asprintf "%i : nat" n
|
| V_Ct (C_nat n) -> Format.asprintf "%a : nat" Z.pp_print n
|
||||||
| V_Ct (C_string s) -> Format.asprintf "\"%s\" : string" s
|
| V_Ct (C_string s) -> Format.asprintf "\"%s\" : string" s
|
||||||
| V_Ct (C_unit) -> Format.asprintf "unit"
|
| V_Ct (C_unit) -> Format.asprintf "unit"
|
||||||
| V_Ct (C_bool true) -> Format.asprintf "true"
|
| V_Ct (C_bool true) -> Format.asprintf "true"
|
||||||
| V_Ct (C_bool false) -> Format.asprintf "false"
|
| V_Ct (C_bool false) -> Format.asprintf "false"
|
||||||
| V_Ct (C_bytes b) -> Format.asprintf "0x%a : bytes" Hex.pp (Hex.of_bytes b)
|
| V_Ct (C_bytes b) -> Format.asprintf "0x%a : bytes" Hex.pp (Hex.of_bytes b)
|
||||||
| V_Ct (C_mutez i) -> Format.asprintf "%i : mutez" i
|
| V_Ct (C_mutez i) -> Format.asprintf "%a : mutez" Z.pp_print i
|
||||||
| V_Ct (C_address s) -> Format.asprintf "\"%s\" : address" s
|
| V_Ct (C_address s) -> Format.asprintf "\"%s\" : address" s
|
||||||
| V_Ct _ -> Format.asprintf "PP, TODO"
|
| V_Ct _ -> Format.asprintf "PP, TODO"
|
||||||
| V_Failure s -> Format.asprintf "\"%s\" : failure " s
|
| V_Failure s -> Format.asprintf "\"%s\" : failure " s
|
||||||
|
@ -16,10 +16,10 @@ type env = value Env.t
|
|||||||
and constant_val =
|
and constant_val =
|
||||||
| C_unit
|
| C_unit
|
||||||
| C_bool of bool
|
| C_bool of bool
|
||||||
| C_int of int
|
| C_int of Z.t
|
||||||
| C_nat of int
|
| C_nat of Z.t
|
||||||
| C_timestamp of int
|
| C_timestamp of Z.t
|
||||||
| C_mutez of int
|
| C_mutez of Z.t
|
||||||
| C_string of string
|
| C_string of string
|
||||||
| C_bytes of bytes
|
| C_bytes of bytes
|
||||||
| C_address of string
|
| C_address of string
|
||||||
|
@ -8,7 +8,7 @@ module Simplified = Ast_core
|
|||||||
|
|
||||||
let int () : unit result =
|
let int () : unit result =
|
||||||
let open Combinators in
|
let open Combinators in
|
||||||
let pre = e_int 32 in
|
let pre = e_int (Z.of_int 32) in
|
||||||
let open Typer in
|
let open Typer in
|
||||||
let e = Environment.full_empty in
|
let e = Environment.full_empty in
|
||||||
let state = Typer.Solver.initial_state in
|
let state = Typer.Solver.initial_state in
|
||||||
@ -37,7 +37,7 @@ module TestExpressions = struct
|
|||||||
module E = O
|
module E = O
|
||||||
|
|
||||||
let unit () : unit result = test_expression I.(e_unit ()) O.(t_unit ())
|
let unit () : unit result = test_expression I.(e_unit ()) O.(t_unit ())
|
||||||
let int () : unit result = test_expression I.(e_int 32) O.(t_int ())
|
let int () : unit result = test_expression I.(e_int (Z.of_int 32)) O.(t_int ())
|
||||||
let bool () : unit result = test_expression I.(e_bool true) O.(t_bool ())
|
let bool () : unit result = test_expression I.(e_bool true) O.(t_bool ())
|
||||||
let string () : unit result = test_expression I.(e_string "s") O.(t_string ())
|
let string () : unit result = test_expression I.(e_string "s") O.(t_string ())
|
||||||
let bytes () : unit result =
|
let bytes () : unit result =
|
||||||
@ -51,7 +51,7 @@ module TestExpressions = struct
|
|||||||
|
|
||||||
let tuple () : unit result =
|
let tuple () : unit result =
|
||||||
test_expression
|
test_expression
|
||||||
I.(e_record @@ LMap.of_list [(Label "0",e_int 32); (Label "1",e_string "foo")])
|
I.(e_record @@ LMap.of_list [(Label "0",e_int (Z.of_int 32)); (Label "1",e_string "foo")])
|
||||||
O.(make_t_ez_record [("0",t_int ()); ("1",t_string ())])
|
O.(make_t_ez_record [("0",t_int ()); ("1",t_string ())])
|
||||||
|
|
||||||
let constructor () : unit result =
|
let constructor () : unit result =
|
||||||
@ -60,12 +60,12 @@ module TestExpressions = struct
|
|||||||
(Typed.Constructor "bar", {ctor_type = Typed.t_string () ; michelson_annotation = None}) ]
|
(Typed.Constructor "bar", {ctor_type = Typed.t_string () ; michelson_annotation = None}) ]
|
||||||
in test_expression
|
in test_expression
|
||||||
~env:(E.env_sum_type variant_foo_bar)
|
~env:(E.env_sum_type variant_foo_bar)
|
||||||
I.(e_constructor "foo" (e_int 32))
|
I.(e_constructor "foo" (e_int (Z.of_int 32)))
|
||||||
O.(make_t_ez_sum variant_foo_bar)
|
O.(make_t_ez_sum variant_foo_bar)
|
||||||
|
|
||||||
let record () : unit result =
|
let record () : unit result =
|
||||||
test_expression
|
test_expression
|
||||||
I.(e_record @@ LMap.of_list [(Label "foo", e_int 32); (Label "bar", e_string "foo")])
|
I.(e_record @@ LMap.of_list [(Label "foo", e_int (Z.of_int 32)); (Label "bar", e_string "foo")])
|
||||||
O.(make_t_ez_record [("foo", t_int ()); ("bar", t_string ())])
|
O.(make_t_ez_record [("foo", t_int ()); ("bar", t_string ())])
|
||||||
|
|
||||||
|
|
||||||
|
@ -45,7 +45,7 @@ let init_vote () =
|
|||||||
(* let votes = List.assoc (Label "voters") storage' in
|
(* let votes = List.assoc (Label "voters") storage' in
|
||||||
let%bind votes' = extract_map votes in *)
|
let%bind votes' = extract_map votes in *)
|
||||||
let yea = List.assoc (Label "yea") storage' in
|
let yea = List.assoc (Label "yea") storage' in
|
||||||
let%bind () = Ast_core.Misc.assert_value_eq (yea, Ast_core.e_nat 1) in
|
let%bind () = Ast_core.Misc.assert_value_eq (yea, Ast_core.e_nat Z.one) in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
let main = test_suite "Vote" [
|
let main = test_suite "Vote" [
|
||||||
|
Loading…
Reference in New Issue
Block a user