diff options
| author | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2011-06-15 09:26:30 +0000 |
|---|---|---|
| committer | Jacques Garrigue <garrigue at math.nagoya-u.ac.jp> | 2011-06-15 09:26:30 +0000 |
| commit | 852558d482255cde6fa686906ee27d26c2a69603 (patch) | |
| tree | f32fc32c01dc7cb01c6871e75ec4a44bc8541b05 /typing/parmatch.ml | |
| parent | fab07a66c6dd92ebbc65d79ae746b88bb0a4f063 (diff) | |
| download | ocaml-gadts.tar.gz | |
fix record pattern-matching; sort records in typed treegadts
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/gadts@11091 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'typing/parmatch.ml')
| -rw-r--r-- | typing/parmatch.ml | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/typing/parmatch.ml b/typing/parmatch.ml index e7f743c547..400246ba5c 100644 --- a/typing/parmatch.ml +++ b/typing/parmatch.ml @@ -51,16 +51,19 @@ let is_absent_pat p = match p.pat_desc with | Tpat_variant (tag, _, row) -> is_absent tag row | _ -> false +(* let sort_fields args = Sort.list (fun (lbl1,_) (lbl2,_) -> lbl1.lbl_pos <= lbl2.lbl_pos) args +*) let records_args l1 l2 = - let l1 = sort_fields l1 - and l2 = sort_fields l2 in + (* let l1 = sort_fields l1 + and l2 = sort_fields l2 in *) + (* Invariant: fields are already sorted by Typecore.type_label_a_list *) let rec combine r1 r2 l1 l2 = match l1,l2 with - | [],[] -> r1,r2 + | [],[] -> List.rev r1, List.rev r2 | [],(_,p2)::rem2 -> combine (omega::r1) (p2::r2) [] rem2 | (_,p1)::rem1,[] -> combine (p1::r1) (omega::r2) rem1 [] | (lbl1,p1)::rem1, (lbl2,p2)::rem2 -> @@ -311,12 +314,14 @@ let extract_fields omegas arg = +(* let sort_record p = match p.pat_desc with | Tpat_record args -> make_pat (Tpat_record (sort_fields args)) p.pat_type p.pat_env | _ -> p +*) let all_record_args lbls = match lbls with | ({lbl_all=lbl_all},_)::_ -> @@ -411,7 +416,7 @@ let discr_pat q pss = match normalize_pat q with | {pat_desc= (Tpat_any | Tpat_record _)} as q -> - sort_record (acc_pat q pss) + (*sort_record*) (acc_pat q pss) | q -> q (* @@ -1565,7 +1570,7 @@ with | Empty -> lub p2 q and record_lubs l1 l2 = - let l1 = sort_fields l1 and l2 = sort_fields l2 in + (* let l1 = sort_fields l1 and l2 = sort_fields l2 in *) let rec lub_rec l1 l2 = match l1,l2 with | [],_ -> l2 | _,[] -> l1 @@ -1957,7 +1962,7 @@ let check_unused tdefs casel = p.pat_loc Warnings.Unused_pat) ps | Used -> () - with e -> assert false + with Empty | Not_an_adt | Not_found | NoGuard -> assert false end ; if has_guard act then |