Skip to content

Commit 842eb76

Browse files
marangetmaranget
committed
Nouveaux warning dans les or-pats
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4830 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
1 parent 3e2024a commit 842eb76

8 files changed

Lines changed: 592 additions & 340 deletions

File tree

‎bytecomp/matching.ml‎

Lines changed: 78 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -28,30 +28,8 @@ open Parmatch
2828
Bon, au commencement du monde c'etait vrai.
2929
*)
3030

31-
let pretty_pat p =
32-
Parmatch.top_pretty Format.str_formatter p ;
33-
prerr_string (Format.flush_str_formatter ())
34-
3531
type matrix = pattern list list
3632

37-
let pretty_line ps =
38-
List.iter
39-
(fun p ->
40-
Parmatch.top_pretty Format.str_formatter p ;
41-
prerr_string " <" ;
42-
prerr_string (Format.flush_str_formatter ()) ;
43-
prerr_string ">")
44-
ps
45-
46-
let pretty_matrix pss =
47-
prerr_endline "begin matrix" ;
48-
List.iter
49-
(fun ps ->
50-
pretty_line ps ;
51-
prerr_endline "")
52-
pss ;
53-
prerr_endline "end matrix"
54-
5533
type ctx = {left:pattern list ; right:pattern list}
5634

5735
let pretty_ctx ctx =
@@ -121,24 +99,29 @@ let ncols = function
12199

122100

123101
exception NoMatch
102+
exception OrPat
124103
exception Unused
125104

126105
let filter_matrix matcher pss =
106+
127107
let rec filter_rec = function
128108
| (p::ps)::rem ->
129109
begin match p.pat_desc with
130-
| Tpat_or (p1,p2,_) ->
131-
filter_rec ((p1::ps)::(p2::ps)::rem)
132110
| Tpat_alias (p,_) ->
133111
filter_rec ((p::ps)::rem)
134112
| Tpat_var _ ->
135113
filter_rec ((omega::ps)::rem)
136114
| _ ->
137-
begin let rem = filter_rec rem in
138-
try
139-
matcher p ps::rem
140-
with
141-
| NoMatch -> rem
115+
begin
116+
let rem = filter_rec rem in
117+
try
118+
matcher p ps::rem
119+
with
120+
| NoMatch -> rem
121+
| OrPat ->
122+
match p.pat_desc with
123+
| Tpat_or (p1,p2,_) -> filter_rec [(p1::ps) ;(p2::ps)]@rem
124+
| _ -> assert false
142125
end
143126
end
144127
| [] -> []
@@ -929,8 +912,6 @@ let divide_line make_ctx make get_args pat ctx pm =
929912
pat=pat}
930913

931914

932-
(* Matching against a constant *)
933-
934915
let make_default matcher (exit,l) =
935916
let rec make_rec = function
936917
| [] -> []
@@ -943,11 +924,19 @@ let make_default matcher (exit,l) =
943924
| pss -> (pss,i)::rem in
944925
exit,make_rec l
945926

927+
(* Matching against a constant *)
928+
929+
946930

947-
let matcher_const cst p rem = match p.pat_desc with
948-
| Tpat_constant c1 when c1=cst -> rem
949-
| Tpat_any -> rem
950-
| _ -> raise NoMatch
931+
let rec matcher_const cst p rem = match p.pat_desc with
932+
| Tpat_or (p1,p2,_) ->
933+
begin try
934+
matcher_const cst p1 rem with
935+
| NoMatch -> matcher_const cst p2 rem
936+
end
937+
| Tpat_constant c1 when c1=cst -> rem
938+
| Tpat_any -> rem
939+
| _ -> raise NoMatch
951940

952941
let get_key_constant caller = function
953942
| {pat_desc= Tpat_constant cst} as p -> cst
@@ -1003,12 +992,49 @@ let pat_as_constr = function
1003992
| _ -> fatal_error "Matching.pat_as_constr"
1004993

1005994

