Permalink
Browse files

Correct PR#6412 by ruling out sharing of Levents

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14804 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent 5d7864a commit f8a3649190114bc7182c718837a2a1737ad676f1 @maranget maranget committed May 12, 2014
Showing with 14 additions and 8 deletions.
  1. +13 −5 bytecomp/lambda.ml
  2. +1 −3 bytecomp/matching.ml
View
@@ -211,16 +211,23 @@ let const_unit = Const_pointer 0
let lambda_unit = Lconst const_unit
+(* Build sharing keys *)
+(*
+ Those keys are later compared with Pervasives.compare.
+ For that reason, they should not include cycles.
+*)
+
exception Not_simple
let max_raw = 32
let make_key e =
- let count = ref 0
+ let count = ref 0 (* Used for controling size *)
and make_key = Ident.make_key_generator () in
+ (* make_key is used for normalizing let-bound variables *)
let rec tr_rec env e =
incr count ;
- if !count > max_raw then raise Not_simple ;
+ if !count > max_raw then raise Not_simple ; (* Too big ! *)
match e with
| Lvar id ->
begin
@@ -264,11 +271,12 @@ let make_key e =
Lassign (x,tr_rec env e)
| Lsend (m,e1,e2,es,loc) ->
Lsend (m,tr_rec env e1,tr_rec env e2,tr_recs env es,Location.none)
- | Levent (e,evt) ->
- Levent (tr_rec env e,evt)
| Lifused (id,e) -> Lifused (id,tr_rec env e)
| Lletrec _|Lfunction _
- | Lfor _ | Lwhile _ ->
+ | Lfor _ | Lwhile _
+(* Beware: (PR#6412) the event argument to Levent
+ may include cyclic structure of type Type.typexpr *)
+ | Levent _ ->
raise Not_simple
and tr_recs env es = List.map (tr_rec env) es
View
@@ -531,9 +531,7 @@ let up_ok_action act1 act2 =
try
let raw1 = tr_raw act1
and raw2 = tr_raw act2 in
- match raw1, raw2 with
- | Lstaticraise (i1,[]), Lstaticraise (i2,[]) -> i1=i2
- | _,_ -> raw1 = raw2
+ raw1 = raw2
with
| Exit -> false

0 comments on commit f8a3649

Please sign in to comment.