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

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

Browse Source 
Solve T_arrow vs. TC_arrow bug in new typer

See merge request ligolang/ligo!593
This commit is contained in:
Suzanne Dupéron 2020-04-30 03:37:45 +00:00
commit 71e0509910
21 changed files with 7 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/passes/10-transpiler/transpiler.ml
View File

@ -268,11 +268,6 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
| T_operator (TC_option o) ->
let%bind o' = transpile_type o in
ok (T_option o')
| T_operator (TC_arrow {type1=param ; type2=result}) -> (
let%bind param' = transpile_type param in
let%bind result' = transpile_type result in
ok (T_function (param', result'))
)
| T_sum m when Ast_typed.Helpers.is_michelson_or m ->
let node = Append_tree.of_list @@ kv_list_of_cmap m in
let aux a b : type_value annotated result =

6
src/passes/10-transpiler/untranspiler.ml
View File

@ -203,12 +203,6 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
let%bind init = return @@ E_constant {cons_name=C_LIST_EMPTY;arguments=[]} in
bind_fold_right_list aux init lst'
)
| TC_arrow _ -> (
let%bind n =
trace_strong (wrong_mini_c_value "lambda as string" v) @@
get_string v in
return (E_literal (Literal_string n))
)
| TC_set ty -> (
let%bind lst =
trace_strong (wrong_mini_c_value "set" v) @@

6
src/passes/4-imperative_to_sugar/imperative_to_sugar.ml
View File

@ -200,9 +200,6 @@ and compile_type_operator : I.type_operator -> O.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
ok @@ O.TC_big_map (k,v)
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair compile_type_expression (i,o) in
ok @@ O.TC_arrow (i,o)
| TC_michelson_or _ | TC_michelson_pair _ -> fail @@ Errors.corner_case __LOC__
let rec compile_expression : I.expression -> O.expression result =
@ -663,9 +660,6 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_big_map (k,v)
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
ok @@ I.TC_arrow (i,o)
let rec uncompile_expression' : O.expression -> I.expression result =
fun e ->

6
src/passes/6-sugar_to_core/sugar_to_core.ml
View File

@ -66,9 +66,6 @@ and idle_type_operator : I.type_operator -> O.type_operator result =
| TC_big_map (k,v) ->
let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
ok @@ O.TC_big_map (k,v)
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair idle_type_expression (i,o) in
ok @@ O.TC_arrow (i,o)
let rec compile_expression : I.expression -> O.expression result =
fun e ->
@ -295,9 +292,6 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
ok @@ I.TC_big_map (k,v)
| TC_map_or_big_map _ -> failwith "TC_map_or_big_map shouldn't be uncompiled"
| TC_arrow (i,o) ->
let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
ok @@ I.TC_arrow (i,o)
let rec uncompile_expression : O.expression -> I.expression result =
fun e ->

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

@ -188,10 +188,6 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
| TC_contract c ->
let%bind c = evaluate_type e c in
ok @@ O.TC_contract c
| TC_arrow ( arg , ret ) ->
let%bind arg' = evaluate_type e arg in
let%bind ret' = evaluate_type e ret in
ok @@ O.TC_arrow { type1=arg' ; type2=ret' }
in
return (T_operator (opt))

4
src/passes/8-typer-new/untyper.ml
View File

@ -193,10 +193,6 @@ let rec untype_type_expression (t:O.type_expression) : (I.type_expression) resul
let%bind k = untype_type_expression k in
let%bind v = untype_type_expression v in
ok @@ I.TC_map_or_big_map (k,v)
| O.TC_arrow { type1=arg ; type2=ret } ->
let%bind arg' = untype_type_expression arg in
let%bind ret' = untype_type_expression ret in
ok @@ I.TC_arrow ( arg' , ret' )
| O.TC_contract c->
let%bind c = untype_type_expression c in
ok @@ I.TC_contract c

2
src/passes/8-typer-new/wrap.ml
View File

@ -71,7 +71,6 @@ let rec type_expression_to_type_value : T.type_expression -> O.type_value = fun
| TC_map { k ; v } -> (C_map, [k;v])
| TC_big_map { k ; v } -> (C_big_map, [k;v])
| TC_map_or_big_map { k ; v } -> (C_map, [k;v])
| TC_arrow { type1 ; type2 } -> (C_arrow, [ type1 ; type2 ])
| TC_list l -> (C_list, [l])
| TC_contract c -> (C_contract, [c])
)
@ -107,7 +106,6 @@ let rec type_expression_to_type_value_copypasted : I.type_expression -> O.type_v
| TC_big_map ( k , v ) -> (C_big_map, [k;v])
| TC_map_or_big_map ( k , v) -> (C_map, [k;v])
| TC_contract c -> (C_contract, [c])
| TC_arrow ( arg , ret ) -> (C_arrow, [ arg ; ret ])
)
in
p_constant csttag (List.map type_expression_to_type_value_copypasted args)

4
src/passes/8-typer-old/typer.ml
View File

