Commit 9da1d67c authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Add a workaround in case pattern compilation failed (after typechecking) due...

Add a workaround in case pattern compilation failed (after typechecking) due to the presence of type variables in some types.
parent cd7eaf51
...@@ -1006,17 +1006,21 @@ module Compile = struct ...@@ -1006,17 +1006,21 @@ module Compile = struct
!compute_actions disp; !compute_actions disp;
disp disp
exception FindCode
let find_code d a = let find_code d a =
let rec aux i = function let rec aux i = function
| `Result code -> code | `Result code -> code
| `None -> | `None ->
(*
Format.fprintf Format.std_formatter Format.fprintf Format.std_formatter
"IFACE=%a@." print_iface d.interface; "IFACE=%a@." print_iface d.interface;
for i = 0 to Array.length a - 1 do for i = 0 to Array.length a - 1 do
Format.fprintf Format.std_formatter Format.fprintf Format.std_formatter
"a.(%i)=%b@." i (a.(i) != None) "a.(%i)=%b@." i (a.(i) != None)
done; done;
assert false assert false *)
raise FindCode
| `Switch (yes,_) when a.(i) != None -> aux (i + 1) yes | `Switch (yes,_) when a.(i) != None -> aux (i + 1) yes
| `Switch (_,no) -> aux (i + 1) no in | `Switch (_,no) -> aux (i + 1) no in
aux 0 d.interface aux 0 d.interface
...@@ -1389,4 +1393,12 @@ module Compile = struct ...@@ -1389,4 +1393,12 @@ module Compile = struct
| Fail -> assert (!code < 0); code := i | _ -> ()) rhs; | Fail -> assert (!code < 0); code := i | _ -> ()) rhs;
if (!code >= 0) then prepare_checker !code d; if (!code >= 0) then prepare_checker !code d;
d d
let make_branches t b =
try
make_branches t b
with
FindCode -> make_branches (Types.Substitution.hide_vars t) b
end end
...@@ -3038,6 +3038,19 @@ struct ...@@ -3038,6 +3038,19 @@ struct
app_subst t subst app_subst t subst
let hide_vars t =
if no_var t then t else
let _,pos, neg, all = Variable.collect_vars t in
let subst = Map.init
(fun v ->
let is_pos = Var.Set.mem pos v in
let is_neg = Var.Set.mem neg v in
if is_pos == is_neg then var v
else if is_pos then any else empty
) all
in
app_subst t subst
end end
......
...@@ -160,7 +160,7 @@ module Substitution : sig ...@@ -160,7 +160,7 @@ module Substitution : sig
val full : t -> (Var.var * t) list -> t val full : t -> (Var.var * t) list -> t
val single : t -> (Var.var * t) -> t val single : t -> (Var.var * t) -> t
val freshen : Var.Set.t -> t -> t val freshen : Var.Set.t -> t -> t
val hide_vars : t -> t
end end
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment