Petite discussion avec Jacques.
1 Pb typage variants, en attente, exemple dans test/Moretest/morematch.ml
2 Meilleure compilation des switch de variants -> bytecomp/switch.ml
a Vider la table t en cas de changement de ok_inter
b Traiter les intervalles de taille 1 meme si !ok_inter = false
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@5153 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Luc Maranget
parent
25e2363a72
commit
aea14e3bb4
|
|
@ -332,35 +332,86 @@ let make_key cases =
|
|||
*)
|
||||
|
||||
let inter_limit = 1 lsl 16
|
||||
|
||||
|
||||
let ok_inter = ref false
|
||||
|
||||
let rec opt_count top cases =
|
||||
let key = make_key cases in
|
||||
try
|
||||
let r = Hashtbl.find t key in
|
||||
r
|
||||
with
|
||||
| Not_found ->
|
||||
let r =
|
||||
let lcases = Array.length cases in
|
||||
match lcases with
|
||||
| 0 -> assert false
|
||||
| _ when same_act cases -> No, ({n=0; ni=0},{n=0; ni=0})
|
||||
| _ ->
|
||||
if lcases < !cut then
|
||||
enum top cases
|
||||
else if lcases < !more_cut then
|
||||
heuristic top cases
|
||||
else
|
||||
divide top cases in
|
||||
Hashtbl.add t key r ;
|
||||
r
|
||||
|
||||
and divide top cases =
|
||||
let lcases = Array.length cases in
|
||||
let m = lcases/2 in
|
||||
let _,left,right = coupe cases m in
|
||||
let key = make_key cases in
|
||||
try
|
||||
let r = Hashtbl.find t key in
|
||||
r
|
||||
with
|
||||
| Not_found ->
|
||||
let r =
|
||||
let lcases = Array.length cases in
|
||||
match lcases with
|
||||
| 0 -> assert false
|
||||
| _ when same_act cases -> No, ({n=0; ni=0},{n=0; ni=0})
|
||||
| _ ->
|
||||
if lcases < !cut then
|
||||
enum top cases
|
||||
else if lcases < !more_cut then
|
||||
heuristic top cases
|
||||
else
|
||||
divide top cases in
|
||||
Hashtbl.add t key r ;
|
||||
r
|
||||
|
||||
and divide top cases =
|
||||
let lcases = Array.length cases in
|
||||
let m = lcases/2 in
|
||||
let _,left,right = coupe cases m in
|
||||
let ci = {n=1 ; ni=0}
|
||||
and cm = {n=1 ; ni=0}
|
||||
and _,(cml,cleft) = opt_count false left
|
||||
and _,(cmr,cright) = opt_count false right in
|
||||
add_test ci cleft ;
|
||||
add_test ci cright ;
|
||||
if less_tests cml cmr then
|
||||
add_test cm cmr
|
||||
else
|
||||
add_test cm cml ;
|
||||
Sep m,(cm, ci)
|
||||
|
||||
and heuristic top cases =
|
||||
let lcases = Array.length cases in
|
||||
|
||||
let sep,csep = divide false cases
|
||||
|
||||
and inter,cinter =
|
||||
if !ok_inter then begin
|
||||
let _,_,act0 = cases.(0)
|
||||
and _,_,act1 = cases.(lcases-1) in
|
||||
if act0 = act1 then begin
|
||||
let low, high, inside, outside = coupe_inter 1 (lcases-2) cases in
|
||||
let _,(cmi,cinside) = opt_count false inside
|
||||
and _,(cmo,coutside) = opt_count false outside
|
||||
and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
|
||||
and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
|
||||
add_test cij cinside ;
|
||||
add_test cij coutside ;
|
||||
if less_tests cmi cmo then
|
||||
add_test cmij cmo
|
||||
else
|
||||
add_test cmij cmi ;
|
||||
Inter (1,lcases-2),(cmij,cij)
|
||||
end else
|
||||
Inter (-1,-1),(too_much, too_much)
|
||||
end else
|
||||
Inter (-1,-1),(too_much, too_much) in
|
||||
if less2tests csep cinter then
|
||||
sep,csep
|
||||
else
|
||||
inter,cinter
|
||||
|
||||
|
||||
and enum top cases =
|
||||
let lcases = Array.length cases in
|
||||
let lim, with_sep =
|
||||
let best = ref (-1) and best_cost = ref (too_much,too_much) in
|
||||
|
||||
for i = 1 to lcases-(1) do
|
||||
let _,left,right = coupe cases i in
|
||||
let ci = {n=1 ; ni=0}
|
||||
and cm = {n=1 ; ni=0}
|
||||
and _,(cml,cleft) = opt_count false left
|
||||
|
|
@ -371,180 +422,152 @@ let rec opt_count top cases =
|
|||
add_test cm cmr
|
||||
else
|
||||
add_test cm cml ;
|
||||
Sep m,(cm, ci)
|
||||
|
||||
if
|
||||
less2tests (cm,ci) !best_cost
|
||||
then begin
|
||||
if top then
|
||||
Printf.fprintf stderr "Get it: %d\n" i ;
|
||||
best := i ;
|
||||
best_cost := (cm,ci)
|
||||
end
|
||||
done ;
|
||||
!best, !best_cost in
|
||||
|
||||
and heuristic top cases =
|
||||
let lcases = Array.length cases in
|
||||
|
||||
let sep,csep = divide false cases
|
||||
|
||||
and inter,cinter =
|
||||
if !ok_inter then begin
|
||||
let _,_,act0 = cases.(0)
|
||||
and _,_,act1 = cases.(lcases-1) in
|
||||
if act0 = act1 then begin
|
||||
let low, high, inside, outside = coupe_inter 1 (lcases-2) cases in
|
||||
let _,(cmi,cinside) = opt_count false inside
|
||||
and _,(cmo,coutside) = opt_count false outside
|
||||
and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
|
||||
and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
|
||||
add_test cij cinside ;
|
||||
add_test cij coutside ;
|
||||
if less_tests cmi cmo then
|
||||
add_test cmij cmo
|
||||
else
|
||||
add_test cmij cmi ;
|
||||
Inter (1,lcases-2),(cmij,cij)
|
||||
end else
|
||||
Inter (-1,-1),(too_much, too_much)
|
||||
end else
|
||||
Inter (-1,-1),(too_much, too_much) in
|
||||
if less2tests csep cinter then
|
||||
sep,csep
|
||||
else
|
||||
inter,cinter
|
||||
|
||||
|
||||
and enum top cases =
|
||||
let lcases = Array.length cases in
|
||||
let lim, with_sep =
|
||||
let best = ref (-1) and best_cost = ref (too_much,too_much) in
|
||||
|
||||
for i = 1 to lcases-(1) do
|
||||
let _,left,right = coupe cases i in
|
||||
let ci = {n=1 ; ni=0}
|
||||
and cm = {n=1 ; ni=0}
|
||||
and _,(cml,cleft) = opt_count false left
|
||||
and _,(cmr,cright) = opt_count false right in
|
||||
add_test ci cleft ;
|
||||
add_test ci cright ;
|
||||
if less_tests cml cmr then
|
||||
add_test cm cmr
|
||||
let ilow, ihigh, with_inter =
|
||||
if not !ok_inter then
|
||||
let rlow = ref (-1) and rhigh = ref (-1)
|
||||
and best_cost= ref (too_much,too_much) in
|
||||
for i=1 to lcases-2 do
|
||||
let low, high, inside, outside = coupe_inter i i cases in
|
||||
if low=high then begin
|
||||
let _,(cmi,cinside) = opt_count false inside
|
||||
and _,(cmo,coutside) = opt_count false outside
|
||||
and cmij = {n=1 ; ni=0}
|
||||
and cij = {n=1 ; ni=0} in
|
||||
add_test cij cinside ;
|
||||
add_test cij coutside ;
|
||||
if less_tests cmi cmo then
|
||||
add_test cmij cmo
|
||||
else
|
||||
add_test cmij cmi ;
|
||||
if less2tests (cmij,cij) !best_cost then begin
|
||||
rlow := i ;
|
||||
rhigh := i ;
|
||||
best_cost := (cmij,cij)
|
||||
end
|
||||
end
|
||||
done ;
|
||||
!rlow, !rhigh, !best_cost
|
||||
else
|
||||
let rlow = ref (-1) and rhigh = ref (-1)
|
||||
and best_cost= ref (too_much,too_much) in
|
||||
for i=1 to lcases-2 do
|
||||
for j=i to lcases-2 do
|
||||
let low, high, inside, outside = coupe_inter i j cases in
|
||||
let _,(cmi,cinside) = opt_count false inside
|
||||
and _,(cmo,coutside) = opt_count false outside
|
||||
and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
|
||||
and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
|
||||
add_test cij cinside ;
|
||||
add_test cij coutside ;
|
||||
if less_tests cmi cmo then
|
||||
add_test cmij cmo
|
||||
else
|
||||
add_test cm cml ;
|
||||
|
||||
if
|
||||
less2tests (cm,ci) !best_cost
|
||||
then begin
|
||||
if top then
|
||||
Printf.fprintf stderr "Get it: %d\n" i ;
|
||||
best := i ;
|
||||
best_cost := (cm,ci)
|
||||
add_test cmij cmi ;
|
||||
if less2tests (cmij,cij) !best_cost then begin
|
||||
rlow := i ;
|
||||
rhigh := j ;
|
||||
best_cost := (cmij,cij)
|
||||
end
|
||||
done ;
|
||||
!best, !best_cost in
|
||||
let ilow, ihigh, with_inter =
|
||||
if not !ok_inter then
|
||||
-1,-1,(too_much,too_much)
|
||||
else
|
||||
let rlow = ref (-1) and rhigh = ref (-1)
|
||||
and best_cost= ref (too_much,too_much) in
|
||||
for i=1 to lcases-2 do
|
||||
for j=i to lcases-2 do
|
||||
let low, high, inside, outside = coupe_inter i j cases in
|
||||
let _,(cmi,cinside) = opt_count false inside
|
||||
and _,(cmo,coutside) = opt_count false outside
|
||||
and cmij = {n=1 ; ni=(if low=high then 0 else 1)}
|
||||
and cij = {n=1 ; ni=(if low=high then 0 else 1)} in
|
||||
add_test cij cinside ;
|
||||
add_test cij coutside ;
|
||||
if less_tests cmi cmo then
|
||||
add_test cmij cmo
|
||||
else
|
||||
add_test cmij cmi ;
|
||||
if less2tests (cmij,cij) !best_cost then begin
|
||||
rlow := i ;
|
||||
rhigh := j ;
|
||||
best_cost := (cmij,cij)
|
||||
end
|
||||
done
|
||||
done ;
|
||||
!rlow, !rhigh, !best_cost in
|
||||
let r = ref (Inter (ilow,ihigh)) and rc = ref with_inter in
|
||||
if less2tests with_sep !rc then begin
|
||||
r := Sep lim ; rc := with_sep
|
||||
end ;
|
||||
!r, !rc
|
||||
|
||||
let make_if_test konst test arg i ifso ifnot =
|
||||
Arg.make_if
|
||||
(Arg.make_prim test [arg ; konst i])
|
||||
ifso ifnot
|
||||
|
||||
let make_if_lt konst arg i ifso ifnot = match i with
|
||||
| 1 ->
|
||||
make_if_test konst Arg.leint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.ltint arg i ifso ifnot
|
||||
done
|
||||
done ;
|
||||
!rlow, !rhigh, !best_cost in
|
||||
let r = ref (Inter (ilow,ihigh)) and rc = ref with_inter in
|
||||
if less2tests with_sep !rc then begin
|
||||
r := Sep lim ; rc := with_sep
|
||||
end ;
|
||||
!r, !rc
|
||||
|
||||
and make_if_le konst arg i ifso ifnot = match i with
|
||||
| -1 ->
|
||||
make_if_test konst Arg.ltint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.leint arg i ifso ifnot
|
||||
|
||||
and make_if_gt konst arg i ifso ifnot = match i with
|
||||
| -1 ->
|
||||
make_if_test konst Arg.geint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.gtint arg i ifso ifnot
|
||||
|
||||
and make_if_ge konst arg i ifso ifnot = match i with
|
||||
| 1 ->
|
||||
make_if_test konst Arg.gtint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.geint arg i ifso ifnot
|
||||
|
||||
and make_if_eq konst arg i ifso ifnot =
|
||||
make_if_test konst Arg.eqint arg i ifso ifnot
|
||||
|
||||
and make_if_ne konst arg i ifso ifnot =
|
||||
make_if_test konst Arg.neint arg i ifso ifnot
|
||||
|
||||
let do_make_if_out h arg ifso ifno =
|
||||
Arg.make_if (Arg.make_isout h arg) ifso ifno
|
||||
|
||||
let make_if_out konst ctx l d mk_ifso mk_ifno = match l with
|
||||
| 0 ->
|
||||
do_make_if_out
|
||||
(konst d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
|
||||
| _ ->
|
||||
Arg.bind
|
||||
(Arg.make_offset ctx.arg (-l))
|
||||
(fun arg ->
|
||||
let ctx = {off= (-l+ctx.off) ; arg=arg} in
|
||||
let make_if_test konst test arg i ifso ifnot =
|
||||
Arg.make_if
|
||||
(Arg.make_prim test [arg ; konst i])
|
||||
ifso ifnot
|
||||
|
||||
let make_if_lt konst arg i ifso ifnot = match i with
|
||||
| 1 ->
|
||||
make_if_test konst Arg.leint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.ltint arg i ifso ifnot
|
||||
|
||||
and make_if_le konst arg i ifso ifnot = match i with
|
||||
| -1 ->
|
||||
make_if_test konst Arg.ltint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.leint arg i ifso ifnot
|
||||
|
||||
and make_if_gt konst arg i ifso ifnot = match i with
|
||||
| -1 ->
|
||||
make_if_test konst Arg.geint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.gtint arg i ifso ifnot
|
||||
|
||||
and make_if_ge konst arg i ifso ifnot = match i with
|
||||
| 1 ->
|
||||
make_if_test konst Arg.gtint arg 0 ifso ifnot
|
||||
| _ ->
|
||||
make_if_test konst Arg.geint arg i ifso ifnot
|
||||
|
||||
and make_if_eq konst arg i ifso ifnot =
|
||||
make_if_test konst Arg.eqint arg i ifso ifnot
|
||||
|
||||
and make_if_ne konst arg i ifso ifnot =
|
||||
make_if_test konst Arg.neint arg i ifso ifnot
|
||||
|
||||
let do_make_if_out h arg ifso ifno =
|
||||
Arg.make_if (Arg.make_isout h arg) ifso ifno
|
||||
|
||||
let make_if_out konst ctx l d mk_ifso mk_ifno = match l with
|
||||
| 0 ->
|
||||
do_make_if_out
|
||||
(konst d) arg (mk_ifso ctx) (mk_ifno ctx))
|
||||
|
||||
let do_make_if_in h arg ifso ifno =
|
||||
Arg.make_if (Arg.make_isin h arg) ifso ifno
|
||||
|
||||
let make_if_in konst ctx l d mk_ifso mk_ifno = match l with
|
||||
| 0 ->
|
||||
do_make_if_in
|
||||
(konst d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
|
||||
| _ ->
|
||||
Arg.bind
|
||||
(Arg.make_offset ctx.arg (-l))
|
||||
(fun arg ->
|
||||
let ctx = {off= (-l+ctx.off) ; arg=arg} in
|
||||
(konst d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
|
||||
| _ ->
|
||||
Arg.bind
|
||||
(Arg.make_offset ctx.arg (-l))
|
||||
(fun arg ->
|
||||
let ctx = {off= (-l+ctx.off) ; arg=arg} in
|
||||
do_make_if_out
|
||||
(konst d) arg (mk_ifso ctx) (mk_ifno ctx))
|
||||
|
||||
let do_make_if_in h arg ifso ifno =
|
||||
Arg.make_if (Arg.make_isin h arg) ifso ifno
|
||||
|
||||
let make_if_in konst ctx l d mk_ifso mk_ifno = match l with
|
||||
| 0 ->
|
||||
do_make_if_in
|
||||
(konst d) arg (mk_ifso ctx) (mk_ifno ctx))
|
||||
|
||||
|
||||
let rec c_test konst ctx ({cases=cases ; actions=actions} as s) =
|
||||
let lcases = Array.length cases in
|
||||
assert(lcases > 0) ;
|
||||
if lcases = 1 then
|
||||
actions.(get_act cases 0) ctx
|
||||
else begin
|
||||
|
||||
let w,c = opt_count false cases in
|
||||
(konst d) ctx.arg (mk_ifso ctx) (mk_ifno ctx)
|
||||
| _ ->
|
||||
Arg.bind
|
||||
(Arg.make_offset ctx.arg (-l))
|
||||
(fun arg ->
|
||||
let ctx = {off= (-l+ctx.off) ; arg=arg} in
|
||||
do_make_if_in
|
||||
(konst d) arg (mk_ifso ctx) (mk_ifno ctx))
|
||||
|
||||
|
||||
let rec c_test konst ctx ({cases=cases ; actions=actions} as s) =
|
||||
let lcases = Array.length cases in
|
||||
assert(lcases > 0) ;
|
||||
if lcases = 1 then
|
||||
actions.(get_act cases 0) ctx
|
||||
else begin
|
||||
|
||||
let w,c = opt_count false cases in
|
||||
(*
|
||||
Printf.fprintf stderr
|
||||
"off=%d tactic=%a for %a\n"
|
||||
ctx.off pret w pcases cases ;
|
||||
*)
|
||||
Printf.fprintf stderr
|
||||
"off=%d tactic=%a for %a\n"
|
||||
ctx.off pret w pcases cases ;
|
||||
*)
|
||||
match w with
|
||||
| No -> actions.(get_act cases 0) ctx
|
||||
| Inter (i,j) ->
|
||||
|
|
@ -753,23 +776,37 @@ let make_clusters ({cases=cases ; actions=actions} as s) n_clusters k =
|
|||
|
||||
let zyva (low,high) konst arg cases actions =
|
||||
let lcases = Array.length cases in
|
||||
let old_ok = !ok_inter in
|
||||
ok_inter := (abs low <= inter_limit && abs high <= inter_limit) ;
|
||||
if !ok_inter <> old_ok then Hashtbl.clear t ;
|
||||
|
||||
let s = {cases=cases ; actions=actions} in
|
||||
(*
|
||||
Printf.eprintf "ZYVA: %b\n" !ok_inter ;
|
||||
pcases stderr cases ;
|
||||
prerr_endline "" ;
|
||||
*)
|
||||
let n_clusters,k = comp_clusters s in
|
||||
let clusters = make_clusters s n_clusters k in
|
||||
c_test konst {arg=arg ; off=0} clusters
|
||||
let r = c_test konst {arg=arg ; off=0} clusters in
|
||||
r
|
||||
|
||||
|
||||
|
||||
and test_sequence konst arg cases actions =
|
||||
let old_ok = !ok_inter in
|
||||
ok_inter := false ;
|
||||
if !ok_inter <> old_ok then Hashtbl.clear t ;
|
||||
let s =
|
||||
{cases=cases ;
|
||||
actions=Array.map (fun act -> (fun _ -> act)) actions} in
|
||||
c_test konst {arg=arg ; off=0} s
|
||||
(*
|
||||
Printf.eprintf "SEQUENCE: %b\n" !ok_inter ;
|
||||
pcases stderr cases ;
|
||||
prerr_endline "" ;
|
||||
*)
|
||||
let r = c_test konst {arg=arg ; off=0} s in
|
||||
r
|
||||
;;
|
||||
|
||||
end
|
||||
|
|
|
|||
|
|
@ -11,16 +11,16 @@ cFont.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
|||
cFrame.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cGrab.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cGrid.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cImage.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cImagebitmap.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cImage.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cImagephoto.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cLabel.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cListbox.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cMenu.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cMenubutton.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cMenu.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cMessage.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cOption.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cOptionmenu.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cOption.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cPack.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cPalette.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cPixmap.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
|
|
@ -36,6 +36,22 @@ cTkwait.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
|||
cToplevel.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cWinfo.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
cWm.cmi: cTk.cmo ../support/textvariable.cmi ../support/widget.cmi
|
||||
camltk.cmo: cBell.cmi cButton.cmi cCanvas.cmi cCheckbutton.cmi cClipboard.cmi \
|
||||
cDialog.cmi cEncoding.cmi cEntry.cmi cFocus.cmi cFont.cmi cFrame.cmi \
|
||||
cGrab.cmi cGrid.cmi cImage.cmi cImagebitmap.cmi cImagephoto.cmi \
|
||||
cLabel.cmi cListbox.cmi cMenu.cmi cMenubutton.cmi cMessage.cmi \
|
||||
cOption.cmi cOptionmenu.cmi cPack.cmi cPalette.cmi cPixmap.cmi cPlace.cmi \
|
||||
cRadiobutton.cmi cResource.cmi cScale.cmi cScrollbar.cmi cSelection.cmi \
|
||||
cText.cmi cTk.cmo cTkvars.cmi cTkwait.cmi cToplevel.cmi cWinfo.cmi \
|
||||
cWm.cmi
|
||||
camltk.cmx: cBell.cmx cButton.cmx cCanvas.cmx cCheckbutton.cmx cClipboard.cmx \
|
||||
cDialog.cmx cEncoding.cmx cEntry.cmx cFocus.cmx cFont.cmx cFrame.cmx \
|
||||
cGrab.cmx cGrid.cmx cImage.cmx cImagebitmap.cmx cImagephoto.cmx \
|
||||
cLabel.cmx cListbox.cmx cMenu.cmx cMenubutton.cmx cMessage.cmx \
|
||||
cOption.cmx cOptionmenu.cmx cPack.cmx cPalette.cmx cPixmap.cmx cPlace.cmx \
|
||||
cRadiobutton.cmx cResource.cmx cScale.cmx cScrollbar.cmx cSelection.cmx \
|
||||
cText.cmx cTk.cmx cTkvars.cmx cTkwait.cmx cToplevel.cmx cWinfo.cmx \
|
||||
cWm.cmx
|
||||
cBell.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cBell.cmi
|
||||
cBell.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
|
|
@ -88,14 +104,14 @@ cGrid.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
|||
../support/widget.cmi cGrid.cmi
|
||||
cGrid.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cGrid.cmi
|
||||
cImage.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cImage.cmi
|
||||
cImage.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cImage.cmi
|
||||
cImagebitmap.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cImagebitmap.cmi
|
||||
cImagebitmap.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cImagebitmap.cmi
|
||||
cImage.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cImage.cmi
|
||||
cImage.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cImage.cmi
|
||||
cImagephoto.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cImagephoto.cmi
|
||||
cImagephoto.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
|
|
@ -108,26 +124,26 @@ cListbox.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
|||
../support/widget.cmi cListbox.cmi
|
||||
cListbox.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cListbox.cmi
|
||||
cMenu.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cMenu.cmi
|
||||
cMenu.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cMenu.cmi
|
||||
cMenubutton.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cMenubutton.cmi
|
||||
cMenubutton.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cMenubutton.cmi
|
||||
cMenu.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cMenu.cmi
|
||||
cMenu.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cMenu.cmi
|
||||
cMessage.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cMessage.cmi
|
||||
cMessage.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cMessage.cmi
|
||||
cOption.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cOption.cmi
|
||||
cOption.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cOption.cmi
|
||||
cOptionmenu.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cOptionmenu.cmi
|
||||
cOptionmenu.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cOptionmenu.cmi
|
||||
cOption.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cOption.cmi
|
||||
cOption.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cOption.cmi
|
||||
cPack.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
||||
../support/widget.cmi cPack.cmi
|
||||
cPack.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
|
|
@ -192,19 +208,3 @@ cWm.cmo: cTk.cmo ../support/protocol.cmi ../support/textvariable.cmi \
|
|||
../support/widget.cmi cWm.cmi
|
||||
cWm.cmx: cTk.cmx ../support/protocol.cmx ../support/textvariable.cmx \
|
||||
../support/widget.cmx cWm.cmi
|
||||
camltk.cmo: cBell.cmi cButton.cmi cCanvas.cmi cCheckbutton.cmi cClipboard.cmi \
|
||||
cDialog.cmi cEncoding.cmi cEntry.cmi cFocus.cmi cFont.cmi cFrame.cmi \
|
||||
cGrab.cmi cGrid.cmi cImage.cmi cImagebitmap.cmi cImagephoto.cmi \
|
||||
cLabel.cmi cListbox.cmi cMenu.cmi cMenubutton.cmi cMessage.cmi \
|
||||
cOption.cmi cOptionmenu.cmi cPack.cmi cPalette.cmi cPixmap.cmi cPlace.cmi \
|
||||
cRadiobutton.cmi cResource.cmi cScale.cmi cScrollbar.cmi cSelection.cmi \
|
||||
cText.cmi cTk.cmo cTkvars.cmi cTkwait.cmi cToplevel.cmi cWinfo.cmi \
|
||||
cWm.cmi
|
||||
camltk.cmx: cBell.cmx cButton.cmx cCanvas.cmx cCheckbutton.cmx cClipboard.cmx \
|
||||
cDialog.cmx cEncoding.cmx cEntry.cmx cFocus.cmx cFont.cmx cFrame.cmx \
|
||||
cGrab.cmx cGrid.cmx cImage.cmx cImagebitmap.cmx cImagephoto.cmx \
|
||||
cLabel.cmx cListbox.cmx cMenu.cmx cMenubutton.cmx cMessage.cmx \
|
||||
cOption.cmx cOptionmenu.cmx cPack.cmx cPalette.cmx cPixmap.cmx cPlace.cmx \
|
||||
cRadiobutton.cmx cResource.cmx cScale.cmx cScrollbar.cmx cSelection.cmx \
|
||||
cText.cmx cTk.cmx cTkvars.cmx cTkwait.cmx cToplevel.cmx cWinfo.cmx \
|
||||
cWm.cmx
|
||||
|
|
|
|||
|
|
@ -11,16 +11,16 @@ font.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
|||
frame.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
grab.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
grid.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
image.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
imagebitmap.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
image.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
imagephoto.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
label.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
listbox.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
menu.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
menubutton.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
menu.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
message.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
option.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
optionmenu.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
option.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
pack.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
palette.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
pixmap.cmi: ../support/textvariable.cmi tk.cmo ../support/widget.cmi
|
||||
|
|
@ -87,14 +87,14 @@ grid.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
|||
../support/widget.cmi grid.cmi
|
||||
grid.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx grid.cmi
|
||||
image.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi image.cmi
|
||||
image.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx image.cmi
|
||||
imagebitmap.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi imagebitmap.cmi
|
||||
imagebitmap.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx imagebitmap.cmi
|
||||
image.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi image.cmi
|
||||
image.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx image.cmi
|
||||
imagephoto.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi imagephoto.cmi
|
||||
imagephoto.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
|
|
@ -125,26 +125,26 @@ listbox.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
|||
../support/widget.cmi listbox.cmi
|
||||
listbox.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx listbox.cmi
|
||||
menu.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi menu.cmi
|
||||
menu.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx menu.cmi
|
||||
menubutton.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi menubutton.cmi
|
||||
menubutton.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx menubutton.cmi
|
||||
menu.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi menu.cmi
|
||||
menu.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx menu.cmi
|
||||
message.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi message.cmi
|
||||
message.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx message.cmi
|
||||
option.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi option.cmi
|
||||
option.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx option.cmi
|
||||
optionmenu.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi optionmenu.cmi
|
||||
optionmenu.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx optionmenu.cmi
|
||||
option.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi option.cmi
|
||||
option.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
../support/widget.cmx option.cmi
|
||||
pack.cmo: ../support/protocol.cmi ../support/textvariable.cmi tk.cmo \
|
||||
../support/widget.cmi pack.cmi
|
||||
pack.cmx: ../support/protocol.cmx ../support/textvariable.cmx tk.cmx \
|
||||
|
|
|
|||
|
|
@ -1043,3 +1043,31 @@ test "seb" seb ((0,Uout),Uin) 2 ;
|
|||
()
|
||||
;;
|
||||
|
||||
(* Talk with Jacques
|
||||
- type 'b is still open ??
|
||||
- better case generation, accept intervals of size 1 when ok_inter is
|
||||
false (in Switch)
|
||||
*)
|
||||
|
||||
(*
|
||||
File "morematch.ml", line 1060, characters 8-65:
|
||||
Warning: this pattern-matching is not exhaustive.
|
||||
Here is an example of a value that is not matched:
|
||||
A `D
|
||||
*)
|
||||
type ('a, 'b) t_j = A of 'a | B of 'b * 'a | C
|
||||
|
||||
let f = function
|
||||
| A (`A|`C) -> 0
|
||||
| B (`B,`D) -> 1
|
||||
| C -> 2
|
||||
|
||||
let g x = try f x with Match_failure _ -> 3
|
||||
|
||||
let _ =
|
||||
test "jacques" g (A `A) 0 ;
|
||||
test "jacques" g (A `C) 0 ;
|
||||
test "jacques" g (B (`B,`D)) 1 ;
|
||||
test "jacaues" g C 2 ;
|
||||
test "jacques" g (B (`A,`D)) 3 ;
|
||||
()
|
||||
|
|
|
|||
|
|
@ -832,11 +832,12 @@ type 'a result =
|
|||
| Rnone (* No matching value *)
|
||||
| Rsome of 'a (* This matching value *)
|
||||
|
||||
let rec try_many f = function
|
||||
(* boolean argument ``variants'' is unused at present *)
|
||||
let rec try_many variants f = function
|
||||
| [] -> Rnone
|
||||
| x::rest ->
|
||||
begin match f x with
|
||||
| Rnone -> try_many f rest
|
||||
| Rnone -> try_many variants f rest
|
||||
| r -> r
|
||||
end
|
||||
|
||||
|
|
@ -861,15 +862,15 @@ let rec exhaust variants tdefs pss n = match pss with
|
|||
| Rsome r -> Rsome (set_args p r)
|
||||
| r -> r in
|
||||
if full_match tdefs true constrs
|
||||
then try_many try_non_omega constrs
|
||||
then try_many variants try_non_omega constrs
|
||||
else
|
||||
match exhaust variants tdefs (filter_extra pss) (n-1) with
|
||||
| Rnone -> try_many try_non_omega constrs
|
||||
| Rnone -> try_many variants try_non_omega constrs
|
||||
| Rsome r ->
|
||||
(* try all constructors anyway, for variant typing ! *)
|
||||
(* Note: it may impact dramatically on cost *)
|
||||
if variants then
|
||||
ignore (try_many try_non_omega constrs) ;
|
||||
ignore (try_many variants try_non_omega constrs) ;
|
||||
try
|
||||
Rsome (build_other constrs::r)
|
||||
with
|
||||
|
|
|
|||
Loading…
Reference in New Issue