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

Merge branch 'bugfix/new-typer-8' into 'dev'

Browse Source 
misc. fixes on the new typer

See merge request ligolang/ligo!369
This commit is contained in:
Suzanne Dupéron 2020-02-03 19:48:49 +00:00
commit d2630379ec
6 changed files with 102 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/passes/4-typer-new/solver.ml
View File

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

3
src/passes/4-typer-new/typer.ml
View File

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

87
src/passes/operators/operators.ml
View File

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

1
src/passes/operators/operators.mli
View File

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

4
src/stages/common/misc.ml
View File

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

10
src/stages/typesystem/core.ml
View File

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