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

Merge branch 'ast/remove-match-bool' into 'dev'

Browse Source 
Remove match_bool from the AST

See merge request ligolang/ligo!589
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-30 09:05:58 +00:00
commit b0998f417a
22 changed files with 15 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/passes/10-interpreter/interpreter.ml
View File

@ -342,6 +342,10 @@ and eval : Ast_typed.expression -> env -> value result
let {hd;tl;body;tv=_} = cases.match_cons in
let env' = Env.extend (Env.extend env (hd,head)) (tl, V_List tail) in
eval body env'
| Match_variant {cases=[{constructor=Constructor t;body=match_true};{constructor=Constructor f; body=match_false}];_}, V_Ct (C_bool b)
when String.equal t "true" && String.equal f "false" ->
if b then eval match_true env
else eval match_false env
| Match_variant {cases ; tv=_} , V_Construct (matched_c , proj) ->
let {constructor=_ ; pattern ; body} =
List.find
@ -350,10 +354,6 @@ and eval : Ast_typed.expression -> env -> value result
cases in
let env' = Env.extend env (pattern, proj) in
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) ->
let {opt;body;tv=_} = cases.match_some in
let env' = Env.extend env (opt,proj) in

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

@ -560,9 +560,6 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
| E_matching {matchee=expr; cases=m} -> (
let%bind expr' = transpile_annotated_expression expr in
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} } ->
let%bind n = transpile_annotated_expression match_none in
let%bind (tv' , s') =
@ -583,6 +580,10 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
in
return @@ E_if_cons (expr' , nil , cons)
)
| Match_variant {cases=[{constructor=Constructor t;body=match_true};{constructor=Constructor f;body=match_false}];_}
when String.equal t "true" && String.equal f "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} -> (
let%bind tree =
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
@ -683,9 +684,6 @@ and transpile_recursive {fun_name; fun_type; lambda} =
let return ret = ok @@ Expression.make ret @@ ty in
let%bind expr = transpile_annotated_expression m.matchee in
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} } ->
let%bind n = replace_callback fun_name loop_type shadowed match_none in
let%bind (tv' , s') =
@ -706,6 +704,10 @@ and transpile_recursive {fun_name; fun_type; lambda} =
in
return @@ E_if_cons (expr , nil , cons)
)
| Match_variant {cases=[{constructor=Constructor t;body=match_true};{constructor=Constructor f;body=match_false}];_}
when String.equal t "true" && String.equal f "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} -> (
let%bind tree =
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@

2
src/passes/2-concrete_to_imperative/cameligo.ml
View File

@ -1026,7 +1026,7 @@ and compile_cases : type a . (Raw.pattern * a) list -> (a, unit) matching_conten
match patterns with
| [(PFalse _, f) ; (PTrue _, t)]
| [(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 (PListComp sugar_nil), nil); (PList (PCons c), cons)] ->
let%bind () =

2
src/passes/2-concrete_to_imperative/pascaligo.ml
View File

@ -1056,7 +1056,7 @@ and compile_cases : (Raw.pattern * expression) list -> matching_expr result = fu
match patterns with
| [(PConstr PFalse _ , f) ; (PConstr PTrue _ , t)]
| [(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 PNone _ , none) ; (PConstr PSomeApp v , some)] -> (
let (_, v) = v.value in

15
src/passes/3-self_ast_imperative/helpers.ml
View File

@ -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 ->
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, _) } -> (
let%bind res = fold_expression f init match_nil 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 ->
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, _) } -> (
let%bind match_nil = map_expression f match_nil 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 ->
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, _) } -> (
let%bind (init, match_nil) = fold_map_expression f init match_nil in
let%bind (init, cons) = fold_map_expression f init cons in

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

@ -381,26 +381,6 @@ and compile_matching : I.matching -> (O.expression option -> O.expression) resul
in
let%bind matchee = compile_expression matchee in
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} ->
let%bind match_none' = compile_expression match_none 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 =
fun m ->
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} ->
let%bind match_nil = uncompile_expression' match_nil in
let (hd,tl,expr,tv) = match_cons in

15
src/passes/5-self_ast_sugar/helpers.ml
View File

@ -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 ->
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, _) } -> (
let%bind res = fold_expression f init match_nil 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 ->
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, _) } -> (
let%bind match_nil = map_expression f match_nil 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 ->
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, _) } -> (
let%bind (init, match_nil) = fold_map_expression f init match_nil in
let%bind (init, cons) = fold_map_expression f init cons in

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

@ -159,7 +159,7 @@ let rec compile_expression : I.expression -> O.expression result =
let%bind matchee = compile_expression condition in
let%bind match_true = compile_expression then_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} ->
let%bind expr1 = compile_expression expr1 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 =
fun m ->
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} ->
let%bind match_nil = compile_expression match_nil 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 =
fun m ->
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} ->
let%bind match_nil = uncompile_expression match_nil in
let (hd,tl,expr,tv) = match_cons in