1006-
let matcher_constr cstr q rem = match q.pat_desc with
1007-
| Tpat_construct (cstr1, args)
1008-
when cstr.cstr_tag = cstr1.cstr_tag ->
1009-
args @ rem
1010-
| Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
1011-
| _ -> raise NoMatch
995+
let matcher_constr cstr = match cstr.cstr_arity with
996+
| 0 ->
997+
let rec matcher_rec q rem = match q.pat_desc with
998+
| Tpat_or (p1,p2,_) ->
999+
begin
1000+
try
1001+
matcher_rec p1 rem
1002+
with
1003+
| NoMatch -> matcher_rec p2 rem
1004+
end
1005+
| Tpat_construct (cstr1, []) when cstr.cstr_tag = cstr1.cstr_tag ->
1006+
rem
1007+
| Tpat_any -> rem
1008+
| _ -> raise NoMatch in
1009+
matcher_rec
1010+
| 1 ->
1011+
let rec matcher_rec q rem = match q.pat_desc with
1012+
| Tpat_or (p1,p2,_) ->
1013+
let r1 = try Some (matcher_rec p1 rem) with NoMatch -> None
1014+
and r2 = try Some (matcher_rec p2 rem) with NoMatch -> None in
1015+
begin match r1,r2 with
1016+
| None, None -> raise NoMatch
1017+
| Some r1, None -> r1
1018+
| None, Some r2 -> r2
1019+
| Some (a1::rem1), Some (a2::_) ->
1020+
{a1 with
1021+
pat_loc = Location.none ;
1022+
pat_desc = Tpat_or (a1, a2, None)}::
1023+
rem
1024+
| _, _ -> assert false
1025+
end
1026+
| Tpat_construct (cstr1, [arg]) when cstr.cstr_tag = cstr1.cstr_tag ->
1027+
arg::rem
1028+
| Tpat_any -> omega::rem
1029+
| _ -> raise NoMatch in
1030+
matcher_rec
1031+
| _ ->
1032+
fun q rem -> match q.pat_desc with
1033+
| Tpat_or (_,_,_) -> raise OrPat
1034+
| Tpat_construct (cstr1, args)
1035+
when cstr.cstr_tag = cstr1.cstr_tag -> args @ rem
1036+
| Tpat_any -> Parmatch.omegas cstr.cstr_arity @ rem
1037+
| _ -> raise NoMatch
10121038

10131039
let make_constr_matching p def ctx = function
10141040
[] -> fatal_error "Matching.make_constr_matching"
@@ -1035,7 +1061,14 @@ let divide_constructor ctx pm =
10351061

10361062
(* Matching against a variant *)
10371063

1038-
let matcher_variant_const lab p rem = match p.pat_desc with
1064+
let rec matcher_variant_const lab p rem = match p.pat_desc with
1065+
| Tpat_or (p1, p2, _) ->
1066+
begin
1067+
try
1068+
matcher_variant_const lab p1 rem
1069+
with
1070+
| NoMatch -> matcher_variant_const lab p2 rem
1071+
end
10391072
| Tpat_variant (lab1,_,_) when lab1=lab -> rem
10401073
| Tpat_any -> rem
10411074
| _ -> raise NoMatch
@@ -1051,6 +1084,7 @@ let make_variant_matching_constant p lab def ctx = function
10511084
pat = normalize_pat p}
10521085

10531086
let matcher_variant_nonconst lab p rem = match p.pat_desc with
1087+
| Tpat_or (_,_,_) -> raise OrPat
10541088
| Tpat_variant (lab1,Some arg,_) when lab1=lab -> arg::rem
10551089
| Tpat_any -> omega::rem
10561090
| _ -> raise NoMatch
@@ -1192,6 +1226,7 @@ let get_args_array p rem = match p with
11921226
| _ -> assert false
11931227

11941228
let matcher_array len p rem = match p.pat_desc with
1229+
| Tpat_or (_,_,_) -> raise OrPat
11951230
| Tpat_array args when List.length args=len -> args @ rem
11961231
| Tpat_any -> Parmatch.omegas len @ rem
11971232
| _ -> raise NoMatch
@@ -1224,9 +1259,6 @@ let sort_lambda_list l =
12241259
l
12251260

12261261