@ -649,10 +649,6 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
let%bind k = evaluate_type e k in
let%bind v = evaluate_type e v in
ok @@ O.TC_map_or_big_map {k;v}
| TC_arrow ( arg , ret ) ->
let%bind arg' = evaluate_type e arg in
let%bind ret' = evaluate_type e ret in
ok @@ O.TC_arrow { type1=arg' ; type2=ret' }
| TC_contract c ->
let%bind c = evaluate_type e c in
ok @@ O.TC_contract c

4
src/passes/9-self_ast_typed/no_nested_big_map.ml
View File

@ -35,10 +35,6 @@ let rec check_no_nested_bigmap is_in_bigmap e =
let%bind _ = check_no_nested_bigmap is_in_bigmap k in
let%bind _ = check_no_nested_bigmap is_in_bigmap v in
ok ()
| T_operator (TC_arrow { type1 ; type2 }) ->
let%bind _ = check_no_nested_bigmap false type1 in
let%bind _ = check_no_nested_bigmap false type2 in
ok ()
| T_sum s ->
let es = List.map (fun {ctor_type;_} -> ctor_type) (CMap.to_list s) in
let%bind _ = bind_map_list (fun l -> check_no_nested_bigmap is_in_bigmap l) es in

1
src/stages/1-ast_imperative/PP.ml
View File

@ -55,7 +55,6 @@ and type_operator :
| TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_michelson_or (l,_, r,_) -> Format.asprintf "Michelson_or (%a,%a)" f l f r
| TC_michelson_pair (l,_, r,_) -> Format.asprintf "Michelson_pair (%a,%a)" f l f r
| TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
| TC_contract te -> Format.asprintf "Contract (%a)" f te
in
fprintf ppf "(TO_%s)" s

1
src/stages/1-ast_imperative/types.ml
View File

@ -24,7 +24,6 @@ and type_operator =
| TC_set of type_expression
| TC_map of type_expression * type_expression
| TC_big_map of type_expression * type_expression
| TC_arrow of type_expression * type_expression
| TC_michelson_or of type_expression * michelson_prct_annotation * type_expression * michelson_prct_annotation
| TC_michelson_pair of type_expression * michelson_prct_annotation * type_expression * michelson_prct_annotation

1
src/stages/2-ast_sugar/PP.ml
View File

@ -51,7 +51,6 @@ and type_operator : (formatter -> type_expression -> unit) -> formatter -> type_
| TC_set te -> Format.asprintf "set(%a)" f te
| TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
| TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
| TC_contract te -> Format.asprintf "Contract (%a)" f te
in
fprintf ppf "(TO_%s)" s

1
src/stages/2-ast_sugar/types.ml
View File

@ -30,7 +30,6 @@ and type_operator =
| TC_set of type_expression
| TC_map of type_expression * type_expression
| TC_big_map of type_expression * type_expression
| TC_arrow of type_expression * type_expression
and type_expression = {type_content: type_content; location: Location.t}

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

@ -248,7 +248,6 @@ and type_operator :
| TC_map {k; v} -> Format.asprintf "Map (%a,%a)" f k f v
| TC_big_map {k; v} -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_map_or_big_map {k; v} -> Format.asprintf "Map Or Big Map (%a,%a)" f k f v
| TC_arrow {type1; type2} -> Format.asprintf "arrow (%a,%a)" f type1 f type2
| TC_contract te -> Format.asprintf "Contract (%a)" f te
in
fprintf ppf "(type_operator: %s)" s

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

@ -9,7 +9,6 @@ let map_type_operator f = function
| TC_map {k ; v} -> TC_map { k = f k ; v = f v }
| TC_big_map {k ; v}-> TC_big_map { k = f k ; v = f v }
| TC_map_or_big_map { k ; v }-> TC_map_or_big_map { k = f k ; v = f v }
| TC_arrow {type1 ; type2} -> TC_arrow { type1 = f type1 ; type2 = f type2 }
let bind_map_type_operator f = function
TC_contract x -> let%bind x = f x in ok @@ TC_contract x
@ -19,7 +18,6 @@ let bind_map_type_operator f = function
| TC_map {k ; v} -> let%bind k = f k in let%bind v = f v in ok @@ TC_map {k ; v}
| TC_big_map {k ; v} -> let%bind k = f k in let%bind v = f v in ok @@ TC_big_map {k ; v}
| TC_map_or_big_map {k ; v} -> let%bind k = f k in let%bind v = f v in ok @@ TC_map_or_big_map {k ; v}
| TC_arrow {type1 ; type2}-> let%bind type1 = f type1 in let%bind type2 = f type2 in ok @@ TC_arrow {type1 ; type2}
let type_operator_name = function
TC_contract _ -> "TC_contract"
@ -29,7 +27,6 @@ let type_operator_name = function
| TC_map _ -> "TC_map"
| TC_big_map _ -> "TC_big_map"
| TC_map_or_big_map _ -> "TC_map_or_big_map"
| TC_arrow _ -> "TC_arrow"
let type_expression'_of_string = function
| "TC_contract" , [x] -> ok @@ T_operator(TC_contract x)
@ -67,7 +64,6 @@ let string_of_type_operator = function
| TC_map { k ; v } -> "TC_map" , [k ; v]
| TC_big_map { k ; v } -> "TC_big_map" , [k ; v]
| TC_map_or_big_map { k ; v } -> "TC_map_or_big_map" , [k ; v]
| TC_arrow { type1 ; type2 } -> "TC_arrow" , [type1 ; type2]
let string_of_type_constant = function
| TC_unit -> "TC_unit", []

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

