Simplify?
This commit is contained in:
parent
3a3cfa341a
commit
3a14ef26ef
@ -591,11 +591,7 @@ assignment:
|
|||||||
in {region; value}}
|
in {region; value}}
|
||||||
|
|
||||||
rhs:
|
rhs:
|
||||||
expr {
|
expr { Expr $1 }
|
||||||
match $1 with
|
|
||||||
EConstr (NoneExpr e) -> (NoneExpr e : rhs)
|
|
||||||
| e -> Expr e
|
|
||||||
}
|
|
||||||
|
|
||||||
lhs:
|
lhs:
|
||||||
path { Path $1 }
|
path { Path $1 }
|
||||||
|
@ -782,7 +782,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu
|
|||||||
let (a , loc) = r_split a in
|
let (a , loc) = r_split a in
|
||||||
let%bind value_expr = match a.rhs with
|
let%bind value_expr = match a.rhs with
|
||||||
| Expr e -> simpl_expression e
|
| Expr e -> simpl_expression e
|
||||||
| NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg))
|
| NoneExpr reg -> simpl_expression (EConstr (NoneExpr reg))
|
||||||
in
|
in
|
||||||
match a.lhs with
|
match a.lhs with
|
||||||
| Path path -> (
|
| Path path -> (
|
||||||
|
@ -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 ())
|
return (E_lambda {binder = fst binder ; body}) (t_function input_type output_type ())
|
||||||
)
|
)
|
||||||
| E_constant ("NONE", []) ->
|
| 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) ->
|
| E_constant (name, lst) ->
|
||||||
let%bind lst' = bind_list @@ List.map (type_expression e) lst in
|
let%bind lst' = bind_list @@ List.map (type_expression e) lst in
|
||||||
let tv_lst = List.map get_type_annotation 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
|
fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
|
||||||
in
|
in
|
||||||
bind_fold_list aux (typed_name.type_value , []) path 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 t_expr' = get_type_annotation expr' in
|
||||||
let%bind () =
|
let%bind () =
|
||||||
trace_strong (type_error
|
trace_strong (type_error
|
||||||
|
@ -130,8 +130,6 @@ let rec transpile_type (t:AST.type_value) : type_value result =
|
|||||||
| T_constant ("option", [o]) ->
|
| T_constant ("option", [o]) ->
|
||||||
let%bind o' = transpile_type o in
|
let%bind o' = transpile_type o in
|
||||||
ok (T_option o')
|
ok (T_option o')
|
||||||
| T_constant ("option_none", []) ->
|
|
||||||
ok (T_option (T_base Base_unit))
|
|
||||||
| T_constant (name , _lst) -> fail @@ unrecognized_type_constant name
|
| T_constant (name , _lst) -> fail @@ unrecognized_type_constant name
|
||||||
(* TODO hmm *)
|
(* TODO hmm *)
|
||||||
| T_sum m ->
|
| T_sum m ->
|
||||||
|
@ -107,14 +107,12 @@ let rec untranspile (v : value) (t : AST.type_value) : AST.annotated_expression
|
|||||||
get_string v in
|
get_string v in
|
||||||
return (E_literal (Literal_address n))
|
return (E_literal (Literal_address n))
|
||||||
)
|
)
|
||||||
| T_constant ("option_none", []) ->
|
|
||||||
ok e_a_empty_none
|
|
||||||
| T_constant ("option", [o]) -> (
|
| T_constant ("option", [o]) -> (
|
||||||
let%bind opt =
|
let%bind opt =
|
||||||
trace_strong (wrong_mini_c_value "option" v) @@
|
trace_strong (wrong_mini_c_value "option" v) @@
|
||||||
get_option v in
|
get_option v in
|
||||||
match opt with
|
match opt with
|
||||||
| None -> ok e_a_empty_none
|
| None -> ok (e_a_empty_none o)
|
||||||
| Some s ->
|
| Some s ->
|
||||||
let%bind s' = untranspile s o in
|
let%bind s' = untranspile s o in
|
||||||
ok (e_a_empty_some s')
|
ok (e_a_empty_some s')
|
||||||
|
@ -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_timestamp ?s () : type_value = make_t (T_constant ("timestamp", [])) s
|
||||||
let t_unit ?s () : type_value = make_t (T_constant ("unit", [])) 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 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_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_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
|
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_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_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_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_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_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)
|
let e_a_application a b = make_a_e (e_application a b) (get_type_annotation b)
|
||||||
|
@ -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_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_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_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_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_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
|
let e_a_empty_map lst k v = e_a_map lst k v Environment.full_empty
|
||||||
|
@ -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)
|
bind_list_iter assert_type_value_eq (List.combine ta tb)
|
||||||
)
|
)
|
||||||
| T_tuple _, _ -> fail @@ different_kinds a b
|
| 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) -> (
|
| T_constant (ca, lsta), T_constant (cb, lstb) -> (
|
||||||
let%bind _ =
|
let%bind _ =
|
||||||
trace_strong (different_size_constants a b)
|
trace_strong (different_size_constants a b)
|
||||||
|
@ -8,7 +8,7 @@ const n : foobar = None
|
|||||||
function assign (var m : int) : foobar is
|
function assign (var m : int) : foobar is
|
||||||
var coco : foobar := None;
|
var coco : foobar := None;
|
||||||
block
|
block
|
||||||
{
|
{
|
||||||
coco := Some(m);
|
coco := Some(m);
|
||||||
coco := None;
|
coco := None;
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user