1227-
1228-
1229-
12301262
let rec cut n l =
12311263
if n = 0 then [],l
12321264
else match l with
@@ -2018,6 +2050,7 @@ let comp_match_handlers comp_fun partial ctx arg first_match next_matchs =
20182050
Output: a lambda term, a jump summary {..., exit number -> context, .. }
20192051
*)
20202052

2053+
20212054
let rec compile_match repr partial ctx m = match m with
20222055
| { cases = [] } -> comp_exit ctx m
20232056
| { cases = ([], action) :: rem } ->

‎camlp4/etc/pr_r.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -838,7 +838,8 @@ and fun_binding b fb k =
838838
| e -> HVbox [: `HVbox [: b; `S LR "=" :]; `expr e k :] ]
839839
and simple_patt p k =
840840
match p with
841-
[ <:patt< $lid:_$ >> | <:patt< ~ $_$ : $_$ >> | <:patt< ~ $_$ >> -> patt p k
841+
[ <:patt< $lid:_$ >> | <:patt< ~ $_$ : $_$ >>
842+
(* useless pat (luc) | <:patt< ~ $_$ >> *) -> patt p k
842843
| _ -> HVbox [: `S LO "("; `patt p [: `S RO ")"; k :] :] ]
843844
and class_type ct k =
844845
match ct with

‎otherlibs/labltk/camltk/.depend‎