@ -342,8 +342,8 @@ let rec assert_type_expression_eq (a, b: (type_expression * type_expression)) :
| (TC_map {k=ka;v=va} | TC_map_or_big_map {k=ka;v=va}), (TC_map {k=kb;v=vb} | TC_map_or_big_map {k=kb;v=vb})
| (TC_big_map {k=ka;v=va} | TC_map_or_big_map {k=ka;v=va}), (TC_big_map {k=kb;v=vb} | TC_map_or_big_map {k=kb;v=vb})
-> ok @@ ([ka;va] ,[kb;vb])
| (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _ ),
(TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _ )
| (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ ),
(TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ )
-> fail @@ different_operators opa opb
in
if List.length lsta <> List.length lstb then

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

@ -65,8 +65,6 @@ and type_operator =
| TC_map of type_map_args
| TC_big_map of type_map_args
| TC_map_or_big_map of type_map_args
| TC_arrow of arrow
and type_expression = {
type_content: type_content;

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

@ -249,7 +249,6 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
| TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
| TC_map_or_big_map (k, v) -> Format.asprintf "Map Or Big Map (%a,%a)" f k f v
| TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
| TC_contract te -> Format.asprintf "Contract (%a)" f te
in
fprintf ppf "(type_operator: %s)" s

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

@ -59,7 +59,6 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map of type_expression * type_expression
| TC_big_map of type_expression * type_expression
| TC_map_or_big_map of type_expression * type_expression
| TC_arrow of type_expression * type_expression
and type_expression = {type_content: type_content; location: Location.t; type_meta: type_meta}
@ -73,7 +72,6 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map (x , y) -> TC_map (f x , f y)
| TC_big_map (x , y)-> TC_big_map (f x , f y)
| TC_map_or_big_map (x , y)-> TC_map_or_big_map (f x , f y)
| TC_arrow (x, y) -> TC_arrow (f x, f y)
let bind_map_type_operator f = function
TC_contract x -> let%bind x = f x in ok @@ TC_contract x
@ -83,7 +81,6 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map (x , y) -> let%bind x = f x in let%bind y = f y in ok @@ TC_map (x , y)
| TC_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_big_map (x , y)
| TC_map_or_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_map_or_big_map (x , y)
| TC_arrow (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_arrow (x , y)
let type_operator_name = function
TC_contract _ -> "TC_contract"
@ -93,7 +90,6 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map _ -> "TC_map"
| TC_big_map _ -> "TC_big_map"
| TC_map_or_big_map _ -> "TC_map_or_big_map"
| TC_arrow _ -> "TC_arrow"
let type_expression'_of_string = function
| "TC_contract" , [x] -> ok @@ T_operator(TC_contract x)
@ -131,7 +127,6 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
| TC_map (x , y) -> "TC_map" , [x ; y]
| TC_big_map (x , y) -> "TC_big_map" , [x ; y]
| TC_map_or_big_map (x , y) -> "TC_map_or_big_map" , [x ; y]
| TC_arrow (x , y) -> "TC_arrow" , [x ; y]
let string_of_type_constant = function
| TC_unit -> "TC_unit", []

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

@ -39,7 +39,7 @@ let type_expression'_of_simple_c_constant : constant_tag * type_expression list
| C_set , [x] -> ok @@ Ast_typed.T_operator(TC_set x)
| C_map , [k ; v] -> ok @@ Ast_typed.T_operator(TC_map {k ; v})
| C_big_map , [k ; v] -> ok @@ Ast_typed.T_operator(TC_big_map {k ; v})
| C_arrow , [x ; y] -> ok @@ Ast_typed.T_operator(TC_arrow {type1=x ; type2=y})
| C_arrow , [x ; y] -> ok @@ Ast_typed.T_arrow {type1=x ; type2=y} (* For now, the arrow type constructor is special *)
| 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 ), _ ->

7
src/stages/typesystem/misc.ml
View File

@ -85,9 +85,10 @@ module Substitution = struct
| T.T_operator type_name_and_args ->
let%bind type_name_and_args = T.Helpers.bind_map_type_operator (s_type_expression ~substs) type_name_and_args in
ok @@ T.T_operator type_name_and_args
| T.T_arrow _ ->
let _TODO = substs in
failwith "TODO: T_function"
| T.T_arrow { type1; type2 } ->
let%bind type1 = s_type_expression ~substs type1 in
let%bind type2 = s_type_expression ~substs type2 in
ok @@ T.T_arrow { type1; type2 }
and s_abstr_type_content : Ast_core.type_content w = fun ~substs -> function
| Ast_core.T_sum _ -> failwith "TODO: subst: unimplemented case s_type_expression sum"