15
src/passes/7-self_ast_core/helpers.ml
View File

@ -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 ->
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, _) } -> (
let%bind res = fold_expression f init match_nil 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 ->
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, _) } -> (
let%bind match_nil = map_expression f match_nil 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 ->
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, _) } -> (
let%bind (init, match_nil) = fold_map_expression f init match_nil in
let%bind (init, cons) = fold_map_expression f init cons in

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

@ -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 =
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} ->
let%bind tv =
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 aux (cur : O.matching_expr) =
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_option { match_none ; match_some = {opt=_; body; tv=_} } -> [ match_none ; body ]
| Match_tuple { vars=_ ; body ; tvs=_ } -> [ body ]

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

@ -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 ->
let open I in
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=_ } ->
let%bind b = f body in
ok @@ I.Match_tuple ((vars, b),[])

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

@ -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 =
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} ->
let%bind tv =
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 aux (cur:O.matching_expr) =
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_option { match_none ; match_some = {opt=_ ; body ; tv=_ } } -> [ match_none ; 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 ->
let open I in
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=_} ->
let%bind b = f body in
ok @@ I.Match_tuple ((vars, b),[])

15
src/passes/9-self_ast_typed/helpers.ml
View File

@ -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 ->
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=_} } -> (
let%bind res = fold_expression f init match_nil 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 ->
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} } -> (
let%bind match_nil = map_expression f match_nil 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 ->
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 } } -> (
let%bind (init, match_nil) = fold_map_expression f init match_nil in
let%bind (init, body) = fold_map_expression f init body in

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

@ -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 ->
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=_}} ->
let%bind _ = check_recursive_call n final_path match_nil in
let%bind _ = check_recursive_call n final_path body in

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

@ -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
| Match_variant (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, _)} ->
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, _)} ->
@ -196,8 +194,6 @@ and matching_type ppf m = match m with
fprintf ppf "tuple"
| Match_variant (lst, _) ->
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
| Match_bool _ ->
fprintf ppf "boolean"
| Match_list _ ->
fprintf ppf "list"
| Match_option _ ->

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

@ -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
| Match_variant (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, _)} ->
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, _)} ->
@ -163,8 +161,6 @@ and matching_type ppf m = match m with
fprintf ppf "tuple"
| Match_variant (lst, _) ->
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
| Match_bool _ ->
fprintf ppf "boolean"
| Match_list _ ->
fprintf ppf "list"
| Match_option _ ->

4
src/stages/3-ast_core/PP.ml
View File

@ -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
| Match_variant (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, _)} ->
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, _)} ->
@ -89,8 +87,6 @@ and matching_type ppf m = match m with
fprintf ppf "tuple"
| Match_variant (lst, _) ->
fprintf ppf "variant %a" (list_sep matching_variant_case_type (tag "@.")) lst
| Match_bool _ ->
fprintf ppf "boolean"
| Match_list _ ->
fprintf ppf "list"
| Match_option _ ->

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

@ -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
| Match_variant {cases ; tv=_} ->
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=_}} ->
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=_}} ->

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

@ -234,7 +234,6 @@ module Free_variables = struct
and matching : (bindings -> expression -> bindings) -> bindings -> matching_expr -> bindings = fun f b m ->
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_option { match_none = n ; match_some = {opt; body; tv=_} } -> union (f b n) (f (union (singleton opt) b) body)
| Match_tuple { vars ; body ; tvs=_ } ->

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

@ -91,10 +91,6 @@ module Captured_variables = struct
and matching : (bindings -> expression -> bindings result) -> bindings -> matching_expr -> bindings result = fun f b m ->
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=_} } ->
let%bind n' = f b n in
let%bind c' = f (union (of_list [hd ; tl]) b) body in

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

@ -88,10 +88,6 @@ type literal =
| Literal_void
| Literal_operation of packed_internal_operation
type matching_content_bool = {
match_true : expression ;
match_false : expression ;
}
and matching_content_cons = {
hd : expression_variable;
@ -139,7 +135,6 @@ and matching_content_variant = {
}
and matching_expr =
| Match_bool of matching_content_bool
| Match_list of matching_content_list
| Match_option of matching_content_option
| Match_tuple of matching_content_tuple

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

@ -169,10 +169,6 @@ type literal =
| Literal_operation of
Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
and ('a,'tv) matching_content =
| Match_bool of {
match_true : 'a ;
match_false : 'a ;
}
| Match_list of {
match_nil : 'a ;
match_cons : expression_variable * expression_variable * 'a * 'tv;