From 3a14ef26ef3092e70356f70a9386e4bda897ff40 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 7 Oct 2019 08:11:46 -0500 Subject: [PATCH] Simplify? --- src/passes/1-parser/pascaligo/Parser.mly | 6 +----- src/passes/2-simplify/pascaligo.ml | 2 +- src/passes/4-typer/typer.ml | 8 ++++++-- src/passes/6-transpiler/transpiler.ml | 2 -- src/passes/6-transpiler/untranspiler.ml | 4 +--- src/stages/ast_typed/combinators.ml | 3 +-- src/stages/ast_typed/combinators_environment.ml | 2 +- src/stages/ast_typed/misc.ml | 3 --- src/test/contracts/option.ligo | 2 +- 9 files changed, 12 insertions(+), 20 deletions(-) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index f4d25bbe5..a1902bade 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -591,11 +591,7 @@ assignment: in {region; value}} rhs: - expr { - match $1 with - EConstr (NoneExpr e) -> (NoneExpr e : rhs) - | e -> Expr e - } + expr { Expr $1 } lhs: path { Path $1 } diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 2e0eee337..ddb3d7bd8 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -782,7 +782,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let (a , loc) = r_split a in let%bind value_expr = match a.rhs with | Expr e -> simpl_expression e - | NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg)) + | NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg)) in match a.lhs with | Path path -> ( diff --git a/src/passes/4-typer/typer.ml b/src/passes/4-typer/typer.ml index 7eba933bf..7acbf5138 100644 --- a/src/passes/4-typer/typer.ml +++ b/src/passes/4-typer/typer.ml @@ -616,7 +616,11 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ()) ) | E_constant ("NONE", []) -> - return (E_constant ("NONE", [])) (t_option_none ()) + let%bind tv_opt = bind_map_option get_t_option tv_opt in + begin match tv_opt with + | None -> fail @@ simple_info "None without a type annotation" + | Some tv -> return (E_constant ("NONE", [])) (t_option tv ()) + end | E_constant (name, lst) -> let%bind lst' = bind_list @@ List.map (type_expression e) lst in let tv_lst = List.map get_type_annotation lst' in @@ -728,7 +732,7 @@ and type_expression : environment -> ?tv_opt:O.type_value -> I.expression -> O.a fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae in bind_fold_list aux (typed_name.type_value , []) path in - let%bind expr' = type_expression e expr in + let%bind expr' = type_expression e ~tv_opt:assign_tv expr in let t_expr' = get_type_annotation expr' in let%bind () = trace_strong (type_error diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index acc4bd7e1..0cef7b26b 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -130,8 +130,6 @@ let rec transpile_type (t:AST.type_value) : type_value result = | T_constant ("option", [o]) -> let%bind o' = transpile_type o in ok (T_option o') - | T_constant ("option_none", []) -> - ok (T_option (T_base Base_unit)) | T_constant (name , _lst) -> fail @@ unrecognized_type_constant name (* TODO hmm *) | T_sum m -> diff --git a/src/passes/6-transpiler/untranspiler.ml b/src/passes/6-transpiler/untranspiler.ml index 08ed0d141..78c41cca8 100644 --- a/src/passes/6-transpiler/untranspiler.ml +++ b/src/passes/6-transpiler/untranspiler.ml @@ -107,14 +107,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression get_string v in return (E_literal (Literal_address n)) ) - | T_constant ("option_none", []) -> - ok e_a_empty_none | T_constant ("option", [o]) -> ( let%bind opt = trace_strong (wrong_mini_c_value "option" v) @@ get_option v in match opt with - | None -> ok e_a_empty_none + | None -> ok (e_a_empty_none o) | Some s -> let%bind s' = untranspile s o in ok (e_a_empty_some s') diff --git a/src/stages/ast_typed/combinators.ml b/src/stages/ast_typed/combinators.ml index 5ae376b9d..d9dcebb73 100644 --- a/src/stages/ast_typed/combinators.ml +++ b/src/stages/ast_typed/combinators.ml @@ -25,7 +25,6 @@ let t_tez ?s () : type_value = make_t (T_constant ("tez", [])) s let t_timestamp ?s () : type_value = make_t (T_constant ("timestamp", [])) s let t_unit ?s () : type_value = make_t (T_constant ("unit", [])) s let t_option o ?s () : type_value = make_t (T_constant ("option", [o])) s -let t_option_none ?s () : type_value = make_t (T_constant ("option_none", [])) s let t_tuple lst ?s () : type_value = make_t (T_tuple lst) s let t_list t ?s () : type_value = make_t (T_constant ("list", [t])) s let t_set t ?s () : type_value = make_t (T_constant ("set", [t])) s @@ -255,7 +254,7 @@ let e_a_address s = make_a_e (e_address s) (t_address ()) let e_a_pair a b = make_a_e (e_pair a b) (t_pair a.type_annotation b.type_annotation ()) let e_a_some s = make_a_e (e_some s) (t_option s.type_annotation ()) let e_a_lambda l in_ty out_ty = make_a_e (e_lambda l) (t_function in_ty out_ty ()) -let e_a_none = make_a_e e_none (t_option_none ()) +let e_a_none t = make_a_e e_none (t_option t ()) let e_a_tuple lst = make_a_e (E_tuple lst) (t_tuple (List.map get_type_annotation lst) ()) let e_a_record r = make_a_e (e_record r) (t_record (SMap.map get_type_annotation r) ()) let e_a_application a b = make_a_e (e_application a b) (get_type_annotation b) diff --git a/src/stages/ast_typed/combinators_environment.ml b/src/stages/ast_typed/combinators_environment.ml index 3cea2fd1d..1446c8780 100644 --- a/src/stages/ast_typed/combinators_environment.ml +++ b/src/stages/ast_typed/combinators_environment.ml @@ -12,7 +12,7 @@ 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_pair a b = e_a_pair a b Environment.full_empty let e_a_empty_some s = e_a_some s Environment.full_empty -let e_a_empty_none = e_a_none Environment.full_empty +let e_a_empty_none t = e_a_none t Environment.full_empty let e_a_empty_tuple lst = e_a_tuple lst Environment.full_empty let e_a_empty_record r = e_a_record r Environment.full_empty let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty diff --git a/src/stages/ast_typed/misc.ml b/src/stages/ast_typed/misc.ml index b7fb63f76..5ba66b4ea 100644 --- a/src/stages/ast_typed/misc.ml +++ b/src/stages/ast_typed/misc.ml @@ -296,9 +296,6 @@ let rec assert_type_value_eq (a, b: (type_value * type_value)) : unit result = m bind_list_iter assert_type_value_eq (List.combine ta tb) ) | T_tuple _, _ -> fail @@ different_kinds a b - | T_constant ("option", _), T_constant ("option_none", []) | - T_constant ("option_none", []), T_constant ("option", _) -> - ok () | T_constant (ca, lsta), T_constant (cb, lstb) -> ( let%bind _ = trace_strong (different_size_constants a b) diff --git a/src/test/contracts/option.ligo b/src/test/contracts/option.ligo index 9abf2c845..d3d1ef36c 100644 --- a/src/test/contracts/option.ligo +++ b/src/test/contracts/option.ligo @@ -8,7 +8,7 @@ const n : foobar = None function assign (var m : int) : foobar is var coco : foobar := None; block -{ +{ coco := Some(m); coco := None; }