switch from tz to mtz
This commit is contained in:
parent
f72593ae85
commit
e6ac10f0ce
@ -434,7 +434,7 @@ let rec simpl_expression :
|
|||||||
| EArith (Mtz n) -> (
|
| EArith (Mtz 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 = Z.to_int @@ snd @@ n in
|
||||||
return @@ e_literal ~loc (Literal_tez n)
|
return @@ e_literal ~loc (Literal_mutez n)
|
||||||
)
|
)
|
||||||
| EArith _ as e ->
|
| EArith _ as e ->
|
||||||
fail @@ unsupported_arith_op e
|
fail @@ unsupported_arith_op e
|
||||||
|
@ -500,7 +500,7 @@ let rec simpl_expression (t:Raw.expr) : expr result =
|
|||||||
| EArith (Mtz n) -> (
|
| EArith (Mtz 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 = 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
|
| EArith (Neg e) -> simpl_unop "NEG" e
|
||||||
| EString (String s) ->
|
| EString (String s) ->
|
||||||
|
@ -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 ())
|
return (E_literal (Literal_nat n)) (t_nat ())
|
||||||
| E_literal (Literal_timestamp n) ->
|
| E_literal (Literal_timestamp n) ->
|
||||||
return (E_literal (Literal_timestamp n)) (t_timestamp ())
|
return (E_literal (Literal_timestamp n)) (t_timestamp ())
|
||||||
| E_literal (Literal_tez n) ->
|
| E_literal (Literal_mutez n) ->
|
||||||
return (E_literal (Literal_tez n)) (t_tez ())
|
return (E_literal (Literal_mutez n)) (t_tez ())
|
||||||
| E_literal (Literal_address s) ->
|
| E_literal (Literal_address s) ->
|
||||||
return (e_address s) (t_address ())
|
return (e_address s) (t_address ())
|
||||||
| E_literal (Literal_operation op) ->
|
| 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_bool b -> ok (Literal_bool b)
|
||||||
| Literal_nat n -> ok (Literal_nat n)
|
| Literal_nat n -> ok (Literal_nat n)
|
||||||
| Literal_timestamp n -> ok (Literal_timestamp 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_int n -> ok (Literal_int n)
|
||||||
| Literal_string s -> ok (Literal_string s)
|
| Literal_string s -> ok (Literal_string s)
|
||||||
| Literal_bytes b -> ok (Literal_bytes b)
|
| Literal_bytes b -> ok (Literal_bytes b)
|
||||||
|
@ -204,7 +204,7 @@ let rec transpile_literal : AST.literal -> value = fun l -> match l with
|
|||||||
| Literal_int n -> D_int n
|
| Literal_int n -> D_int n
|
||||||
| Literal_nat n -> D_nat n
|
| Literal_nat n -> D_nat n
|
||||||
| Literal_timestamp n -> D_timestamp 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_bytes s -> D_bytes s
|
||||||
| Literal_string s -> D_string s
|
| Literal_string s -> D_string s
|
||||||
| Literal_address s -> D_string s
|
| Literal_address s -> D_string s
|
||||||
|
@ -86,8 +86,8 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
|
|||||||
| T_constant ("tez", []) -> (
|
| T_constant ("tez", []) -> (
|
||||||
let%bind n =
|
let%bind n =
|
||||||
trace_strong (wrong_mini_c_value "tez" v) @@
|
trace_strong (wrong_mini_c_value "tez" v) @@
|
||||||
get_nat v in
|
get_mutez v in
|
||||||
return (E_literal (Literal_tez n))
|
return (E_literal (Literal_mutez n))
|
||||||
)
|
)
|
||||||
| T_constant ("string", []) -> (
|
| T_constant ("string", []) -> (
|
||||||
let%bind n =
|
let%bind n =
|
||||||
|
@ -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_int n -> ok @@ int (Z.of_int n)
|
||||||
| D_nat 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_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_string s -> ok @@ string s
|
||||||
| D_bytes s -> ok @@ bytes (Tezos_stdlib.MBytes.of_bytes s)
|
| D_bytes s -> ok @@ bytes (Tezos_stdlib.MBytes.of_bytes s)
|
||||||
| D_unit -> ok @@ prim D_Unit
|
| D_unit -> ok @@ prim D_Unit
|
||||||
|
@ -40,7 +40,7 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result =
|
|||||||
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 () -> Int64.to_int @@ Alpha_context.Tez.to_mutez n) in
|
||||||
ok @@ D_nat n
|
ok @@ D_mutez n
|
||||||
| (Bool_t _), b ->
|
| (Bool_t _), b ->
|
||||||
ok @@ D_bool b
|
ok @@ D_bool b
|
||||||
| (String_t _), s ->
|
| (String_t _), s ->
|
||||||
|
@ -88,6 +88,9 @@ module Simplify = struct
|
|||||||
("map_iter" , "MAP_ITER") ;
|
("map_iter" , "MAP_ITER") ;
|
||||||
("map_map" , "MAP_MAP") ;
|
("map_map" , "MAP_MAP") ;
|
||||||
("map_fold" , "MAP_FOLD") ;
|
("map_fold" , "MAP_FOLD") ;
|
||||||
|
("map_remove" , "MAP_REMOVE") ;
|
||||||
|
("map_update" , "MAP_UPDATE") ;
|
||||||
|
("map_get" , "MAP_GET") ;
|
||||||
("sha_256" , "SHA256") ;
|
("sha_256" , "SHA256") ;
|
||||||
("sha_512" , "SHA512") ;
|
("sha_512" , "SHA512") ;
|
||||||
("blake2b" , "BLAKE2b") ;
|
("blake2b" , "BLAKE2b") ;
|
||||||
@ -270,7 +273,9 @@ module Typer = struct
|
|||||||
ok @@ t_bool ()
|
ok @@ t_bool ()
|
||||||
|
|
||||||
let map_find : typer = typer_2 "MAP_FIND" @@ fun k m ->
|
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
|
let%bind () = assert_type_value_eq (src, k) in
|
||||||
ok @@ dst
|
ok @@ dst
|
||||||
|
|
||||||
@ -313,11 +318,16 @@ module Typer = struct
|
|||||||
(is_t_string t) in
|
(is_t_string t) in
|
||||||
ok @@ t_unit ()
|
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 (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in
|
||||||
let%bind _ = assert_type_value_eq (src, i) in
|
let%bind _ = assert_type_value_eq (src, i) in
|
||||||
ok dst
|
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 int : typer = typer_1 "INT" @@ fun t ->
|
||||||
let%bind () = assert_t_nat t in
|
let%bind () = assert_t_nat t in
|
||||||
ok @@ t_int ()
|
ok @@ t_int ()
|
||||||
@ -607,6 +617,8 @@ module Typer = struct
|
|||||||
map_map ;
|
map_map ;
|
||||||
map_fold ;
|
map_fold ;
|
||||||
map_iter ;
|
map_iter ;
|
||||||
|
map_get_force ;
|
||||||
|
map_get ;
|
||||||
set_empty ;
|
set_empty ;
|
||||||
set_mem ;
|
set_mem ;
|
||||||
set_add ;
|
set_add ;
|
||||||
@ -619,7 +631,6 @@ module Typer = struct
|
|||||||
int ;
|
int ;
|
||||||
size ;
|
size ;
|
||||||
failwith_ ;
|
failwith_ ;
|
||||||
get_force ;
|
|
||||||
bytes_pack ;
|
bytes_pack ;
|
||||||
bytes_unpack ;
|
bytes_unpack ;
|
||||||
hash256 ;
|
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_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_FIND" , simple_binary @@ seq [prim I_GET ; i_assert_some_msg (i_push_string "MAP FIND")]) ;
|
||||||
("MAP_GET" , simple_binary @@ prim I_GET) ;
|
("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_ADD" , simple_ternary @@ seq [dip (i_some) ; prim I_UPDATE]) ;
|
||||||
("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ;
|
("MAP_UPDATE" , simple_ternary @@ prim I_UPDATE) ;
|
||||||
("SIZE" , simple_unary @@ prim I_SIZE) ;
|
("SIZE" , simple_unary @@ prim I_SIZE) ;
|
||||||
|
@ -25,7 +25,7 @@ let literal ppf (l:literal) = match l with
|
|||||||
| Literal_int n -> fprintf ppf "%d" n
|
| Literal_int n -> fprintf ppf "%d" n
|
||||||
| Literal_nat n -> fprintf ppf "+%d" n
|
| Literal_nat n -> fprintf ppf "+%d" n
|
||||||
| Literal_timestamp 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_string s -> fprintf ppf "%S" s
|
||||||
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
|
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
|
||||||
| Literal_address s -> fprintf ppf "@%S" s
|
| Literal_address s -> fprintf ppf "@%S" s
|
||||||
|
@ -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_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_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_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 e'_bytes b : expression' result =
|
||||||
let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in
|
let%bind bytes = generic_try (simple_error "bad hex to bytes") (fun () -> Hex.to_bytes (`Hex b)) in
|
||||||
ok @@ E_literal (Literal_bytes bytes)
|
ok @@ E_literal (Literal_bytes bytes)
|
||||||
|
@ -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 a, Literal_timestamp b when a = b -> ok ()
|
||||||
| Literal_timestamp _, Literal_timestamp _ -> fail @@ different_literals "different timestamps" a b
|
| 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_timestamp _, _ -> fail @@ different_literals_because_different_types "timestamp vs non-timestamp" a b
|
||||||
| Literal_tez a, Literal_tez b when a = b -> ok ()
|
| Literal_mutez a, Literal_mutez b when a = b -> ok ()
|
||||||
| Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b
|
| Literal_mutez _, Literal_mutez _ -> fail @@ different_literals "different tezs" a b
|
||||||
| Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" 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 a, Literal_string b when a = b -> ok ()
|
||||||
| Literal_string _, Literal_string _ -> fail @@ different_literals "different strings" a b
|
| 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
|
| Literal_string _, _ -> fail @@ different_literals_because_different_types "string vs non-string" a b
|
||||||
|
@ -91,7 +91,7 @@ and literal =
|
|||||||
| Literal_bool of bool
|
| Literal_bool of bool
|
||||||
| Literal_int of int
|
| Literal_int of int
|
||||||
| Literal_nat of int
|
| Literal_nat of int
|
||||||
| Literal_tez of int
|
| Literal_mutez of int
|
||||||
| Literal_string of string
|
| Literal_string of string
|
||||||
| Literal_bytes of bytes
|
| Literal_bytes of bytes
|
||||||
| Literal_address of string
|
| Literal_address of string
|
||||||
|
@ -70,7 +70,7 @@ and literal ppf (l:literal) : unit =
|
|||||||
| Literal_int n -> fprintf ppf "%d" n
|
| Literal_int n -> fprintf ppf "%d" n
|
||||||
| Literal_nat n -> fprintf ppf "+%d" n
|
| Literal_nat n -> fprintf ppf "+%d" n
|
||||||
| Literal_timestamp 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_string s -> fprintf ppf "%s" s
|
||||||
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
|
| Literal_bytes b -> fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
|
||||||
| Literal_address s -> fprintf ppf "@%s" s
|
| Literal_address s -> fprintf ppf "@%s" s
|
||||||
|
@ -232,7 +232,7 @@ let e_map lst : expression = E_map lst
|
|||||||
let e_unit : expression = E_literal (Literal_unit)
|
let e_unit : expression = E_literal (Literal_unit)
|
||||||
let e_int n : expression = E_literal (Literal_int n)
|
let e_int n : expression = E_literal (Literal_int n)
|
||||||
let e_nat n : expression = E_literal (Literal_nat 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_bool b : expression = E_literal (Literal_bool b)
|
||||||
let e_string s : expression = E_literal (Literal_string s)
|
let e_string s : expression = E_literal (Literal_string s)
|
||||||
let e_address s : expression = E_literal (Literal_address 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_unit = make_a_e e_unit (t_unit ())
|
||||||
let e_a_int n = make_a_e (e_int n) (t_int ())
|
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_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_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_string s = make_a_e (e_string s) (t_string ())
|
||||||
let e_a_address s = make_a_e (e_address s) (t_address ())
|
let e_a_address s = make_a_e (e_address s) (t_address ())
|
||||||
|
@ -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_unit = e_a_unit Environment.full_empty
|
||||||
let e_a_empty_int n = e_a_int n 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_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_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_string s = e_a_string s Environment.full_empty
|
||||||
let e_a_empty_address s = e_a_address s Environment.full_empty
|
let e_a_empty_address s = e_a_address s Environment.full_empty
|
||||||
|
@ -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 a, Literal_timestamp b when a = b -> ok ()
|
||||||
| Literal_timestamp _, Literal_timestamp _ -> fail @@ different_literals "different timestamps" a b
|
| 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_timestamp _, _ -> fail @@ different_literals_because_different_types "timestamp vs non-timestamp" a b
|
||||||
| Literal_tez a, Literal_tez b when a = b -> ok ()
|
| Literal_mutez a, Literal_mutez b when a = b -> ok ()
|
||||||
| Literal_tez _, Literal_tez _ -> fail @@ different_literals "different tezs" a b
|
| Literal_mutez _, Literal_mutez _ -> fail @@ different_literals "different tezs" a b
|
||||||
| Literal_tez _, _ -> fail @@ different_literals_because_different_types "tez vs non-tez" 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 a, Literal_string b when a = b -> ok ()
|
||||||
| Literal_string _, Literal_string _ -> fail @@ different_literals "different strings" a b
|
| 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
|
| Literal_string _, _ -> fail @@ different_literals_because_different_types "string vs non-string" a b
|
||||||
|
@ -119,7 +119,7 @@ and literal =
|
|||||||
| Literal_int of int
|
| Literal_int of int
|
||||||
| Literal_nat of int
|
| Literal_nat of int
|
||||||
| Literal_timestamp of int
|
| Literal_timestamp of int
|
||||||
| Literal_tez of int
|
| Literal_mutez of int
|
||||||
| Literal_string of string
|
| Literal_string of string
|
||||||
| Literal_bytes of bytes
|
| Literal_bytes of bytes
|
||||||
| Literal_address of string
|
| Literal_address of string
|
||||||
|
@ -49,7 +49,7 @@ let rec value ppf : value -> unit = function
|
|||||||
| D_int n -> fprintf ppf "%d" n
|
| D_int n -> fprintf ppf "%d" n
|
||||||
| D_nat n -> fprintf ppf "+%d" n
|
| D_nat n -> fprintf ppf "+%d" n
|
||||||
| D_timestamp 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_unit -> fprintf ppf "unit"
|
||||||
| D_string s -> fprintf ppf "\"%s\"" s
|
| D_string s -> fprintf ppf "\"%s\"" s
|
||||||
| D_bytes x ->
|
| D_bytes x ->
|
||||||
|
@ -34,6 +34,10 @@ let get_nat (v:value) = match v with
|
|||||||
| D_nat n -> ok n
|
| D_nat n -> ok n
|
||||||
| _ -> simple_fail "not a nat"
|
| _ -> 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
|
let get_timestamp (v:value) = match v with
|
||||||
| D_timestamp n -> ok n
|
| D_timestamp n -> ok n
|
||||||
| _ -> simple_fail "not a timestamp"
|
| _ -> simple_fail "not a timestamp"
|
||||||
|
@ -38,7 +38,7 @@ type value =
|
|||||||
| D_bool of bool
|
| D_bool of bool
|
||||||
| D_nat of int
|
| D_nat of int
|
||||||
| D_timestamp of int
|
| D_timestamp of int
|
||||||
| D_tez of int
|
| D_mutez of int
|
||||||
| D_int of int
|
| D_int of int
|
||||||
| D_string of string
|
| D_string of string
|
||||||
| D_bytes of bytes
|
| D_bytes of bytes
|
||||||
|
@ -47,7 +47,7 @@ let card_pattern_ty =
|
|||||||
]
|
]
|
||||||
|
|
||||||
let card_pattern_ez (coeff , qtt) =
|
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 make_card_patterns lst =
|
||||||
let card_pattern_id_ty = t_nat in
|
let card_pattern_id_ty = t_nat in
|
||||||
|
@ -26,6 +26,11 @@ function get (const m : foobar) : option(int) is
|
|||||||
skip
|
skip
|
||||||
end with m[42]
|
end with m[42]
|
||||||
|
|
||||||
|
function get_ (const m : foobar) : option(int) is
|
||||||
|
begin
|
||||||
|
skip
|
||||||
|
end with map_get(42 , m)
|
||||||
|
|
||||||
const bm : foobar = map
|
const bm : foobar = map
|
||||||
144 -> 23 ;
|
144 -> 23 ;
|
||||||
51 -> 23 ;
|
51 -> 23 ;
|
||||||
|
@ -3,3 +3,5 @@ type foobar = (int , int) map
|
|||||||
let foobar : foobar = Map.empty
|
let foobar : foobar = Map.empty
|
||||||
|
|
||||||
let foobarz : foobar = Map.literal [ (1 , 10) ; (2 , 20) ]
|
let foobarz : foobar = Map.literal [ (1 , 10) ; (2 , 20) ]
|
||||||
|
|
||||||
|
let foo : int = Map.find 1 foobarz
|
||||||
|
@ -363,6 +363,7 @@ let mmap () : unit result =
|
|||||||
(e_annotation (e_map []) (t_map t_int t_int)) in
|
(e_annotation (e_map []) (t_map t_int t_int)) in
|
||||||
let%bind () = expect_eq_evaluate program "foobarz"
|
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
|
(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 ()
|
ok ()
|
||||||
|
|
||||||
let map () : unit result =
|
let map () : unit result =
|
||||||
@ -399,6 +400,11 @@ let map () : unit result =
|
|||||||
let make_expected = fun _ -> e_some @@ e_int 4 in
|
let make_expected = fun _ -> e_some @@ e_int 4 in
|
||||||
expect_eq_n program "get" make_input make_expected
|
expect_eq_n program "get" make_input make_expected
|
||||||
in
|
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%bind () =
|
||||||
let expected = ez @@ List.map (fun x -> (x, 23)) [144 ; 51 ; 42 ; 120 ; 421] in
|
let expected = ez @@ List.map (fun x -> (x, 23)) [144 ; 51 ; 42 ; 120 ; 421] in
|
||||||
expect_eq_evaluate program "bm" expected
|
expect_eq_evaluate program "bm" expected
|
||||||
|
Loading…
Reference in New Issue
Block a user