remove match_bool from the ast
This commit is contained in:
parent
f4deb32561
commit
2c62f9d32e
@ -342,6 +342,9 @@ and eval : Ast_typed.expression -> env -> value result
|
|||||||
let {hd;tl;body;tv=_} = cases.match_cons in
|
let {hd;tl;body;tv=_} = cases.match_cons in
|
||||||
let env' = Env.extend (Env.extend env (hd,head)) (tl, V_List tail) in
|
let env' = Env.extend (Env.extend env (hd,head)) (tl, V_List tail) in
|
||||||
eval body env'
|
eval body env'
|
||||||
|
| Match_variant {cases=[{constructor=Constructor "true";body=match_true};{constructor=Constructor "false"; body=match_false}];_}, V_Ct (C_bool b) ->
|
||||||
|
if b then eval match_true env
|
||||||
|
else eval match_false env
|
||||||
| Match_variant {cases ; tv=_} , V_Construct (matched_c , proj) ->
|
| Match_variant {cases ; tv=_} , V_Construct (matched_c , proj) ->
|
||||||
let {constructor=_ ; pattern ; body} =
|
let {constructor=_ ; pattern ; body} =
|
||||||
List.find
|
List.find
|
||||||
@ -350,10 +353,6 @@ and eval : Ast_typed.expression -> env -> value result
|
|||||||
cases in
|
cases in
|
||||||
let env' = Env.extend env (pattern, proj) in
|
let env' = Env.extend env (pattern, proj) in
|
||||||
eval body env'
|
eval body env'
|
||||||
| Match_bool cases , V_Ct (C_bool true) ->
|
|
||||||
eval cases.match_true env
|
|
||||||
| Match_bool cases , V_Ct (C_bool false) ->
|
|
||||||
eval cases.match_false env
|
|
||||||
| Match_option cases, V_Construct ("Some" , proj) ->
|
| Match_option cases, V_Construct ("Some" , proj) ->
|
||||||
let {opt;body;tv=_} = cases.match_some in
|
let {opt;body;tv=_} = cases.match_some in
|
||||||
let env' = Env.extend env (opt,proj) in
|
let env' = Env.extend env (opt,proj) in
|
||||||
|
@ -560,9 +560,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
|
|||||||
| E_matching {matchee=expr; cases=m} -> (
|
| E_matching {matchee=expr; cases=m} -> (
|
||||||
let%bind expr' = transpile_annotated_expression expr in
|
let%bind expr' = transpile_annotated_expression expr in
|
||||||
match m with
|
match m with
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
let%bind (t , f) = bind_map_pair (transpile_annotated_expression) (match_true, match_false) in
|
|
||||||
return @@ E_if_bool (expr', t, f)
|
|
||||||
| Match_option { match_none; match_some = {opt; body; tv} } ->
|
| Match_option { match_none; match_some = {opt; body; tv} } ->
|
||||||
let%bind n = transpile_annotated_expression match_none in
|
let%bind n = transpile_annotated_expression match_none in
|
||||||
let%bind (tv' , s') =
|
let%bind (tv' , s') =
|
||||||
@ -583,6 +580,9 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
|
|||||||
in
|
in
|
||||||
return @@ E_if_cons (expr' , nil , cons)
|
return @@ E_if_cons (expr' , nil , cons)
|
||||||
)
|
)
|
||||||
|
| Match_variant {cases=[{constructor=Constructor "true";body=match_true};{constructor=Constructor "false";body=match_false}];_} ->
|
||||||
|
let%bind (t , f) = bind_map_pair (transpile_annotated_expression) (match_true, match_false) in
|
||||||
|
return @@ E_if_bool (expr', t, f)
|
||||||
| Match_variant {cases ; tv} -> (
|
| Match_variant {cases ; tv} -> (
|
||||||
let%bind tree =
|
let%bind tree =
|
||||||
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
|
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
|
||||||
@ -683,9 +683,6 @@ and transpile_recursive {fun_name; fun_type; lambda} =
|
|||||||
let return ret = ok @@ Expression.make ret @@ ty in
|
let return ret = ok @@ Expression.make ret @@ ty in
|
||||||
let%bind expr = transpile_annotated_expression m.matchee in
|
let%bind expr = transpile_annotated_expression m.matchee in
|
||||||
match m.cases with
|
match m.cases with
|
||||||
Match_bool {match_true; match_false} ->
|
|
||||||
let%bind (t , f) = bind_map_pair (replace_callback fun_name loop_type shadowed) (match_true, match_false) in
|
|
||||||
return @@ E_if_bool (expr, t, f)
|
|
||||||
| Match_option { match_none; match_some = {opt; body; tv} } ->
|
| Match_option { match_none; match_some = {opt; body; tv} } ->
|
||||||
let%bind n = replace_callback fun_name loop_type shadowed match_none in
|
let%bind n = replace_callback fun_name loop_type shadowed match_none in
|
||||||
let%bind (tv' , s') =
|
let%bind (tv' , s') =
|
||||||
@ -706,6 +703,9 @@ and transpile_recursive {fun_name; fun_type; lambda} =
|
|||||||
in
|
in
|
||||||
return @@ E_if_cons (expr , nil , cons)
|
return @@ E_if_cons (expr , nil , cons)
|
||||||
)
|
)
|
||||||
|
| Match_variant {cases=[{constructor=Constructor "true";body=match_true};{constructor=Constructor "false";body=match_false}];_} ->
|
||||||
|
let%bind (t , f) = bind_map_pair (replace_callback fun_name loop_type shadowed) (match_true, match_false) in
|
||||||
|
return @@ E_if_bool (expr, t, f)
|
||||||
| Match_variant {cases;tv} -> (
|
| Match_variant {cases;tv} -> (
|
||||||
let%bind tree =
|
let%bind tree =
|
||||||
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
|
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
|
||||||
|
@ -1026,7 +1026,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
|
|||||||
match patterns with
|
match patterns with
|
||||||
| [(PFalse _, f) ; (PTrue _, t)]
|
| [(PFalse _, f) ; (PTrue _, t)]
|
||||||
| [(PTrue _, t) ; (PFalse _, f)] ->
|
| [(PTrue _, t) ; (PFalse _, f)] ->
|
||||||
ok @@ Match_bool {match_true = t ; match_false = f}
|
ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)], ())
|
||||||
| [(PList (PCons c), cons); (PList (PListComp sugar_nil), nil)]
|
| [(PList (PCons c), cons); (PList (PListComp sugar_nil), nil)]
|
||||||
| [(PList (PListComp sugar_nil), nil); (PList (PCons c), cons)] ->
|
| [(PList (PListComp sugar_nil), nil); (PList (PCons c), cons)] ->
|
||||||
let%bind () =
|
let%bind () =
|
||||||
|
@ -1056,7 +1056,7 @@ and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fu
|
|||||||
match patterns with
|
match patterns with
|
||||||
| [(PConstr PFalse _ , f) ; (PConstr PTrue _ , t)]
|
| [(PConstr PFalse _ , f) ; (PConstr PTrue _ , t)]
|
||||||
| [(PConstr PTrue _ , t) ; (PConstr PFalse _ , f)] ->
|
| [(PConstr PTrue _ , t) ; (PConstr PFalse _ , f)] ->
|
||||||
ok @@ Match_bool {match_true = t ; match_false = f}
|
ok @@ Match_variant ([((Constructor "true", Var.of_name "_"), t); ((Constructor "false", Var.of_name "_"), f)], ())
|
||||||
| [(PConstr PSomeApp v , some) ; (PConstr PNone _ , none)]
|
| [(PConstr PSomeApp v , some) ; (PConstr PNone _ , none)]
|
||||||
| [(PConstr PNone _ , none) ; (PConstr PSomeApp v , some)] -> (
|
| [(PConstr PNone _ , none) ; (PConstr PSomeApp v , some)] -> (
|
||||||
let (_, v) = v.value in
|
let (_, v) = v.value in
|
||||||
|
@ -104,11 +104,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
|
|||||||
|
|
||||||
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind res = fold_expression f init match_true in
|
|
||||||
let%bind res = fold_expression f res match_false in
|
|
||||||
ok res
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
|
||||||
let%bind res = fold_expression f init match_nil in
|
let%bind res = fold_expression f init match_nil in
|
||||||
let%bind res = fold_expression f res cons in
|
let%bind res = fold_expression f res cons in
|
||||||
@ -272,11 +267,6 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
|
|||||||
|
|
||||||
and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
|
and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind match_true = map_expression f match_true in
|
|
||||||
let%bind match_false = map_expression f match_false in
|
|
||||||
ok @@ Match_bool { match_true ; match_false }
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
||||||
let%bind match_nil = map_expression f match_nil in
|
let%bind match_nil = map_expression f match_nil in
|
||||||
let%bind cons = map_expression f cons in
|
let%bind cons = map_expression f cons in
|
||||||
@ -433,11 +423,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
|
|||||||
|
|
||||||
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind (init, match_true) = fold_map_expression f init match_true in
|
|
||||||
let%bind (init, match_false) = fold_map_expression f init match_false in
|
|
||||||
ok @@ (init, Match_bool { match_true ; match_false })
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
||||||
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
||||||
let%bind (init, cons) = fold_map_expression f init cons in
|
let%bind (init, cons) = fold_map_expression f init cons in
|
||||||
|
@ -381,26 +381,6 @@ and compile_matching : I.matching -> (O.expression option -> O.expression) resul
|
|||||||
in
|
in
|
||||||
let%bind matchee = compile_expression matchee in
|
let%bind matchee = compile_expression matchee in
|
||||||
match cases with
|
match cases with
|
||||||
| I.Match_bool {match_true;match_false} ->
|
|
||||||
let%bind match_true' = compile_expression match_true in
|
|
||||||
let%bind match_false' = compile_expression match_false in
|
|
||||||
let env = Var.fresh () in
|
|
||||||
let%bind ((_,free_vars_true), match_true) = repair_mutable_variable_in_matching match_true' [] env in
|
|
||||||
let%bind ((_,free_vars_false), match_false) = repair_mutable_variable_in_matching match_false' [] env in
|
|
||||||
let match_true = add_to_end match_true (O.e_variable env) in
|
|
||||||
let match_false = add_to_end match_false (O.e_variable env) in
|
|
||||||
|
|
||||||
let free_vars = List.sort_uniq Var.compare @@ free_vars_true @ free_vars_false in
|
|
||||||
if (List.length free_vars != 0) then
|
|
||||||
let match_expr = O.e_matching matchee (O.Match_bool {match_true; match_false}) in
|
|
||||||
let return_expr = fun expr ->
|
|
||||||
O.e_let_in (env,None) false false (store_mutable_variable free_vars) @@
|
|
||||||
O.e_let_in (env,None) false false match_expr @@
|
|
||||||
expr
|
|
||||||
in
|
|
||||||
ok @@ restore_mutable_variable return_expr free_vars env
|
|
||||||
else
|
|
||||||
return @@ O.e_matching matchee @@ O.Match_bool {match_true=match_true';match_false=match_false'}
|
|
||||||
| I.Match_option {match_none;match_some} ->
|
| I.Match_option {match_none;match_some} ->
|
||||||
let%bind match_none' = compile_expression match_none in
|
let%bind match_none' = compile_expression match_none in
|
||||||
let (n,expr,tv) = match_some in
|
let (n,expr,tv) = match_some in
|
||||||
@ -765,10 +745,6 @@ and uncompile_lambda : O.lambda -> I.lambda result =
|
|||||||
and uncompile_matching : O.matching_expr -> I.matching_expr result =
|
and uncompile_matching : O.matching_expr -> I.matching_expr result =
|
||||||
fun m ->
|
fun m ->
|
||||||
match m with
|
match m with
|
||||||
| O.Match_bool {match_true;match_false} ->
|
|
||||||
let%bind match_true = uncompile_expression' match_true in
|
|
||||||
let%bind match_false = uncompile_expression' match_false in
|
|
||||||
ok @@ I.Match_bool {match_true;match_false}
|
|
||||||
| O.Match_list {match_nil;match_cons} ->
|
| O.Match_list {match_nil;match_cons} ->
|
||||||
let%bind match_nil = uncompile_expression' match_nil in
|
let%bind match_nil = uncompile_expression' match_nil in
|
||||||
let (hd,tl,expr,tv) = match_cons in
|
let (hd,tl,expr,tv) = match_cons in
|
||||||
|
@ -103,11 +103,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
|
|||||||
|
|
||||||
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind res = fold_expression f init match_true in
|
|
||||||
let%bind res = fold_expression f res match_false in
|
|
||||||
ok res
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
|
||||||
let%bind res = fold_expression f init match_nil in
|
let%bind res = fold_expression f init match_nil in
|
||||||
let%bind res = fold_expression f res cons in
|
let%bind res = fold_expression f res cons in
|
||||||
@ -255,11 +250,6 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
|
|||||||
|
|
||||||
and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
|
and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind match_true = map_expression f match_true in
|
|
||||||
let%bind match_false = map_expression f match_false in
|
|
||||||
ok @@ Match_bool { match_true ; match_false }
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
||||||
let%bind match_nil = map_expression f match_nil in
|
let%bind match_nil = map_expression f match_nil in
|
||||||
let%bind cons = map_expression f cons in
|
let%bind cons = map_expression f cons in
|
||||||
@ -402,11 +392,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
|
|||||||
|
|
||||||
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind (init, match_true) = fold_map_expression f init match_true in
|
|
||||||
let%bind (init, match_false) = fold_map_expression f init match_false in
|
|
||||||
ok @@ (init, Match_bool { match_true ; match_false })
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
||||||
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
||||||
let%bind (init, cons) = fold_map_expression f init cons in
|
let%bind (init, cons) = fold_map_expression f init cons in
|
||||||
|
@ -159,7 +159,7 @@ let rec compile_expression : I.expression -> O.expression result =
|
|||||||
let%bind matchee = compile_expression condition in
|
let%bind matchee = compile_expression condition in
|
||||||
let%bind match_true = compile_expression then_clause in
|
let%bind match_true = compile_expression then_clause in
|
||||||
let%bind match_false = compile_expression else_clause in
|
let%bind match_false = compile_expression else_clause in
|
||||||
return @@ O.E_matching {matchee; cases=Match_bool{match_true;match_false}}
|
return @@ O.E_matching {matchee; cases=Match_variant ([((Constructor "true", Var.of_name "_"),match_true);((Constructor "false", Var.of_name "_"), match_false)],())}
|
||||||
| I.E_sequence {expr1; expr2} ->
|
| I.E_sequence {expr1; expr2} ->
|
||||||
let%bind expr1 = compile_expression expr1 in
|
let%bind expr1 = compile_expression expr1 in
|
||||||
let%bind expr2 = compile_expression expr2 in
|
let%bind expr2 = compile_expression expr2 in
|
||||||
@ -191,10 +191,6 @@ and compile_lambda : I.lambda -> O.lambda result =
|
|||||||
and compile_matching : I.matching_expr -> O.matching_expr result =
|
and compile_matching : I.matching_expr -> O.matching_expr result =
|
||||||
fun m ->
|
fun m ->
|
||||||
match m with
|
match m with
|
||||||
| I.Match_bool {match_true;match_false} ->
|
|
||||||
let%bind match_true = compile_expression match_true in
|
|
||||||
let%bind match_false = compile_expression match_false in
|
|
||||||
ok @@ O.Match_bool {match_true;match_false}
|
|
||||||
| I.Match_list {match_nil;match_cons} ->
|
| I.Match_list {match_nil;match_cons} ->
|
||||||
let%bind match_nil = compile_expression match_nil in
|
let%bind match_nil = compile_expression match_nil in
|
||||||
let (hd,tl,expr,tv) = match_cons in
|
let (hd,tl,expr,tv) = match_cons in
|
||||||
@ -360,10 +356,6 @@ and uncompile_lambda : O.lambda -> I.lambda result =
|
|||||||
and uncompile_matching : O.matching_expr -> I.matching_expr result =
|
and uncompile_matching : O.matching_expr -> I.matching_expr result =
|
||||||
fun m ->
|
fun m ->
|
||||||
match m with
|
match m with
|
||||||
| O.Match_bool {match_true;match_false} ->
|
|
||||||
let%bind match_true = uncompile_expression match_true in
|
|
||||||
let%bind match_false = uncompile_expression match_false in
|
|
||||||
ok @@ I.Match_bool {match_true;match_false}
|
|
||||||
| O.Match_list {match_nil;match_cons} ->
|
| O.Match_list {match_nil;match_cons} ->
|
||||||
let%bind match_nil = uncompile_expression match_nil in
|
let%bind match_nil = uncompile_expression match_nil in
|
||||||
let (hd,tl,expr,tv) = match_cons in
|
let (hd,tl,expr,tv) = match_cons in
|
||||||
|
@ -72,11 +72,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
|
|||||||
|
|
||||||
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind res = fold_expression f init match_true in
|
|
||||||
let%bind res = fold_expression f res match_false in
|
|
||||||
ok res
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (_ , _ , cons, _) } -> (
|
||||||
let%bind res = fold_expression f init match_nil in
|
let%bind res = fold_expression f init match_nil in
|
||||||
let%bind res = fold_expression f res cons in
|
let%bind res = fold_expression f res cons in
|
||||||
@ -179,11 +174,6 @@ and map_type_expression : ty_exp_mapper -> type_expression -> type_expression re
|
|||||||
|
|
||||||
and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
|
and map_cases : exp_mapper -> matching_expr -> matching_expr result = fun f m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind match_true = map_expression f match_true in
|
|
||||||
let%bind match_false = map_expression f match_false in
|
|
||||||
ok @@ Match_bool { match_true ; match_false }
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
||||||
let%bind match_nil = map_expression f match_nil in
|
let%bind match_nil = map_expression f match_nil in
|
||||||
let%bind cons = map_expression f cons in
|
let%bind cons = map_expression f cons in
|
||||||
@ -284,11 +274,6 @@ let rec fold_map_expression : 'a fold_mapper -> 'a -> expression -> ('a * expres
|
|||||||
|
|
||||||
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
and fold_map_cases : 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind (init, match_true) = fold_map_expression f init match_true in
|
|
||||||
let%bind (init, match_false) = fold_map_expression f init match_false in
|
|
||||||
ok @@ (init, Match_bool { match_true ; match_false })
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
| Match_list { match_nil ; match_cons = (hd , tl , cons, _) } -> (
|
||||||
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
||||||
let%bind (init, cons) = fold_map_expression f init cons in
|
let%bind (init, cons) = fold_map_expression f init cons in
|
||||||
|
@ -34,13 +34,6 @@ let rec type_declaration env state : I.declaration -> (environment * O.typer_sta
|
|||||||
|
|
||||||
and type_match : environment -> O.typer_state -> O.type_expression -> I.matching_expr -> I.expression -> Location.t -> (O.matching_expr * O.typer_state) result =
|
and type_match : environment -> O.typer_state -> O.type_expression -> I.matching_expr -> I.expression -> Location.t -> (O.matching_expr * O.typer_state) result =
|
||||||
fun e state t i ae loc -> match i with
|
fun e state t i ae loc -> match i with
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
let%bind _ =
|
|
||||||
trace_strong (match_error ~expected:i ~actual:t loc)
|
|
||||||
@@ get_t_bool t in
|
|
||||||
let%bind (match_true , state') = type_expression e state match_true in
|
|
||||||
let%bind (match_false , state'') = type_expression e state' match_false in
|
|
||||||
ok (O.Match_bool {match_true ; match_false} , state'')
|
|
||||||
| Match_option {match_none ; match_some} ->
|
| Match_option {match_none ; match_some} ->
|
||||||
let%bind tv =
|
let%bind tv =
|
||||||
trace_strong (match_error ~expected:i ~actual:t loc)
|
trace_strong (match_error ~expected:i ~actual:t loc)
|
||||||
@ -361,7 +354,6 @@ and type_expression : environment -> O.typer_state -> ?tv_opt:O.type_expression
|
|||||||
let tvs =
|
let tvs =
|
||||||
let aux (cur : O.matching_expr) =
|
let aux (cur : O.matching_expr) =
|
||||||
match cur with
|
match cur with
|
||||||
| Match_bool { match_true ; match_false } -> [ match_true ; match_false ]
|
|
||||||
| Match_list { match_nil ; match_cons = { hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
|
| Match_list { match_nil ; match_cons = { hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
|
||||||
| Match_option { match_none ; match_some = {opt=_; body; tv=_} } -> [ match_none ; body ]
|
| Match_option { match_none ; match_some = {opt=_; body; tv=_} } -> [ match_none ; body ]
|
||||||
| Match_tuple { vars=_ ; body ; tvs=_ } -> [ body ]
|
| Match_tuple { vars=_ ; body ; tvs=_ } -> [ body ]
|
||||||
|
@ -295,10 +295,6 @@ and untype_lambda ty {binder; result} : I.lambda result =
|
|||||||
and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
|
and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
|
||||||
let open I in
|
let open I in
|
||||||
match m with
|
match m with
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
let%bind match_true = f match_true in
|
|
||||||
let%bind match_false = f match_false in
|
|
||||||
ok @@ Match_bool {match_true ; match_false}
|
|
||||||
| Match_tuple { vars ; body ; tvs=_ } ->
|
| Match_tuple { vars ; body ; tvs=_ } ->
|
||||||
let%bind b = f body in
|
let%bind b = f body in
|
||||||
ok @@ I.Match_tuple ((vars, b),[])
|
ok @@ I.Match_tuple ((vars, b),[])
|
||||||
|
@ -496,13 +496,6 @@ and type_declaration env (_placeholder_for_state_of_new_typer : O.typer_state) :
|
|||||||
|
|
||||||
and type_match : (environment -> I.expression -> O.expression result) -> environment -> O.type_expression -> I.matching_expr -> I.expression -> Location.t -> O.matching_expr result =
|
and type_match : (environment -> I.expression -> O.expression result) -> environment -> O.type_expression -> I.matching_expr -> I.expression -> Location.t -> O.matching_expr result =
|
||||||
fun f e t i ae loc -> match i with
|
fun f e t i ae loc -> match i with
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
let%bind _ =
|
|
||||||
trace_strong (match_error ~expected:i ~actual:t loc)
|
|
||||||
@@ get_t_bool t in
|
|
||||||
let%bind match_true = f e match_true in
|
|
||||||
let%bind match_false = f e match_false in
|
|
||||||
ok (O.Match_bool {match_true ; match_false})
|
|
||||||
| Match_option {match_none ; match_some} ->
|
| Match_option {match_none ; match_some} ->
|
||||||
let%bind tv =
|
let%bind tv =
|
||||||
trace_strong (match_error ~expected:i ~actual:t loc)
|
trace_strong (match_error ~expected:i ~actual:t loc)
|
||||||
@ -911,7 +904,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
|
|||||||
let tvs =
|
let tvs =
|
||||||
let aux (cur:O.matching_expr) =
|
let aux (cur:O.matching_expr) =
|
||||||
match cur with
|
match cur with
|
||||||
| Match_bool { match_true ; match_false } -> [ match_true ; match_false ]
|
|
||||||
| Match_list { match_nil ; match_cons = {hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
|
| Match_list { match_nil ; match_cons = {hd=_ ; tl=_ ; body ; tv=_} } -> [ match_nil ; body ]
|
||||||
| Match_option { match_none ; match_some = {opt=_ ; body ; tv=_ } } -> [ match_none ; body ]
|
| Match_option { match_none ; match_some = {opt=_ ; body ; tv=_ } } -> [ match_none ; body ]
|
||||||
| Match_tuple {vars=_;body;tvs=_} -> [ body ]
|
| Match_tuple {vars=_;body;tvs=_} -> [ body ]
|
||||||
@ -1081,10 +1073,6 @@ let rec untype_expression (e:O.expression) : (I.expression) result =
|
|||||||
and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
|
and untype_matching : (O.expression -> I.expression result) -> O.matching_expr -> I.matching_expr result = fun f m ->
|
||||||
let open I in
|
let open I in
|
||||||
match m with
|
match m with
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
let%bind match_true = f match_true in
|
|
||||||
let%bind match_false = f match_false in
|
|
||||||
ok @@ Match_bool {match_true ; match_false}
|
|
||||||
| Match_tuple {vars; body;tvs=_} ->
|
| Match_tuple {vars; body;tvs=_} ->
|
||||||
let%bind b = f body in
|
let%bind b = f body in
|
||||||
ok @@ I.Match_tuple ((vars, b),[])
|
ok @@ I.Match_tuple ((vars, b),[])
|
||||||
|
@ -53,11 +53,6 @@ let rec fold_expression : 'a . 'a folder -> 'a -> expression -> 'a result = fun
|
|||||||
|
|
||||||
and fold_cases : 'a . 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
and fold_cases : 'a . 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind res = fold_expression f init match_true in
|
|
||||||
let%bind res = fold_expression f res match_false in
|
|
||||||
ok res
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = {hd=_; tl=_ ; body; tv=_} } -> (
|
| Match_list { match_nil ; match_cons = {hd=_; tl=_ ; body; tv=_} } -> (
|
||||||
let%bind res = fold_expression f init match_nil in
|
let%bind res = fold_expression f init match_nil in
|
||||||
let%bind res = fold_expression f res body in
|
let%bind res = fold_expression f res body in
|
||||||
@ -135,11 +130,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
|
|||||||
|
|
||||||
and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
|
and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind match_true = map_expression f match_true in
|
|
||||||
let%bind match_false = map_expression f match_false in
|
|
||||||
ok @@ Match_bool { match_true ; match_false }
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = {hd ; tl ; body ; tv} } -> (
|
| Match_list { match_nil ; match_cons = {hd ; tl ; body ; tv} } -> (
|
||||||
let%bind match_nil = map_expression f match_nil in
|
let%bind match_nil = map_expression f match_nil in
|
||||||
let%bind body = map_expression f body in
|
let%bind body = map_expression f body in
|
||||||
@ -230,11 +220,6 @@ let rec fold_map_expression : 'a . 'a fold_mapper -> 'a -> expression -> ('a * e
|
|||||||
|
|
||||||
and fold_map_cases : 'a . 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
and fold_map_cases : 'a . 'a fold_mapper -> 'a -> matching_expr -> ('a * matching_expr) result = fun f init m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true ; match_false } -> (
|
|
||||||
let%bind (init, match_true) = fold_map_expression f init match_true in
|
|
||||||
let%bind (init, match_false) = fold_map_expression f init match_false in
|
|
||||||
ok @@ (init, Match_bool { match_true ; match_false })
|
|
||||||
)
|
|
||||||
| Match_list { match_nil ; match_cons = { hd ; tl ; body ; tv } } -> (
|
| Match_list { match_nil ; match_cons = { hd ; tl ; body ; tv } } -> (
|
||||||
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
let%bind (init, match_nil) = fold_map_expression f init match_nil in
|
||||||
let%bind (init, body) = fold_map_expression f init body in
|
let%bind (init, body) = fold_map_expression f init body in
|
||||||
|
@ -59,10 +59,6 @@ let rec check_recursive_call : expression_variable -> bool -> expression -> unit
|
|||||||
|
|
||||||
and check_recursive_call_in_matching = fun n final_path c ->
|
and check_recursive_call_in_matching = fun n final_path c ->
|
||||||
match c with
|
match c with
|
||||||
| Match_bool {match_true;match_false} ->
|
|
||||||
let%bind _ = check_recursive_call n final_path match_true in
|
|
||||||
let%bind _ = check_recursive_call n final_path match_false in
|
|
||||||
ok ()
|
|
||||||
| Match_list {match_nil;match_cons={hd=_;tl=_;body;tv=_}} ->
|
| Match_list {match_nil;match_cons={hd=_;tl=_;body;tv=_}} ->
|
||||||
let%bind _ = check_recursive_call n final_path match_nil in
|
let%bind _ = check_recursive_call n final_path match_nil in
|
||||||
let%bind _ = check_recursive_call n final_path body in
|
let%bind _ = check_recursive_call n final_path body in
|
||||||
|
@ -183,8 +183,6 @@ and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matchi
|
|||||||
fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
|
fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
|
||||||
| Match_variant (lst, _) ->
|
| Match_variant (lst, _) ->
|
||||||
fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
|
fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false
|
|
||||||
| Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
|
| Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
|
||||||
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
|
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
|
||||||
| Match_option {match_none ; match_some = (some, match_some, _)} ->
|
| Match_option {match_none ; match_some = (some, match_some, _)} ->
|
||||||
@ -196,8 +194,6 @@ and matching_type ppf m = match m with
|
|||||||
fprintf ppf "tuple"
|
fprintf ppf "tuple"
|
||||||
| Match_variant (lst, _) ->
|
| Match_variant (lst, _) ->
|
||||||
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
|
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
|
||||||
| Match_bool _ ->
|
|
||||||
fprintf ppf "boolean"
|
|
||||||
| Match_list _ ->
|
| Match_list _ ->
|
||||||
fprintf ppf "list"
|
fprintf ppf "list"
|
||||||
| Match_option _ ->
|
| Match_option _ ->
|
||||||
|
@ -150,8 +150,6 @@ and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matchi
|
|||||||
fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
|
fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) lst f b
|
||||||
| Match_variant (lst, _) ->
|
| Match_variant (lst, _) ->
|
||||||
fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
|
fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) lst
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false
|
|
||||||
| Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
|
| Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
|
||||||
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
|
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f match_cons
|
||||||
| Match_option {match_none ; match_some = (some, match_some, _)} ->
|
| Match_option {match_none ; match_some = (some, match_some, _)} ->
|
||||||
@ -163,8 +161,6 @@ and matching_type ppf m = match m with
|
|||||||
fprintf ppf "tuple"
|
fprintf ppf "tuple"
|
||||||
| Match_variant (lst, _) ->
|
| Match_variant (lst, _) ->
|
||||||
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
|
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
|
||||||
| Match_bool _ ->
|
|
||||||
fprintf ppf "boolean"
|
|
||||||
| Match_list _ ->
|
| Match_list _ ->
|
||||||
fprintf ppf "list"
|
fprintf ppf "list"
|
||||||
| Match_option _ ->
|
| Match_option _ ->
|
||||||
|
@ -76,8 +76,6 @@ and matching : type a . (formatter -> a -> unit) -> formatter -> (a,unit) matchi
|
|||||||
fprintf ppf "@[<hv>| (%a) ->@;<1 2>%a@]" (list_sep_d expression_variable) lst f b
|
fprintf ppf "@[<hv>| (%a) ->@;<1 2>%a@]" (list_sep_d expression_variable) lst f b
|
||||||
| Match_variant (lst, _) ->
|
| Match_variant (lst, _) ->
|
||||||
fprintf ppf "@[<hv>%a@]" (list_sep (matching_variant_case f) (tag "@ ")) lst
|
fprintf ppf "@[<hv>%a@]" (list_sep (matching_variant_case f) (tag "@ ")) lst
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
fprintf ppf "@[<hv>| True ->@;<1 2>%a@ | False ->@;<1 2>%a@]" f match_true f match_false
|
|
||||||
| Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
|
| Match_list {match_nil ; match_cons = (hd, tl, match_cons, _)} ->
|
||||||
fprintf ppf "@[<hv>| Nil ->@;<1 2>%a@ | %a :: %a ->@;<1 2>%a@]" f match_nil expression_variable hd expression_variable tl f match_cons
|
fprintf ppf "@[<hv>| Nil ->@;<1 2>%a@ | %a :: %a ->@;<1 2>%a@]" f match_nil expression_variable hd expression_variable tl f match_cons
|
||||||
| Match_option {match_none ; match_some = (some, match_some, _)} ->
|
| Match_option {match_none ; match_some = (some, match_some, _)} ->
|
||||||
@ -89,8 +87,6 @@ and matching_type ppf m = match m with
|
|||||||
fprintf ppf "tuple"
|
fprintf ppf "tuple"
|
||||||
| Match_variant (lst, _) ->
|
| Match_variant (lst, _) ->
|
||||||
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
|
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
|
||||||
| Match_bool _ ->
|
|
||||||
fprintf ppf "boolean"
|
|
||||||
| Match_list _ ->
|
| Match_list _ ->
|
||||||
fprintf ppf "list"
|
fprintf ppf "list"
|
||||||
| Match_option _ ->
|
| Match_option _ ->
|
||||||
|
@ -315,8 +315,6 @@ and matching : (formatter -> expression -> unit) -> _ -> matching_expr -> unit =
|
|||||||
fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) vars f body
|
fprintf ppf "let (%a) = %a" (list_sep_d expression_variable) vars f body
|
||||||
| Match_variant {cases ; tv=_} ->
|
| Match_variant {cases ; tv=_} ->
|
||||||
fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) cases
|
fprintf ppf "%a" (list_sep (matching_variant_case f) (tag "@.")) cases
|
||||||
| Match_bool {match_true ; match_false} ->
|
|
||||||
fprintf ppf "| True -> %a @.| False -> %a" f match_true f match_false
|
|
||||||
| Match_list {match_nil ; match_cons = {hd; tl; body; tv=_}} ->
|
| Match_list {match_nil ; match_cons = {hd; tl; body; tv=_}} ->
|
||||||
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f body
|
fprintf ppf "| Nil -> %a @.| %a :: %a -> %a" f match_nil expression_variable hd expression_variable tl f body
|
||||||
| Match_option {match_none ; match_some = {opt; body; tv=_}} ->
|
| Match_option {match_none ; match_some = {opt; body; tv=_}} ->
|
||||||
|
@ -234,7 +234,6 @@ module Free_variables = struct
|
|||||||
|
|
||||||
and matching : (bindings -> expression -> bindings) -> bindings -> matching_expr -> bindings = fun f b m ->
|
and matching : (bindings -> expression -> bindings) -> bindings -> matching_expr -> bindings = fun f b m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true = t ; match_false = fa } -> union (f b t) (f b fa)
|
|
||||||
| Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } -> union (f b n) (f (union (of_list [hd ; tl]) b) body)
|
| Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } -> union (f b n) (f (union (of_list [hd ; tl]) b) body)
|
||||||
| Match_option { match_none = n ; match_some = {opt; body; tv=_} } -> union (f b n) (f (union (singleton opt) b) body)
|
| Match_option { match_none = n ; match_some = {opt; body; tv=_} } -> union (f b n) (f (union (singleton opt) b) body)
|
||||||
| Match_tuple { vars ; body ; tvs=_ } ->
|
| Match_tuple { vars ; body ; tvs=_ } ->
|
||||||
|
@ -91,10 +91,6 @@ module Captured_variables = struct
|
|||||||
|
|
||||||
and matching : (bindings -> expression -> bindings result) -> bindings -> matching_expr -> bindings result = fun f b m ->
|
and matching : (bindings -> expression -> bindings result) -> bindings -> matching_expr -> bindings result = fun f b m ->
|
||||||
match m with
|
match m with
|
||||||
| Match_bool { match_true = t ; match_false = fa } ->
|
|
||||||
let%bind t' = f b t in
|
|
||||||
let%bind fa' = f b fa in
|
|
||||||
ok @@ union t' fa'
|
|
||||||
| Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } ->
|
| Match_list { match_nil = n ; match_cons = {hd; tl; body; tv=_} } ->
|
||||||
let%bind n' = f b n in
|
let%bind n' = f b n in
|
||||||
let%bind c' = f (union (of_list [hd ; tl]) b) body in
|
let%bind c' = f (union (of_list [hd ; tl]) b) body in
|
||||||
|
@ -88,10 +88,6 @@ type literal =
|
|||||||
| Literal_void
|
| Literal_void
|
||||||
| Literal_operation of packed_internal_operation
|
| Literal_operation of packed_internal_operation
|
||||||
|
|
||||||
type matching_content_bool = {
|
|
||||||
match_true : expression ;
|
|
||||||
match_false : expression ;
|
|
||||||
}
|
|
||||||
|
|
||||||
and matching_content_cons = {
|
and matching_content_cons = {
|
||||||
hd : expression_variable;
|
hd : expression_variable;
|
||||||
@ -139,7 +135,6 @@ and matching_content_variant = {
|
|||||||
}
|
}
|
||||||
|
|
||||||
and matching_expr =
|
and matching_expr =
|
||||||
| Match_bool of matching_content_bool
|
|
||||||
| Match_list of matching_content_list
|
| Match_list of matching_content_list
|
||||||
| Match_option of matching_content_option
|
| Match_option of matching_content_option
|
||||||
| Match_tuple of matching_content_tuple
|
| Match_tuple of matching_content_tuple
|
||||||
|
@ -169,10 +169,6 @@ type literal =
|
|||||||
| Literal_operation of
|
| Literal_operation of
|
||||||
Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
|
Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
|
||||||
and ('a,'tv) matching_content =
|
and ('a,'tv) matching_content =
|
||||||
| Match_bool of {
|
|
||||||
match_true : 'a ;
|
|
||||||
match_false : 'a ;
|
|
||||||
}
|
|
||||||
| Match_list of {
|
| Match_list of {
|
||||||
match_nil : 'a ;
|
match_nil : 'a ;
|
||||||
match_cons : expression_variable * expression_variable * 'a * 'tv;
|
match_cons : expression_variable * expression_variable * 'a * 'tv;
|
||||||
|
Loading…
Reference in New Issue
Block a user