Lines changed: 31 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -11,16 +11,16 @@ cFont.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
1111
cFrame.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
1212
cGrab.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
1313
cGrid.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
14-
cImage.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
1514
cImagebitmap.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
15+
cImage.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
1616
cImagephoto.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
1717
cLabel.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
1818
cListbox.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
19-
cMenu.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
2019
cMenubutton.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
20+
cMenu.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
2121
cMessage.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
22-
cOption.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
2322
cOptionmenu.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
23+
cOption.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
2424
cPack.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
2525
cPalette.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
2626
cPixmap.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
@@ -36,6 +36,22 @@ cTkwait.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
3636
cToplevel.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
3737
cWinfo.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
3838
cWm.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
39+
camltk.cmo: cBell.cmi cButton.cmi cCanvas.cmi cCheckbutton.cmi cClipboard.cmi \
40+
cDialog.cmi cEncoding.cmi cEntry.cmi cFocus.cmi cFont.cmi cFrame.cmi \
41+
cGrab.cmi cGrid.cmi cImage.cmi cImagebitmap.cmi cImagephoto.cmi \
42+
cLabel.cmi cListbox.cmi cMenu.cmi cMenubutton.cmi cMessage.cmi \
43+
cOption.cmi cOptionmenu.cmi cPack.cmi cPalette.cmi cPixmap.cmi cPlace.cmi \
44+
cRadiobutton.cmi cResource.cmi cScale.cmi cScrollbar.cmi cSelection.cmi \
45+
cText.cmi cTk.cmo cTkvars.cmi cTkwait.cmi cToplevel.cmi cWinfo.cmi \
46+
cWm.cmi
47+
camltk.cmx: cBell.cmx cButton.cmx cCanvas.cmx cCheckbutton.cmx cClipboard.cmx \
48+
cDialog.cmx cEncoding.cmx cEntry.cmx cFocus.cmx cFont.cmx cFrame.cmx \
49+
cGrab.cmx cGrid.cmx cImage.cmx cImagebitmap.cmx cImagephoto.cmx \
50+
cLabel.cmx cListbox.cmx cMenu.cmx cMenubutton.cmx cMessage.cmx \
51+
cOption.cmx cOptionmenu.cmx cPack.cmx cPalette.cmx cPixmap.cmx cPlace.cmx \
52+
cRadiobutton.cmx cResource.cmx cScale.cmx cScrollbar.cmx cSelection.cmx \
53+
cText.cmx cTk.cmx cTkvars.cmx cTkwait.cmx cToplevel.cmx cWinfo.cmx \
54+
cWm.cmx
3955
cBell.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
4056
../support/widget.cmi cBell.cmi
4157
cBell.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
@@ -88,14 +104,14 @@ cGrid.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
88104
../support/widget.cmi cGrid.cmi
89105
cGrid.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
90106
../support/widget.cmx cGrid.cmi
91-
cImage.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
92-
../support/widget.cmi cImage.cmi
93-
cImage.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
94-
../support/widget.cmx cImage.cmi
95107
cImagebitmap.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
96108
../support/widget.cmi cImagebitmap.cmi
97109
cImagebitmap.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
98110
../support/widget.cmx cImagebitmap.cmi
111+
cImage.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
112+
../support/widget.cmi cImage.cmi
113+
cImage.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
114+
../support/widget.cmx cImage.cmi
99115
cImagephoto.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
100116
../support/widget.cmi cImagephoto.cmi
101117
cImagephoto.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
@@ -108,26 +124,26 @@ cListbox.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
108124
../support/widget.cmi cListbox.cmi
109125
cListbox.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
110126
../support/widget.cmx cListbox.cmi
111-
cMenu.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
112-
../support/widget.cmi cMenu.cmi
113-
cMenu.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
114-
../support/widget.cmx cMenu.cmi
115127
cMenubutton.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
116128
../support/widget.cmi cMenubutton.cmi
117129
cMenubutton.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
118130
../support/widget.cmx cMenubutton.cmi
131+
cMenu.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
132+
../support/widget.cmi cMenu.cmi
133+
cMenu.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
134+
../support/widget.cmx cMenu.cmi
119135
cMessage.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
120136
../support/widget.cmi cMessage.cmi
121137
cMessage.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
122138
../support/widget.cmx cMessage.cmi
123-
cOption.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
124-
../support/widget.cmi cOption.cmi
125-
cOption.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
126-
../support/widget.cmx cOption.cmi
127139
cOptionmenu.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
128140
../support/widget.cmi cOptionmenu.cmi
129141
cOptionmenu.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
130142
../support/widget.cmx cOptionmenu.cmi
143+
cOption.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
144+
../support/widget.cmi cOption.cmi
145+
cOption.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
146+
../support/widget.cmx cOption.cmi
131147
cPack.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
132148
../support/widget.cmi cPack.cmi
133149
cPack.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
@@ -192,19 +208,3 @@ cWm.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
192208
../support/widget.cmi cWm.cmi
193209
cWm.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
194210
../support/widget.cmx cWm.cmi
195-
camltk.cmo: cBell.cmi cButton.cmi cCanvas.cmi cCheckbutton.cmi cClipboard.cmi \
196-
cDialog.cmi cEncoding.cmi cEntry.cmi cFocus.cmi cFont.cmi cFrame.cmi \
197-
cGrab.cmi cGrid.cmi cImage.cmi cImagebitmap.cmi cImagephoto.cmi \
198-
cLabel.cmi cListbox.cmi cMenu.cmi cMenubutton.cmi cMessage.cmi \
199-
cOption.cmi cOptionmenu.cmi cPack.cmi cPalette.cmi cPixmap.cmi cPlace.cmi \
200-
cRadiobutton.cmi cResource.cmi cScale.cmi cScrollbar.cmi cSelection.cmi \
201-
cText.cmi cTk.cmo cTkvars.cmi cTkwait.cmi cToplevel.cmi cWinfo.cmi \
202-
cWm.cmi
203-
camltk.cmx: cBell.cmx cButton.cmx cCanvas.cmx cCheckbutton.cmx cClipboard.cmx \
204-
cDialog.cmx cEncoding.cmx cEntry.cmx cFocus.cmx cFont.cmx cFrame.cmx \
205-
cGrab.cmx cGrid.cmx cImage.cmx cImagebitmap.cmx cImagephoto.cmx \
206-
cLabel.cmx cListbox.cmx cMenu.cmx cMenubutton.cmx cMessage.cmx \
207-
cOption.cmx cOptionmenu.cmx cPack.cmx cPalette.cmx cPixmap.cmx cPlace.cmx \
208-
cRadiobutton.cmx cResource.cmx cScale.cmx cScrollbar.cmx cSelection.cmx \
209-
cText.cmx cTk.cmx cTkvars.cmx cTkwait.cmx cToplevel.cmx cWinfo.cmx \
210-
cWm.cmx

0 commit comments

Comments
 (0)