diff options
| -rw-r--r-- | bytecomp/matching.ml | 2 | ||||
| -rw-r--r-- | typing/parmatch.ml | 15 | ||||
| -rw-r--r-- | typing/parmatch.mli | 6 |
3 files changed, 20 insertions, 3 deletions
diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml index c1f5866b4..4cb5b54cd 100644 --- a/bytecomp/matching.ml +++ b/bytecomp/matching.ml @@ -102,7 +102,7 @@ let rshift_num n {left=left ; right=right} = let ctx_rshift_num n ctx = List.map (rshift_num n) ctx let combine {left=left ; right=right} = match left with -| p::ps -> {left=ps ; right=set_args p right} +| p::ps -> {left=ps ; right=set_args_erase_mutable p right} | _ -> assert false let ctx_combine ctx = List.map combine ctx diff --git a/typing/parmatch.ml b/typing/parmatch.ml index 6ee656cb0..56ddcaf99 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -410,7 +410,7 @@ let rec read_args xs r = match xs,r with | _,_ -> fatal_error "Parmatch.read_args" -let set_args q r = match q with +let do_set_args erase_mutable q r = match q with | {pat_desc = Tpat_tuple omegas} -> let args,rest = read_args omegas r in make_pat (Tpat_tuple args) q.pat_type q.pat_env::rest @@ -418,7 +418,16 @@ let set_args q r = match q with let args,rest = read_args omegas r in make_pat (Tpat_record - (List.map2 (fun (lbl,_) arg -> lbl,arg) omegas args)) + (List.map2 (fun (lbl,_) arg -> + if + erase_mutable && + (match lbl.lbl_mut with + | Mutable -> true | Immutable -> false) + then + lbl, omega + else + lbl,arg) + omegas args)) q.pat_type q.pat_env:: rest | {pat_desc = Tpat_construct (c,omegas)} -> @@ -445,6 +454,8 @@ let set_args q r = match q with q::r (* case any is used in matching.ml *) | _ -> fatal_error "Parmatch.set_args" +let set_args q r = do_set_args false q r +and set_args_erase_mutable q r = do_set_args true q r (* filter pss acording to pattern q *) let filter_one q pss = diff --git a/typing/parmatch.mli b/typing/parmatch.mli index 168876d64..08dfcb299 100644 --- a/typing/parmatch.mli +++ b/typing/parmatch.mli @@ -38,7 +38,13 @@ val lubs : pattern list -> pattern list -> pattern list val get_mins : ('a -> 'a -> bool) -> 'a list -> 'a list +(* Those to functions recombine one pattern and its arguments: + For instance: + (_,_)::p1::p2::rem -> (p1, p2)::rem + The second one will replace mutable arguments by '_' +*) val set_args : pattern -> pattern list -> pattern list +val set_args_erase_mutable : pattern -> pattern list -> pattern list val pat_of_constr : pattern -> constructor_description -> pattern val complete_constrs : |