fix detection of matching on bool in the spiller
This commit is contained in:
parent
2f0ffc10ac
commit
2893fc0412
@ -342,8 +342,13 @@ 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 t;body=match_true};{constructor=Constructor f; body=match_false}];_}, V_Ct (C_bool b)
|
| Match_variant {cases;_}, V_Ct (C_bool b) ->
|
||||||
when String.equal t "true" && String.equal f "false" ->
|
let ctor_body (case : matching_content_case) = (case.constructor, case.body) in
|
||||||
|
let cases = CMap.of_list (List.map ctor_body cases) in
|
||||||
|
let get_case c =
|
||||||
|
(CMap.find (Constructor c) cases) in
|
||||||
|
let match_true = get_case "true" in
|
||||||
|
let match_false = get_case "false" in
|
||||||
if b then eval match_true env
|
if b then eval match_true env
|
||||||
else eval match_false env
|
else eval match_false env
|
||||||
| Match_variant {cases ; tv=_} , V_Construct (matched_c , proj) ->
|
| Match_variant {cases ; tv=_} , V_Construct (matched_c , proj) ->
|
||||||
|
@ -468,11 +468,20 @@ and compile_expression (ae:AST.expression) : (expression , spilling_error) resul
|
|||||||
in
|
in
|
||||||
return @@ E_if_cons (expr' , nil , cons)
|
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 (compile_expression) (match_true, match_false) in
|
|
||||||
return @@ E_if_bool (expr', t, f)
|
|
||||||
| Match_variant {cases ; tv} -> (
|
| Match_variant {cases ; tv} -> (
|
||||||
|
match expr'.type_expression.type_content with
|
||||||
|
| T_base TB_bool ->
|
||||||
|
let ctor_body (case : AST.matching_content_case) = (case.constructor, case.body) in
|
||||||
|
let cases = AST.CMap.of_list (List.map ctor_body cases) in
|
||||||
|
let get_case c =
|
||||||
|
trace_option
|
||||||
|
(corner_case ~loc:__LOC__ ("missing " ^ c ^ " case in match"))
|
||||||
|
(AST.CMap.find_opt (Constructor c) cases) in
|
||||||
|
let%bind match_true = get_case "true" in
|
||||||
|
let%bind match_false = get_case "false" in
|
||||||
|
let%bind (t , f) = bind_map_pair (compile_expression) (match_true, match_false) in
|
||||||
|
return @@ E_if_bool (expr', t, f)
|
||||||
|
| _ ->
|
||||||
let%bind tree =
|
let%bind tree =
|
||||||
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
|
trace_strong (corner_case ~loc:__LOC__ "getting lr tree") @@
|
||||||
tree_of_sum tv in
|
tree_of_sum tv in
|
||||||
|
Loading…
Reference in New Issue
Block a user