From 7ab2ffa156db0150e7e61af21afa5bfbfdaf21ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= Date: Thu, 30 Jan 2020 13:12:24 +0000 Subject: [PATCH 1/4] New typer: fix tuples --- src/stages/typesystem/core.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/stages/typesystem/core.ml b/src/stages/typesystem/core.ml index c21888908..11f9122c5 100644 --- a/src/stages/typesystem/core.ml +++ b/src/stages/typesystem/core.ml @@ -77,7 +77,11 @@ let type_expression'_of_simple_c_constant = function | C_set , [x] -> ok @@ T_operator(TC_set x) | C_map , [x ; y] -> ok @@ T_operator(TC_map (x , y)) | C_big_map , [x ; y] -> ok @@ T_operator(TC_big_map (x, y)) - | (C_contract | C_option | C_list | C_set | C_map | C_big_map), _ -> + | C_arrow , [x ; y] -> ok @@ T_operator(TC_arrow (x, y)) + | C_tuple , lst -> ok @@ T_operator(TC_tuple lst) + | C_record , _lst -> ok @@ failwith "records are not supported yet: T_record lst" + | C_variant , _lst -> ok @@ failwith "sums are not supported yet: T_sum lst" + | (C_contract | C_option | C_list | C_set | C_map | C_big_map | C_arrow ), _ -> failwith "internal error: wrong number of arguments for type operator" | C_unit , [] -> ok @@ T_constant(TC_unit) @@ -94,8 +98,6 @@ let type_expression'_of_simple_c_constant = function | C_chain_id , [] -> ok @@ T_constant(TC_chain_id) | C_signature , [] -> ok @@ T_constant(TC_signature) | C_timestamp , [] -> ok @@ T_constant(TC_timestamp) - | _ , [] -> + | (C_unit | C_string | C_bytes | C_nat | C_int | C_mutez | C_bool | C_operation | C_address | C_key | C_key_hash | C_chain_id | C_signature | C_timestamp), _::_ -> failwith "internal error: wrong number of arguments for type constant" - | _ , _ -> - failwith "internal error: unknown type operator" From 96468bd8ff55b00adbdeb40bc601cd15b5b8060a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= Date: Thu, 30 Jan 2020 13:09:34 +0000 Subject: [PATCH 2/4] Disabled conversion of records & variants to type constructor + argument list in new typer, the current implementation is just wrong. --- src/passes/4-typer-new/solver.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/passes/4-typer-new/solver.ml b/src/passes/4-typer-new/solver.ml index 4f9c96388..7175fab54 100644 --- a/src/passes/4-typer-new/solver.ml +++ b/src/passes/4-typer-new/solver.ml @@ -35,8 +35,10 @@ module Wrap = struct let rec type_expression_to_type_value : T.type_value -> O.type_value = fun te -> match te.type_value' with | T_sum kvmap -> + let () = failwith "fixme: don't use to_list, it drops the variant keys, rows have a differnt kind than argument lists for now!" in P_constant (C_variant, T.CMap.to_list @@ T.CMap.map type_expression_to_type_value kvmap) | T_record kvmap -> + let () = failwith "fixme: don't use to_list, it drops the record keys, rows have a differnt kind than argument lists for now!" in P_constant (C_record, T.LMap.to_list @@ T.LMap.map type_expression_to_type_value kvmap) | T_arrow (arg , ret) -> P_constant (C_arrow, List.map type_expression_to_type_value [ arg ; ret ]) @@ -77,8 +79,10 @@ module Wrap = struct let rec type_expression_to_type_value_copypasted : I.type_expression -> O.type_value = fun te -> match te.type_expression' with | T_sum kvmap -> + let () = failwith "fixme: don't use to_list, it drops the variant keys, rows have a differnt kind than argument lists for now!" in P_constant (C_variant, I.CMap.to_list @@ I.CMap.map type_expression_to_type_value_copypasted kvmap) | T_record kvmap -> + let () = failwith "fixme: don't use to_list, it drops the record keys, rows have a differnt kind than argument lists for now!" in P_constant (C_record, I.LMap.to_list @@ I.LMap.map type_expression_to_type_value_copypasted kvmap) | T_arrow (arg , ret) -> P_constant (C_arrow, List.map type_expression_to_type_value_copypasted [ arg ; ret ]) From a6f0d7297cdfcb611716d628763164202a834b43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= Date: Thu, 30 Jan 2020 13:11:56 +0000 Subject: [PATCH 3/4] Improved temporary internal error message --- src/stages/common/misc.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stages/common/misc.ml b/src/stages/common/misc.ml index 794a36e7c..c753d7f3b 100644 --- a/src/stages/common/misc.ml +++ b/src/stages/common/misc.ml @@ -57,8 +57,8 @@ let type_expression'_of_string = function | "TC_timestamp" , [] -> ok @@ T_constant(TC_timestamp) | _, [] -> failwith "internal error: wrong number of arguments for type constant" - | _ -> - failwith "internal error: unknown type operator" + | op, _ -> + failwith (Format.asprintf "internal error: unknown type operator in src/stages/common/misc.ml %s" op) let string_of_type_operator = function | TC_contract x -> "TC_contract" , [x] From 0abc4cd2062a91294e6e77cb41cf4f5eaae7f3d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Suzanne=20Dup=C3=A9ron?= Date: Thu, 30 Jan 2020 18:48:43 +0000 Subject: [PATCH 4/4] Started adding typer for constants --- src/passes/4-typer-new/typer.ml | 3 +- src/passes/operators/operators.ml | 87 ++++++++++++++++++++++++++++++ src/passes/operators/operators.mli | 1 + 3 files changed, 90 insertions(+), 1 deletion(-) diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index ba9e10bd0..7eb46e26e 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/src/passes/4-typer-new/typer.ml @@ -897,7 +897,8 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e | E_constant (name, lst) -> let () = ignore (name , lst) in - Pervasives.failwith "TODO: E_constant" + let _t = Operators.Typer.Operators_types.constant_type name in + Pervasives.failwith (Format.asprintf "TODO: E_constant (%a(%a))" Stage_common.PP.constant name (Format.pp_print_list Ast_simplified.PP.expression) lst) (* let%bind lst' = bind_list @@ List.map (type_expression e) lst in let tv_lst = List.map get_type_annotation lst' in diff --git a/src/passes/operators/operators.ml b/src/passes/operators/operators.ml index 6c8c92112..4c0d3dbb9 100644 --- a/src/passes/operators/operators.ml +++ b/src/passes/operators/operators.ml @@ -365,6 +365,93 @@ module Typer = struct let t_set_add = forall "a" @@ fun a -> a --> set a --> set a let t_set_remove = forall "a" @@ fun a -> a --> set a --> set a let t_not = bool --> bool + + let constant_type : constant -> Typesystem.Core.type_value result = function + | C_INT -> ok @@ t_int ; + | C_UNIT -> ok @@ t_unit ; + | C_NOW -> ok @@ t_now ; + | C_IS_NAT -> ok @@ failwith "t_is_nat" ; + | C_SOME -> ok @@ t_some ; + | C_NONE -> ok @@ t_none ; + | C_ASSERTION -> ok @@ t_assertion ; + | C_FAILWITH -> ok @@ t_failwith ; + (* LOOPS *) + | C_FOLD_WHILE -> ok @@ failwith "t_fold_while" ; + | C_CONTINUE -> ok @@ failwith "t_continue" ; + | C_STOP -> ok @@ failwith "t_stop" ; + (* MATH *) + | C_NEG -> ok @@ failwith "t_neg" ; + | C_ABS -> ok @@ t_abs ; + | C_ADD -> ok @@ t_add ; + | C_SUB -> ok @@ t_sub ; + | C_MUL -> ok @@ t_times; + | C_DIV -> ok @@ t_div ; + | C_MOD -> ok @@ t_mod ; + (* LOGIC *) + | C_NOT -> ok @@ t_not ; + | C_AND -> ok @@ failwith "t_and" ; + | C_OR -> ok @@ failwith "t_or" ; + | C_XOR -> ok @@ failwith "t_xor" ; + (* COMPARATOR *) + | C_EQ -> ok @@ failwith "t_comparator EQ" ; + | C_NEQ -> ok @@ failwith "t_comparator NEQ" ; + | C_LT -> ok @@ failwith "t_comparator LT" ; + | C_GT -> ok @@ failwith "t_comparator GT" ; + | C_LE -> ok @@ failwith "t_comparator LE" ; + | C_GE -> ok @@ failwith "t_comparator GE" ; + (* BYTES / STRING *) + | C_SIZE -> ok @@ t_size ; + | C_CONCAT -> ok @@ failwith "t_concat" ; + | C_SLICE -> ok @@ t_slice ; + | C_BYTES_PACK -> ok @@ t_bytes_pack ; + | C_BYTES_UNPACK -> ok @@ t_bytes_unpack ; + | C_CONS -> ok @@ t_cons ; + (* SET *) + | C_SET_EMPTY -> ok @@ failwith "t_set_empty" ; + | C_SET_ADD -> ok @@ t_set_add ; + | C_SET_REMOVE -> ok @@ t_set_remove ; + | C_SET_ITER -> ok @@ failwith "t_set_iter" ; + | C_SET_FOLD -> ok @@ failwith "t_set_fold" ; + | C_SET_MEM -> ok @@ t_set_mem ; + + (* LIST *) + | C_LIST_ITER -> ok @@ failwith "t_list_iter" ; + | C_LIST_MAP -> ok @@ failwith "t_list_map" ; + | C_LIST_FOLD -> ok @@ failwith "t_list_fold" ; + | C_LIST_CONS -> ok @@ failwith "t_list_cons" ; + (* MAP *) + | C_MAP_GET -> ok @@ failwith "t_map_get" ; + | C_MAP_GET_FORCE -> ok @@ failwith "t_map_get_force" ; + | C_MAP_ADD -> ok @@ t_map_add ; + | C_MAP_REMOVE -> ok @@ t_map_remove ; + | C_MAP_UPDATE -> ok @@ t_map_update ; + | C_MAP_ITER -> ok @@ t_map_iter ; + | C_MAP_MAP -> ok @@ t_map_map ; + | C_MAP_FOLD -> ok @@ t_map_fold ; + | C_MAP_MEM -> ok @@ t_map_mem ; + | C_MAP_FIND -> ok @@ t_map_find ; + | C_MAP_FIND_OPT -> ok @@ t_map_find_opt ; + (* BIG MAP *) + (* CRYPTO *) + | C_SHA256 -> ok @@ t_hash256 ; + | C_SHA512 -> ok @@ t_hash512 ; + | C_BLAKE2b -> ok @@ t_blake2b ; + | C_HASH_KEY -> ok @@ t_hash_key ; + | C_CHECK_SIGNATURE -> ok @@ t_check_signature ; + | C_CHAIN_ID -> ok @@ failwith "t_chain_id" ; + (*BLOCKCHAIN *) + | C_CONTRACT -> ok @@ t_get_contract ; + | C_CONTRACT_ENTRYPOINT -> ok @@ failwith "t_get_entrypoint" ; + | C_AMOUNT -> ok @@ t_amount ; + | C_BALANCE -> ok @@ failwith "t_balance" ; + | C_CALL -> ok @@ t_transaction ; + | C_SENDER -> ok @@ t_sender ; + | C_SOURCE -> ok @@ t_source ; + | C_ADDRESS -> ok @@ t_address ; + | C_SELF_ADDRESS -> ok @@ failwith "t_self_address"; + | C_IMPLICIT_ACCOUNT -> ok @@ failwith "t_implicit_account"; + | C_SET_DELEGATE -> ok @@ failwith "t_set_delegate" ; + | c -> simple_fail @@ Format.asprintf "Typer not implemented for consant %a" Stage_common.PP.constant c end let none = typer_0 "NONE" @@ fun tv_opt -> diff --git a/src/passes/operators/operators.mli b/src/passes/operators/operators.mli index 0085f5883..3da294664 100644 --- a/src/passes/operators/operators.mli +++ b/src/passes/operators/operators.mli @@ -94,6 +94,7 @@ module Typer : sig val t_set_add : Typesystem.Core.type_value val t_set_remove : Typesystem.Core.type_value val t_not : Typesystem.Core.type_value + val constant_type : constant -> Typesystem.Core.type_value Trace.result end (*