diff options
| -rw-r--r-- | bytecomp/lambda.ml | 18 | ||||
| -rw-r--r-- | bytecomp/matching.ml | 4 |
2 files changed, 14 insertions, 8 deletions
diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index 68b03d2801..3c1aaf26bb 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -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 diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index 2e2eea9a20..88a348408e 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -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 |