Merge branch 'fix/arbitrary_procesion_for_numerals' into 'dev'
Arbitrary Precission for numerals in Ligo See merge request ligolang/ligo!594
This commit is contained in:
commit
5c61bfaa95
@ -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_timestamp a') ; V_Ct (C_timestamp b') ] ) ->
|
||||
let f_op = match comp with
|
||||
| C_EQ -> Int.equal
|
||||
| C_NEQ -> fun a b -> not (Int.equal a b)
|
||||
| C_EQ -> Z.equal
|
||||
| C_NEQ -> fun a b -> not (Z.equal a b)
|
||||
| C_LT -> (<)
|
||||
| C_LE -> (<=)
|
||||
| C_GT -> (>)
|
||||
@ -68,17 +68,17 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
|
||||
raise (Temporary_hack a')
|
||||
(*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_Map l ] ) -> return_ct @@ C_nat (List.length l)
|
||||
| ( C_SIZE , [ V_Ct (C_string s ) ] ) -> return_ct @@ C_nat (String.length s)
|
||||
| ( C_SIZE , [ V_Ct (C_bytes b ) ] ) -> return_ct @@ C_nat (Bytes.length b)
|
||||
| ( 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 (Z.of_int @@ List.length l)
|
||||
| ( 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 (Z.of_int @@ Bytes.length b)
|
||||
| ( 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_ABS , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (abs a')
|
||||
| ( C_NEG , [ V_Ct (C_int a') ] ) -> return_ct @@ C_int (-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 (Z.neg a')
|
||||
| ( C_SOME , [ v ] ) -> return_some v
|
||||
| ( 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 ()
|
||||
| ( C_FOLD_CONTINUE , [ v ] ) -> ok @@ v_pair (v_bool true , 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 *)
|
||||
| ( (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_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_int b' ) ] ) -> return_ct @@ C_int (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_int b' ) ] ) -> return_ct @@ C_int (a' + b')
|
||||
| ( C_ADD , [ V_Ct (C_int a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_int (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_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (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_mutez a') ; V_Ct (C_mutez b') ] ) -> return_ct @@ C_mutez (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_nat a' ) ; V_Ct (C_nat b' ) ] ) -> return_ct @@ C_nat (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_mutez b') ] ) -> return_ct @@ C_nat (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_nat a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (a' mod 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_int a') ; V_Ct (C_nat b') ] ) -> return_ct @@ C_nat (a' mod 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 (Z.add 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 (Z.add 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 (Z.mul 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 (Z.mul 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 (Z.div 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 (Z.div a' 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 (Z.rem a' 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 (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_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')
|
||||
@ -161,7 +161,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
|
||||
(* tertiary *)
|
||||
| ( C_SLICE , [ V_Ct (C_nat st) ; V_Ct (C_nat ed) ; V_Ct (C_string s) ] ) ->
|
||||
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 ] ) ->
|
||||
bind_fold_list
|
||||
|
@ -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
|
||||
| D_bool b -> ok @@ prim (if b then D_True else D_False)
|
||||
| D_int n -> ok @@ int (Z.of_int n)
|
||||
| D_nat n -> ok @@ int (Z.of_int n)
|
||||
| D_timestamp n -> ok @@ int (Z.of_int n)
|
||||
| D_mutez n -> ok @@ int (Z.of_int n)
|
||||
| D_int n -> ok @@ int n
|
||||
| D_nat n -> ok @@ int n
|
||||
| D_timestamp n -> ok @@ int n
|
||||
| D_mutez n -> ok @@ int n
|
||||
| D_string s -> ok @@ string s
|
||||
| D_bytes s -> ok @@ bytes s
|
||||
| D_unit -> ok @@ prim D_Unit
|
||||
|
@ -22,14 +22,10 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result =
|
||||
ok @@ D_right b
|
||||
)
|
||||
| (Int_t _), n ->
|
||||
let%bind n =
|
||||
trace_option (simple_error "too big to fit an int") @@
|
||||
Alpha_context.Script_int.to_int n in
|
||||
let n = Alpha_context.Script_int.to_zint n in
|
||||
ok @@ D_int n
|
||||
| (Nat_t _), n ->
|
||||
let%bind n =
|
||||
trace_option (simple_error "too big to fit an int") @@
|
||||
Alpha_context.Script_int.to_int n in
|
||||
let n = Alpha_context.Script_int.to_zint n in
|
||||
ok @@ D_nat n
|
||||
| (Chain_id_t _), id ->
|
||||
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 ->
|
||||
ok @@ D_string (Signature.to_b58check n)
|
||||
| (Timestamp_t _), n ->
|
||||
let n =
|
||||
Z.to_int @@
|
||||
Alpha_context.Script_timestamp.to_zint n in
|
||||
let n = Alpha_context.Script_timestamp.to_zint n in
|
||||
ok @@ D_timestamp n
|
||||
| (Mutez_t _), n ->
|
||||
let%bind n =
|
||||
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
|
||||
| (Bool_t _), b ->
|
||||
ok @@ D_bool b
|
||||
|
@ -565,17 +565,17 @@ let rec compile_expression :
|
||||
compile_binop "MOD" c
|
||||
| EArith (Int n) -> (
|
||||
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)
|
||||
)
|
||||
| EArith (Nat n) -> (
|
||||
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)
|
||||
)
|
||||
| EArith (Mutez n) -> (
|
||||
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)
|
||||
)
|
||||
| EArith (Neg e) -> compile_unop "NEG" e
|
||||
|
@ -364,17 +364,17 @@ let rec compile_expression (t:Raw.expr) : expr result =
|
||||
compile_binop "MOD" c
|
||||
| EArith (Int n) -> (
|
||||
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)
|
||||
)
|
||||
| EArith (Nat n) -> (
|
||||
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)
|
||||
)
|
||||
| EArith (Mutez n) -> (
|
||||
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)
|
||||
)
|
||||
| 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 bound = compile_expression fi.bound in
|
||||
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
|
||||
let%bind body = compile_block fi.block.value in
|
||||
let%bind body = body @@ None in
|
||||
|
@ -25,7 +25,7 @@ let peephole_expression : expression -> expression result = fun e ->
|
||||
let%bind time =
|
||||
trace_option (bad_string_timestamp str e'.location)
|
||||
@@ 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)
|
||||
| (E_literal (Literal_string str) , T_constant (TC_address)) -> return @@ E_literal (Literal_address str)
|
||||
| (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_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_nat ?loc n : expression = make_e ?loc @@ E_literal (Literal_nat n)
|
||||
let e_timestamp ?loc n : expression = make_e ?loc @@ E_literal (Literal_timestamp n)
|
||||
let e_int_z ?loc n : expression = make_e ?loc @@ E_literal (Literal_int n)
|
||||
let e_int ?loc n : expression = e_int_z ?loc @@ Z.of_int 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_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_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_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)
|
||||
|
@ -54,6 +54,9 @@ val make_e : ?loc:Location.t -> expression_content -> expression
|
||||
|
||||
val e_literal : ?loc:Location.t -> literal -> 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_nat : ?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_hash : ?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'_bytes : string -> expression_content 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 e_literal : ?loc:Location.t -> literal -> expression
|
||||
val e_unit : ?loc:Location.t -> unit -> expression
|
||||
val e_int : ?loc:Location.t -> int -> expression
|
||||
val e_nat : ?loc:Location.t -> int -> expression
|
||||
val e_timestamp : ?loc:Location.t -> int -> expression
|
||||
val e_int : ?loc:Location.t -> Z.t -> expression
|
||||
val e_nat : ?loc:Location.t -> Z.t -> expression
|
||||
val e_timestamp : ?loc:Location.t -> Z.t -> expression
|
||||
val e_bool : ?loc:Location.t -> bool -> expression
|
||||
val e_string : ?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_hash : ?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_hex : ?loc:Location.t -> string -> expression result
|
||||
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_literal : ?loc:Location.t -> literal -> expression
|
||||
val e_unit : ?loc:Location.t -> unit -> expression
|
||||
val e_int : ?loc:Location.t -> int -> expression
|
||||
val e_nat : ?loc:Location.t -> int -> expression
|
||||
val e_timestamp : ?loc:Location.t -> int -> expression
|
||||
val e_int : ?loc:Location.t -> Z.t -> expression
|
||||
val e_nat : ?loc:Location.t -> Z.t -> expression
|
||||
val e_timestamp : ?loc:Location.t -> Z.t -> expression
|
||||
val e_bool : ?loc:Location.t -> bool -> expression
|
||||
val e_string : ?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_hash : ?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_hex : ?loc:Location.t -> string -> expression result
|
||||
val e_bytes_raw : ?loc:Location.t -> bytes -> expression
|
||||
|
@ -181,10 +181,10 @@ let literal ppf (l : literal) =
|
||||
| Literal_unit -> fprintf ppf "unit"
|
||||
| Literal_void -> fprintf ppf "void"
|
||||
| Literal_bool b -> fprintf ppf "%b" b
|
||||
| Literal_int n -> fprintf ppf "%d" n
|
||||
| Literal_nat n -> fprintf ppf "+%d" n
|
||||
| Literal_timestamp n -> fprintf ppf "+%d" n
|
||||
| Literal_mutez n -> fprintf ppf "%dmutez" n
|
||||
| Literal_int z -> fprintf ppf "%a" Z.pp_print z
|
||||
| Literal_nat z -> fprintf ppf "+%a" Z.pp_print z
|
||||
| Literal_timestamp z -> fprintf ppf "+%a" Z.pp_print z
|
||||
| Literal_mutez z -> fprintf ppf "%amutez" Z.pp_print z
|
||||
| Literal_string s -> fprintf ppf "%S" s
|
||||
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
|
||||
| Literal_address s -> fprintf ppf "@%S" s
|
||||
|
@ -12,7 +12,7 @@ let needs_parens = {
|
||||
);
|
||||
type_variable = (fun _ _ _ -> false) ;
|
||||
bool = (fun _ _ _ -> false) ;
|
||||
int = (fun _ _ _ -> false) ;
|
||||
z = (fun _ _ _ -> false) ;
|
||||
string = (fun _ _ _ -> false) ;
|
||||
bytes = (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) ;
|
||||
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) ;
|
||||
bytes = (fun _visitor () _bytes -> fprintf ppf "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_none : unit -> expression_content
|
||||
val e_unit : unit -> expression_content
|
||||
val e_int : int -> expression_content
|
||||
val e_nat : int -> expression_content
|
||||
val e_mutez : int -> expression_content
|
||||
val e_int : Z.t -> expression_content
|
||||
val e_nat : Z.t -> expression_content
|
||||
val e_mutez : Z.t -> expression_content
|
||||
val e_bool : bool -> expression_content
|
||||
val e_string : string -> 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_signature : 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_a_unit : full_environment -> expression
|
||||
val e_a_int : int -> full_environment -> expression
|
||||
val e_a_nat : int -> full_environment -> expression
|
||||
val e_a_mutez : int -> full_environment -> expression
|
||||
val e_a_int : Z.t -> full_environment -> expression
|
||||
val e_a_nat : Z.t -> full_environment -> expression
|
||||
val e_a_mutez : Z.t -> full_environment -> expression
|
||||
val e_a_bool : bool -> full_environment -> expression
|
||||
val e_a_string : 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 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_bool : expression -> bool 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 e_a_empty_unit : expression
|
||||
val e_a_empty_int : int -> expression
|
||||
val e_a_empty_nat : int -> expression
|
||||
val e_a_empty_mutez : int -> expression
|
||||
val e_a_empty_int : Z.t -> expression
|
||||
val e_a_empty_nat : Z.t -> expression
|
||||
val e_a_empty_mutez : Z.t -> expression
|
||||
val e_a_empty_bool : bool -> expression
|
||||
val e_a_empty_string : string -> expression
|
||||
val e_a_empty_address : string -> expression
|
||||
|
@ -78,10 +78,10 @@ and type_expression = {
|
||||
type literal =
|
||||
| Literal_unit
|
||||
| Literal_bool of bool
|
||||
| Literal_int of int
|
||||
| Literal_nat of int
|
||||
| Literal_timestamp of int
|
||||
| Literal_mutez of int
|
||||
| Literal_int of z
|
||||
| Literal_nat of z
|
||||
| Literal_timestamp of z
|
||||
| Literal_mutez of z
|
||||
| Literal_string of string
|
||||
| Literal_bytes of bytes
|
||||
| Literal_address of string
|
||||
|
@ -10,6 +10,7 @@ type expression_ = Stage_common.Types.expression_
|
||||
type expression_variable = Stage_common.Types.expression_variable
|
||||
type type_ = Stage_common.Types.type_
|
||||
type type_variable = Stage_common.Types.type_variable
|
||||
type z = Z.t
|
||||
|
||||
type constructor' =
|
||||
| Constructor of string
|
||||
|
@ -52,10 +52,10 @@ and type_constant ppf (tc:type_constant) : unit =
|
||||
let rec value ppf : value -> unit = function
|
||||
| D_bool b -> fprintf ppf "%b" b
|
||||
| D_operation _ -> fprintf ppf "operation[...bytes]"
|
||||
| D_int n -> fprintf ppf "%d" n
|
||||
| D_nat n -> fprintf ppf "+%d" n
|
||||
| D_timestamp n -> fprintf ppf "+%d" n
|
||||
| D_mutez n -> fprintf ppf "%dmutez" n
|
||||
| D_int n -> fprintf ppf "%a" Z.pp_print n
|
||||
| D_nat n -> fprintf ppf "+%a" Z.pp_print n
|
||||
| D_timestamp n -> fprintf ppf "+%a" Z.pp_print n
|
||||
| D_mutez n -> fprintf ppf "%amutez" Z.pp_print n
|
||||
| D_unit -> fprintf ppf "unit"
|
||||
| D_string s -> fprintf ppf "\"%s\"" s
|
||||
| D_bytes x ->
|
||||
|
@ -17,10 +17,10 @@ module Expression : sig
|
||||
end
|
||||
|
||||
val get_bool : value ->bool result
|
||||
val get_int : value -> int result
|
||||
val get_nat : value -> int result
|
||||
val get_mutez : value -> int result
|
||||
val get_timestamp : value -> int result
|
||||
val get_int : value -> Z.t result
|
||||
val get_nat : value -> Z.t result
|
||||
val get_mutez : value -> Z.t result
|
||||
val get_timestamp : value -> Z.t result
|
||||
val get_string : value -> string result
|
||||
val get_bytes : value -> bytes result
|
||||
val get_unit : value -> unit result
|
||||
|
@ -32,10 +32,10 @@ type inline = bool
|
||||
type value =
|
||||
| D_unit
|
||||
| D_bool of bool
|
||||
| D_nat of int
|
||||
| D_timestamp of int
|
||||
| D_mutez of int
|
||||
| D_int of int
|
||||
| D_nat of Z.t
|
||||
| D_timestamp of Z.t
|
||||
| D_mutez of Z.t
|
||||
| D_int of Z.t
|
||||
| D_string of string
|
||||
| D_bytes of bytes
|
||||
| D_pair of value * value
|
||||
|
@ -131,10 +131,10 @@ let literal ppf (l : literal) =
|
||||
| Literal_unit -> fprintf ppf "unit"
|
||||
| Literal_void -> fprintf ppf "void"
|
||||
| Literal_bool b -> fprintf ppf "%b" b
|
||||
| Literal_int n -> fprintf ppf "%d" n
|
||||
| Literal_nat n -> fprintf ppf "+%d" n
|
||||
| Literal_timestamp n -> fprintf ppf "+%d" n
|
||||
| Literal_mutez n -> fprintf ppf "%dmutez" n
|
||||
| Literal_int z -> fprintf ppf "%a" Z.pp_print z
|
||||
| Literal_nat z -> fprintf ppf "+%a" Z.pp_print z
|
||||
| Literal_timestamp z -> fprintf ppf "+%a" Z.pp_print z
|
||||
| Literal_mutez z -> fprintf ppf "%amutez" Z.pp_print z
|
||||
| Literal_string s -> fprintf ppf "%S" s
|
||||
| Literal_bytes b -> fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
|
||||
| Literal_address s -> fprintf ppf "@%S" s
|
||||
|
@ -163,10 +163,10 @@ end
|
||||
type literal =
|
||||
| Literal_unit
|
||||
| Literal_bool of bool
|
||||
| Literal_int of int
|
||||
| Literal_nat of int
|
||||
| Literal_timestamp of int
|
||||
| Literal_mutez of int
|
||||
| Literal_int of Z.t
|
||||
| Literal_nat of Z.t
|
||||
| Literal_timestamp of Z.t
|
||||
| Literal_mutez of Z.t
|
||||
| Literal_string of string
|
||||
| Literal_bytes of bytes
|
||||
| Literal_address of string
|
||||
|
@ -1,14 +1,14 @@
|
||||
open Types
|
||||
|
||||
let rec pp_value : value -> string = function
|
||||
| V_Ct (C_int i) -> Format.asprintf "%i : int" i
|
||||
| V_Ct (C_nat n) -> Format.asprintf "%i : nat" n
|
||||
| V_Ct (C_int i) -> Format.asprintf "%a : int" Z.pp_print i
|
||||
| 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_unit) -> Format.asprintf "unit"
|
||||
| V_Ct (C_bool true) -> Format.asprintf "true"
|
||||
| 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_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 _ -> Format.asprintf "PP, TODO"
|
||||
| V_Failure s -> Format.asprintf "\"%s\" : failure " s
|
||||
|
@ -16,10 +16,10 @@ type env = value Env.t
|
||||
and constant_val =
|
||||
| C_unit
|
||||
| C_bool of bool
|
||||
| C_int of int
|
||||
| C_nat of int
|
||||
| C_timestamp of int
|
||||
| C_mutez of int
|
||||
| C_int of Z.t
|
||||
| C_nat of Z.t
|
||||
| C_timestamp of Z.t
|
||||
| C_mutez of Z.t
|
||||
| C_string of string
|
||||
| C_bytes of bytes
|
||||
| C_address of string
|
||||
|
@ -8,7 +8,7 @@ module Simplified = Ast_core
|
||||
|
||||
let int () : unit result =
|
||||
let open Combinators in
|
||||
let pre = e_int 32 in
|
||||
let pre = e_int (Z.of_int 32) in
|
||||
let open Typer in
|
||||
let e = Environment.full_empty in
|
||||
let state = Typer.Solver.initial_state in
|
||||
@ -37,7 +37,7 @@ module TestExpressions = struct
|
||||
module E = O
|
||||
|
||||
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 string () : unit result = test_expression I.(e_string "s") O.(t_string ())
|
||||
let bytes () : unit result =
|
||||
@ -51,7 +51,7 @@ module TestExpressions = struct
|
||||
|
||||
let tuple () : unit result =
|
||||
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 ())])
|
||||
|
||||
let constructor () : unit result =
|
||||
@ -60,12 +60,12 @@ module TestExpressions = struct
|
||||
(Typed.Constructor "bar", {ctor_type = Typed.t_string () ; michelson_annotation = None}) ]
|
||||
in test_expression
|
||||
~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)
|
||||
|
||||
let record () : unit result =
|
||||
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 ())])
|
||||
|
||||
|
||||
|
@ -45,7 +45,7 @@ let init_vote () =
|
||||
(* let votes = List.assoc (Label "voters") storage' in
|
||||
let%bind votes' = extract_map votes 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 ()
|
||||
|
||||
let main = test_suite "Vote" [
|
||||
|
Loading…
Reference in New Issue
Block a user