balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'dev' of gitlab.com:ligolang/ligo into rinderknecht@michelson

Browse Source
This commit is contained in:
Christian Rinderknecht 2020-04-28 19:26:39 +02:00
commit de7864a500
27 changed files with 1295 additions and 920 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1944
src/bin/expect_tests/contract_tests.ml
View File

File diff suppressed because it is too large Load Diff

54
src/passes/10-interpreter/interpreter.ml
View File

@ -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

15
src/passes/12-compiler/compiler_environment.ml
View File

@ -15,22 +15,15 @@ let get : environment -> expression_variable -> michelson result = fun e s ->
error title content in
generic_try error @@
(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 [
dipn n i_dup ;
i_dig n ;
i_dup ;
i_dug (n + 1) ;
]
in
let code =
if position < 2
then aux_bubble position
if position < 1
then i_dup
else aux_dig position in
ok code

31
src/passes/12-compiler/compiler_program.ml
View File

@ -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
@ -251,11 +251,12 @@ and translate_expression (expr:expression) (env:environment) : michelson result
)
| E_application (f , arg) -> (
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
return @@ seq [
arg ;
dip f ;
f ;
i_swap ;
prim I_EXEC ;
]
)
@ -273,15 +274,18 @@ and translate_expression (expr:expression) (env:environment) : michelson result
)
| E_constant{cons_name=str;arguments= lst} ->
let module L = Logger.Stateful() in
let%bind pre_code =
let aux code expr =
let%bind (pre_code, _env) =
let aux (code, env) expr =
let%bind expr_code = translate_expression expr env in
L.log @@ Format.asprintf "\n%a -> %a in %a\n"
PP.expression expr
Michelson.pp expr_code
PP.environment env ;
ok (seq [ expr_code ; dip code ]) in
bind_fold_right_list aux (seq []) lst in
let env = Environment.add (Var.fresh (), expr.type_value) env 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 code = match (predicate, List.length lst) with
| Constant c, 0 -> ok @@ seq [
@ -426,12 +430,15 @@ and translate_expression (expr:expression) (env:environment) : michelson result
)
)
| 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 body' = translate_expression body (Environment.add v env) in
let code = seq [
initial' ;
collection' ;
dip initial' ;
i_iter (seq [
i_swap ;
i_pair ; body' ; dip i_drop ;

14
src/passes/12-compiler/uncompiler.ml
View File

@ -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

6
src/passes/2-concrete_to_imperative/cameligo.ml
View File

@ -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

8
src/passes/2-concrete_to_imperative/pascaligo.ml
View File

@ -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

2
src/passes/3-self_ast_imperative/tezos_type_annotation.ml
View File

@ -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)) -> (

12
src/stages/1-ast_imperative/combinators.ml
View File

@ -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)

4
src/stages/1-ast_imperative/combinators.mli
View File

@ -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

8
src/stages/2-ast_sugar/combinators.mli
View File

@ -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

8
src/stages/3-ast_core/combinators.mli
View File

@ -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

8
src/stages/4-ast_typed/PP.ml
View File

@ -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

4
src/stages/4-ast_typed/PP_generic.ml
View File

@ -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)") ;

16
src/stages/4-ast_typed/combinators.mli
View File

@ -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

6
src/stages/4-ast_typed/combinators_environment.mli
View File

@ -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

8
src/stages/4-ast_typed/types.ml
View File

@ -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

1
src/stages/4-ast_typed/types_utils.ml
View File

@ -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

8
src/stages/5-mini_c/PP.ml
View File

@ -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 ->

8
src/stages/5-mini_c/combinators.mli
View File

@ -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

8
src/stages/5-mini_c/types.ml
View File

@ -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

8
src/stages/common/PP.ml
View File

@ -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

8
src/stages/common/types.ml
View File

@ -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

6
src/stages/ligo_interpreter/PP.ml
View File

@ -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

8
src/stages/ligo_interpreter/types.ml
View File

@ -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

10
src/test/typer_tests.ml
View File

@ -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 ())])

2
src/test/vote_tests.ml
View File

@ -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" [