From e6ac10f0ce5229b776ac11f96b2b64b9558500d3 Mon Sep 17 00:00:00 2001 From: galfour Date: Tue, 24 Sep 2019 14:29:18 +0200 Subject: [PATCH] switch from tz to mtz --- src/passes/2-simplify/ligodity.ml | 2 +- src/passes/2-simplify/pascaligo.ml | 2 +- src/passes/4-typer/typer.ml | 6 +++--- src/passes/6-transpiler/transpiler.ml | 2 +- src/passes/6-transpiler/untranspiler.ml | 4 ++-- src/passes/8-compiler/compiler_program.ml | 2 +- src/passes/8-compiler/uncompiler.ml | 2 +- src/passes/operators/operators.ml | 18 +++++++++++++++--- src/stages/ast_simplified/PP.ml | 2 +- src/stages/ast_simplified/combinators.ml | 2 +- src/stages/ast_simplified/misc.ml | 6 +++--- src/stages/ast_simplified/types.ml | 2 +- src/stages/ast_typed/PP.ml | 2 +- src/stages/ast_typed/combinators.ml | 4 ++-- .../ast_typed/combinators_environment.ml | 2 +- src/stages/ast_typed/misc.ml | 6 +++--- src/stages/ast_typed/types.ml | 2 +- src/stages/mini_c/PP.ml | 2 +- src/stages/mini_c/combinators.ml | 4 ++++ src/stages/mini_c/types.ml | 2 +- src/test/coase_tests.ml | 2 +- src/test/contracts/map.ligo | 5 +++++ src/test/contracts/map.mligo | 2 ++ src/test/integration_tests.ml | 6 ++++++ 24 files changed, 59 insertions(+), 30 deletions(-) diff --git a/src/passes/2-simplify/ligodity.ml b/src/passes/2-simplify/ligodity.ml index 3a1fe5132..879579e9f 100644 --- a/src/passes/2-simplify/ligodity.ml +++ b/src/passes/2-simplify/ligodity.ml @@ -434,7 +434,7 @@ let rec simpl_expression : | EArith (Mtz n) -> ( let (n , loc) = r_split n in let n = Z.to_int @@ snd @@ n in - return @@ e_literal ~loc (Literal_tez n) + return @@ e_literal ~loc (Literal_mutez n) ) | EArith _ as e -> fail @@ unsupported_arith_op e diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 0a6fe63d3..5380e9f0e 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -500,7 +500,7 @@ let rec simpl_expression (t:Raw.expr) : expr result = | EArith (Mtz n) -> ( let (n , loc) = r_split n in let n = Z.to_int @@ snd @@ n in - return @@ e_literal ~loc (Literal_tez n) + return @@ e_literal ~loc (Literal_mutez n) ) | EArith (Neg e) -> simpl_unop "NEG" e | EString (String s) -> diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 2cacd1629..5c87cfe62 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -416,8 +416,8 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a return (E_literal (Literal_nat n)) (t_nat ()) | E_literal (Literal_timestamp n) -> return (E_literal (Literal_timestamp n)) (t_timestamp ()) - | E_literal (Literal_tez n) -> - return (E_literal (Literal_tez n)) (t_tez ()) + | E_literal (Literal_mutez n) -> + return (E_literal (Literal_mutez n)) (t_tez ()) | E_literal (Literal_address s) -> return (e_address s) (t_address ()) | E_literal (Literal_operation op) -> @@ -803,7 +803,7 @@ let untype_literal (l:O.literal) : I.literal result = | Literal_bool b -> ok (Literal_bool b) | Literal_nat n -> ok (Literal_nat n) | Literal_timestamp n -> ok (Literal_timestamp n) - | Literal_tez n -> ok (Literal_tez n) + | Literal_mutez n -> ok (Literal_mutez n) | Literal_int n -> ok (Literal_int n) | Literal_string s -> ok (Literal_string s) | Literal_bytes b -> ok (Literal_bytes b) diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index fc71afebb..ef3207d2b 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -204,7 +204,7 @@ let rec transpile_literal : AST.literal -> value = fun l -> match l with | Literal_int n -> D_int n | Literal_nat n -> D_nat n | Literal_timestamp n -> D_timestamp n - | Literal_tez n -> D_tez n + | Literal_mutez n -> D_mutez n | Literal_bytes s -> D_bytes s | Literal_string s -> D_string s | Literal_address s -> D_string s diff --git a/src/passes/6-transpiler/untranspiler.ml b/src/passes/6-transpiler/untranspiler.ml index 6c0309bd3..78c41cca8 100644 --- a/src/passes/6-transpiler/untranspiler.ml +++ b/src/passes/6-transpiler/untranspiler.ml @@ -86,8 +86,8 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression | T_constant ("tez", []) -> ( let%bind n = trace_strong (wrong_mini_c_value "tez" v) @@ - get_nat v in - return (E_literal (Literal_tez n)) + get_mutez v in + return (E_literal (Literal_mutez n)) ) | T_constant ("string", []) -> ( let%bind n = diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 783b1d6ad..ef3d19395 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -66,7 +66,7 @@ let rec translate_value (v:value) ty : michelson result = match v with | 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_tez n -> ok @@ int (Z.of_int n) + | D_mutez n -> ok @@ int (Z.of_int n) | D_string s -> ok @@ string s | D_bytes s -> ok @@ bytes (Tezos_stdlib.MBytes.of_bytes s) | D_unit -> ok @@ prim D_Unit diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml index 2838298d3..310d3a72f 100644 --- a/src/passes/8-compiler/uncompiler.ml +++ b/src/passes/8-compiler/uncompiler.ml @@ -40,7 +40,7 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result = let%bind n = generic_try (simple_error "too big to fit an int") @@ (fun () -> Int64.to_int @@ Alpha_context.Tez.to_mutez n) in - ok @@ D_nat n + ok @@ D_mutez n | (Bool_t _), b -> ok @@ D_bool b | (String_t _), s -> diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 335cd53d0..75b940e22 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -88,6 +88,9 @@ module Simplify = struct ("map_iter" , "MAP_ITER") ; ("map_map" , "MAP_MAP") ; ("map_fold" , "MAP_FOLD") ; + ("map_remove" , "MAP_REMOVE") ; + ("map_update" , "MAP_UPDATE") ; + ("map_get" , "MAP_GET") ; ("sha_256" , "SHA256") ; ("sha_512" , "SHA512") ; ("blake2b" , "BLAKE2b") ; @@ -270,7 +273,9 @@ module Typer = struct ok @@ t_bool () let map_find : typer = typer_2 "MAP_FIND" @@ fun k m -> - let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in + let%bind (src, dst) = + trace_strong (simple_error "MAP_FIND: not map or bigmap") @@ + bind_map_or (get_t_map , get_t_big_map) m in let%bind () = assert_type_value_eq (src, k) in ok @@ dst @@ -313,11 +318,16 @@ module Typer = struct (is_t_string t) in ok @@ t_unit () - let get_force = typer_2 "MAP_GET_FORCE" @@ fun i m -> + let map_get_force = typer_2 "MAP_GET_FORCE" @@ fun i m -> let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in let%bind _ = assert_type_value_eq (src, i) in ok dst + let map_get = typer_2 "MAP_GET" @@ fun i m -> + let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in + let%bind _ = assert_type_value_eq (src, i) in + ok @@ t_option dst () + let int : typer = typer_1 "INT" @@ fun t -> let%bind () = assert_t_nat t in ok @@ t_int () @@ -607,6 +617,8 @@ module Typer = struct map_map ; map_fold ; map_iter ; + map_get_force ; + map_get ; set_empty ; set_mem ; set_add ; @@ -619,7 +631,6 @@ module Typer = struct int ; size ; failwith_ ; - get_force ; bytes_pack ; bytes_unpack ; hash256 ; @@ -687,6 +698,7 @@ module Compiler = struct ("MAP_GET_FORCE" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "GET_FORCE")]) ; ("MAP_FIND" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "MAP FIND")]) ; ("MAP_GET" , simple_binary @@ prim I_GET) ; + ("MAP_FIND_OPT" , simple_binary @@ prim I_GET) ; ("MAP_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE]) ; ("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ; ("SIZE" , simple_unary @@ prim I_SIZE) ; diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index 6ddef98c6..1fb7cb18e 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/src/stages/ast_simplified/PP.ml @@ -25,7 +25,7 @@ let literal ppf (l:literal) = match l with | Literal_int n -> fprintf ppf "%d" n | Literal_nat n -> fprintf ppf "+%d" n | Literal_timestamp n -> fprintf ppf "+%d" n - | Literal_tez n -> fprintf ppf "%dtz" n + | Literal_mutez n -> fprintf ppf "%dmtz" n | Literal_string s -> fprintf ppf "%S" s | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_address s -> fprintf ppf "@%S" s diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index 99f0f3af5..0890365d1 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/src/stages/ast_simplified/combinators.ml @@ -61,7 +61,7 @@ let e_timestamp ?loc n : expression = location_wrap ?loc @@ E_literal (Literal_t let e_bool ?loc b : expression = location_wrap ?loc @@ E_literal (Literal_bool b) let e_string ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_string s) let e_address ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_address s) -let e_tez ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_tez s) +let e_mutez ?loc s : expression = location_wrap ?loc @@ E_literal (Literal_mutez s) let e'_bytes b : expression' result = let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in ok @@ E_literal (Literal_bytes bytes) diff --git a/src/stages/ast_simplified/misc.ml b/src/stages/ast_simplified/misc.ml index 9484b1f09..ec9044c8a 100644 --- a/src/stages/ast_simplified/misc.ml +++ b/src/stages/ast_simplified/misc.ml @@ -45,9 +45,9 @@ let assert_literal_eq (a, b : literal * literal) : unit result = | Literal_timestamp a, Literal_timestamp b when a = b -> ok () | Literal_timestamp _, Literal_timestamp _ -> fail @@ different_literals "different timestamps" a b | Literal_timestamp _, _ -> fail @@ different_literals_because_different_types "timestamp vs non-timestamp" a b - | Literal_tez a, Literal_tez b when a = b -> ok () - | Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b - | Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b + | Literal_mutez a, Literal_mutez b when a = b -> ok () + | Literal_mutez _, Literal_mutez _ -> fail @@ different_literals "different tezs" a b + | Literal_mutez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b | Literal_string a, Literal_string b when a = b -> ok () | Literal_string _, Literal_string _ -> fail @@ different_literals "different strings" a b | Literal_string _, _ -> fail @@ different_literals_because_different_types "string vs non-string" a b diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index 1ca2a19cf..ea42d849d 100644 --- a/src/stages/ast_simplified/types.ml +++ b/src/stages/ast_simplified/types.ml @@ -91,7 +91,7 @@ and literal = | Literal_bool of bool | Literal_int of int | Literal_nat of int - | Literal_tez of int + | Literal_mutez of int | Literal_string of string | Literal_bytes of bytes | Literal_address of string diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index 9af3eb49a..96825ecc3 100644 --- a/src/stages/ast_typed/PP.ml +++ b/src/stages/ast_typed/PP.ml @@ -70,7 +70,7 @@ and literal ppf (l:literal) : unit = | Literal_int n -> fprintf ppf "%d" n | Literal_nat n -> fprintf ppf "+%d" n | Literal_timestamp n -> fprintf ppf "+%d" n - | Literal_tez n -> fprintf ppf "%dtz" n + | Literal_mutez n -> fprintf ppf "%dmtz" n | Literal_string s -> fprintf ppf "%s" s | Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b | Literal_address s -> fprintf ppf "@%s" s diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index 1f4047d5b..d9dcebb73 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -232,7 +232,7 @@ let e_map lst : expression = E_map lst let e_unit : expression = E_literal (Literal_unit) let e_int n : expression = E_literal (Literal_int n) let e_nat n : expression = E_literal (Literal_nat n) -let e_tez n : expression = E_literal (Literal_tez n) +let e_mutez n : expression = E_literal (Literal_mutez n) let e_bool b : expression = E_literal (Literal_bool b) let e_string s : expression = E_literal (Literal_string s) let e_address s : expression = E_literal (Literal_address s) @@ -247,7 +247,7 @@ let e_let_in binder rhs result = E_let_in { binder ; rhs ; result } let e_a_unit = make_a_e e_unit (t_unit ()) let e_a_int n = make_a_e (e_int n) (t_int ()) let e_a_nat n = make_a_e (e_nat n) (t_nat ()) -let e_a_tez n = make_a_e (e_tez n) (t_tez ()) +let e_a_mutez n = make_a_e (e_mutez n) (t_tez ()) let e_a_bool b = make_a_e (e_bool b) (t_bool ()) let e_a_string s = make_a_e (e_string s) (t_string ()) let e_a_address s = make_a_e (e_address s) (t_address ()) diff --git a/src/stages/ast_typed/combinators_environment.ml b/src/stages/ast_typed/combinators_environment.ml index 4c41f7296..1446c8780 100644 --- a/src/stages/ast_typed/combinators_environment.ml +++ b/src/stages/ast_typed/combinators_environment.ml @@ -6,7 +6,7 @@ let make_a_e_empty expression type_annotation = make_a_e expression type_annotat let e_a_empty_unit = e_a_unit Environment.full_empty let e_a_empty_int n = e_a_int n Environment.full_empty let e_a_empty_nat n = e_a_nat n Environment.full_empty -let e_a_empty_tez n = e_a_tez n Environment.full_empty +let e_a_empty_mutez n = e_a_mutez n Environment.full_empty let e_a_empty_bool b = e_a_bool b Environment.full_empty let e_a_empty_string s = e_a_string s Environment.full_empty let e_a_empty_address s = e_a_address s Environment.full_empty diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index 39b437060..5aaf28550 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -365,9 +365,9 @@ let assert_literal_eq (a, b : literal * literal) : unit result = | Literal_timestamp a, Literal_timestamp b when a = b -> ok () | Literal_timestamp _, Literal_timestamp _ -> fail @@ different_literals "different timestamps" a b | Literal_timestamp _, _ -> fail @@ different_literals_because_different_types "timestamp vs non-timestamp" a b - | Literal_tez a, Literal_tez b when a = b -> ok () - | Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b - | Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b + | Literal_mutez a, Literal_mutez b when a = b -> ok () + | Literal_mutez _, Literal_mutez _ -> fail @@ different_literals "different tezs" a b + | Literal_mutez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" a b | Literal_string a, Literal_string b when a = b -> ok () | Literal_string _, Literal_string _ -> fail @@ different_literals "different strings" a b | Literal_string _, _ -> fail @@ different_literals_because_different_types "string vs non-string" a b diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index ce5627086..fc297b593 100644 --- a/src/stages/ast_typed/types.ml +++ b/src/stages/ast_typed/types.ml @@ -119,7 +119,7 @@ and literal = | Literal_int of int | Literal_nat of int | Literal_timestamp of int - | Literal_tez of int + | Literal_mutez of int | Literal_string of string | Literal_bytes of bytes | Literal_address of string diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index d35d38b64..660006521 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -49,7 +49,7 @@ let rec value ppf : value -> unit = function | D_int n -> fprintf ppf "%d" n | D_nat n -> fprintf ppf "+%d" n | D_timestamp n -> fprintf ppf "+%d" n - | D_tez n -> fprintf ppf "%dtz" n + | D_mutez n -> fprintf ppf "%dmtz" n | D_unit -> fprintf ppf "unit" | D_string s -> fprintf ppf "\"%s\"" s | D_bytes x -> diff --git a/src/stages/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml index 074d66618..094d91928 100644 --- a/src/stages/mini_c/combinators.ml +++ b/src/stages/mini_c/combinators.ml @@ -34,6 +34,10 @@ let get_nat (v:value) = match v with | D_nat n -> ok n | _ -> simple_fail "not a nat" +let get_mutez (v:value) = match v with + | D_mutez n -> ok n + | _ -> simple_fail "not a mutez" + let get_timestamp (v:value) = match v with | D_timestamp n -> ok n | _ -> simple_fail "not a timestamp" diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index b2c7a2499..a0a367409 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -38,7 +38,7 @@ type value = | D_bool of bool | D_nat of int | D_timestamp of int - | D_tez of int + | D_mutez of int | D_int of int | D_string of string | D_bytes of bytes diff --git a/src/test/coase_tests.ml b/src/test/coase_tests.ml index 7b7b38ae8..967130f3d 100644 --- a/src/test/coase_tests.ml +++ b/src/test/coase_tests.ml @@ -47,7 +47,7 @@ let card_pattern_ty = ] let card_pattern_ez (coeff , qtt) = - card_pattern (e_tez coeff , e_nat qtt) + card_pattern (e_mutez coeff , e_nat qtt) let make_card_patterns lst = let card_pattern_id_ty = t_nat in diff --git a/src/test/contracts/map.ligo b/src/test/contracts/map.ligo index 722412603..dd6770077 100644 --- a/src/test/contracts/map.ligo +++ b/src/test/contracts/map.ligo @@ -26,6 +26,11 @@ function get (const m : foobar) : option(int) is skip end with m[42] +function get_ (const m : foobar) : option(int) is + begin + skip + end with map_get(42 , m) + const bm : foobar = map 144 -> 23 ; 51 -> 23 ; diff --git a/src/test/contracts/map.mligo b/src/test/contracts/map.mligo index 7317dc6b8..375a69507 100644 --- a/src/test/contracts/map.mligo +++ b/src/test/contracts/map.mligo @@ -3,3 +3,5 @@ type foobar = (int , int) map let foobar : foobar = Map.empty let foobarz : foobar = Map.literal [ (1 , 10) ; (2 , 20) ] + +let foo : int = Map.find 1 foobarz diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 93aac4e01..5e8008999 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -363,6 +363,7 @@ let mmap () : unit result = (e_annotation (e_map []) (t_map t_int t_int)) in let%bind () = expect_eq_evaluate program "foobarz" (e_annotation (e_map [(e_int 1 , e_int 10) ; (e_int 2 , e_int 20)]) (t_map t_int t_int)) in + let%bind () = expect_eq_evaluate program "foo" (e_int 10) in ok () let map () : unit result = @@ -399,6 +400,11 @@ let map () : unit result = let make_expected = fun _ -> e_some @@ e_int 4 in expect_eq_n program "get" make_input make_expected in + let%bind () = + let make_input = fun n -> ez [(23, n) ; (42, 4)] in + let make_expected = fun _ -> e_some @@ e_int 4 in + expect_eq_n program "get_" make_input make_expected + in let%bind () = let expected = ez @@ List.map (fun x -> (x, 23)) [144 ; 51 ; 42 ; 120 ; 421] in expect_eq_evaluate program "bm" expected