[MLton-commit] r6713
Matthew Fluet
fluet at mlton.org
Tue Aug 19 15:09:56 PDT 2008
Introduce '-polyvariance-hofo {true|false}'.
Introduce a compile-time option that controls whether or not
polyvariance applies to higher-order functions only. While not
necessarily generally useful, it can introduce enough inlining so that
SXML PrimApp constant folding and algebraic identities are triggered.
Nonetheless, benchmarks seem to show that there are instances where it
can be beneficial (and instances where it can be harmful):
Benchmarks:
============================================================
SHADOW (Dual-processor AMD Opteron 2.0GHz, 8GB Memory, Fedora Core 7)
MLton0 -- ~/devel/mlton/mlton-20070826-1/build/bin/mlton
MLton1 -- ~/devel/mlton/mlton.svn.trunk/build/bin/mlton
MLton2 -- ~/devel/mlton/mlton.git-svn.trunk/build/bin/mlton -polyvariance-hofo false
MLton3 -- ~/devel/mlton/mlton.git-svn.trunk/build/bin/mlton -polyvariance-hofo true
run time ratio
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 1.00 0.94 0.76 0.93
boyer 1.00 0.93 1.06 0.98
checksum 1.00 1.01 1.01 1.01
count-graphs 1.00 1.09 1.11 1.10
DLXSimulator 1.00 1.01 1.06 1.04
fft 1.00 0.90 1.00 0.89
fib 1.00 1.00 1.01 1.01
flat-array 1.00 1.17 1.05 1.00
hamlet 1.00 1.02 1.23 1.07
imp-for 1.00 1.01 1.01 1.01
knuth-bendix 1.00 0.97 0.98 0.98
lexgen 1.00 0.89 1.14 0.87
life 1.00 1.05 1.03 1.05
logic 1.00 0.99 1.00 1.02
mandelbrot 1.00 1.00 0.96 0.96
matrix-multiply 1.00 0.97 1.00 1.04
md5 1.00 0.96 0.63 0.96
merge 1.00 0.97 0.98 1.02
mlyacc 1.00 0.96 0.99 0.98
model-elimination 1.00 0.95 1.00 0.97
mpuz 1.00 0.91 0.94 0.92
nucleic 1.00 1.09 1.14 1.09
output1 1.00 0.70 0.74 0.70
peek 1.00 0.75 0.75 0.74
psdes-random 1.00 0.96 0.94 0.94
ratio-regions 1.00 1.06 0.79 1.05
ray 1.00 0.99 0.80 0.99
raytrace 1.00 0.94 1.12 0.94
simple 1.00 1.02 1.00 1.03
smith-normal-form 1.00 1.06 1.06 1.06
tailfib 1.00 1.02 1.00 1.01
tak 1.00 0.97 0.97 0.97
tensor 1.00 0.99 1.20 0.99
tsp 1.00 1.18 1.19 1.19
tyan 1.00 1.00 1.01 1.01
vector-concat 1.00 0.97 0.99 0.99
vector-rev 1.00 1.06 0.89 1.12
vliw 1.00 0.80 0.74 0.82
wc-input1 1.00 0.81 1.00 0.82
wc-scanStream 1.00 1.01 1.12 1.03
zebra 1.00 1.00 0.99 0.98
zern 1.00 0.88 0.54 0.90
size
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 167,519 165,599 171,535 165,631
boyer 213,378 218,146 240,898 218,146
checksum 93,410 98,002 98,002 98,002
count-graphs 119,666 124,082 127,330 124,082
DLXSimulator 195,933 201,053 265,277 201,053
fft 117,168 120,480 120,480 120,480
fib 93,298 97,890 97,890 97,890
flat-array 92,802 97,426 97,426 97,426
hamlet 1,504,314 1,508,586 2,014,522 1,510,906
imp-for 93,122 97,714 97,714 97,714
knuth-bendix 171,709 176,973 249,693 176,973
lexgen 285,148 290,588 331,404 290,604
life 117,810 122,354 129,266 122,354
logic 177,538 182,146 182,322 182,146
mandelbrot 92,962 97,602 97,602 97,602
matrix-multiply 94,978 99,586 99,586 99,586
md5 126,765 131,869 134,861 131,869
merge 94,626 99,218 99,218 99,218
mlyacc 661,740 662,812 822,508 662,812
model-elimination 850,115 865,571 1,062,963 865,587
mpuz 99,586 103,858 103,826 103,858
nucleic 268,833 273,633 282,369 273,441
output1 136,545 141,249 145,985 141,217
peek 132,333 137,421 139,421 137,421
psdes-random 96,194 100,786 100,786 100,786
ratio-regions 120,738 125,394 128,898 125,394
ray 244,873 248,905 312,265 248,889
raytrace 372,643 377,699 573,619 377,683
simple 343,306 347,098 393,578 347,178
smith-normal-form 271,821 276,621 295,549 276,621
tailfib 92,866 97,458 97,458 97,458
tak 93,314 97,938 97,938 97,938
tensor 162,244 167,236 192,516 167,236
tsp 139,324 144,876 146,972 144,892
tyan 212,285 217,197 238,253 217,213
vector-concat 94,610 99,234 99,234 99,234
vector-rev 94,370 98,994 98,434 98,994
vliw 519,083 528,011 796,667 528,043
wc-input1 159,067 164,059 167,419 164,059
wc-scanStream 169,867 174,843 177,451 174,843
zebra 212,429 217,485 220,685 217,485
zern 132,151 135,191 140,951 135,175
compile time
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 10.41 10.51 10.67 10.15
boyer 10.26 10.65 11.42 10.92
checksum 7.82 7.73 7.77 7.87
count-graphs 8.90 8.14 9.48 8.77
DLXSimulator 10.98 10.69 13.84 11.56
fft 8.40 8.58 8.19 8.62
fib 8.07 8.33 7.93 7.65
flat-array 8.07 7.38 8.04 8.38
hamlet 49.73 48.31 61.98 46.04
imp-for 7.92 7.85 8.01 7.84
knuth-bendix 10.16 9.48 11.97 10.12
lexgen 12.73 12.44 14.40 12.43
life 8.71 8.25 8.41 8.24
logic 10.14 9.65 10.47 9.95
mandelbrot 7.93 7.60 7.95 7.77
matrix-multiply 8.07 7.95 7.84 8.42
md5 9.03 8.63 8.85 8.55
merge 8.10 7.69 8.04 8.52
mlyacc 27.88 27.00 33.88 27.45
model-elimination 26.60 25.49 29.98 25.84
mpuz 8.18 7.64 7.77 7.83
nucleic 11.66 11.50 12.41 12.33
output1 8.74 8.33 9.12 9.19
peek 8.97 8.44 9.83 8.69
psdes-random 7.94 7.57 7.85 7.82
ratio-regions 9.17 8.83 10.51 9.30
ray 11.83 11.97 13.62 11.62
raytrace 14.93 16.25 21.92 16.64
simple 14.38 13.75 14.98 13.84
smith-normal-form 12.05 12.77 12.27 11.95
tailfib 7.96 7.86 7.56 7.62
tak 8.52 7.88 7.88 7.56
tensor 10.16 10.59 11.57 10.89
tsp 9.04 9.28 8.87 8.89
tyan 11.13 11.03 11.54 10.90
vector-concat 7.74 7.65 7.63 7.65
vector-rev 7.60 7.85 7.56 7.59
vliw 19.58 19.15 29.46 19.58
wc-input1 9.23 9.22 9.62 9.68
wc-scanStream 9.52 10.23 9.69 9.52
zebra 10.78 11.36 11.58 11.85
zern 8.49 8.89 8.71 8.39
run time
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 16.55 15.59 12.57 15.34
boyer 39.10 36.54 41.29 38.27
checksum 18.53 18.74 18.69 18.72
count-graphs 29.58 32.34 32.96 32.59
DLXSimulator 26.97 27.32 28.48 28.17
fft 14.83 13.41 14.78 13.23
fib 41.20 41.19 41.52 41.66
flat-array 29.16 34.05 30.67 29.21
hamlet 41.55 42.39 51.12 44.41
imp-for 26.68 26.97 26.95 26.95
knuth-bendix 24.80 24.02 24.28 24.31
lexgen 24.81 21.99 28.27 21.56
life 19.51 20.47 20.02 20.47
logic 28.08 27.73 28.20 28.74
mandelbrot 21.72 21.70 20.81 20.94
matrix-multiply 30.12 29.25 30.07 31.40
md5 34.00 32.66 21.53 32.75
merge 48.82 47.49 47.83 49.56
mlyacc 26.25 25.14 25.86 25.65
model-elimination 37.61 35.78 37.72 36.34
mpuz 29.34 26.84 27.46 27.06
nucleic 16.17 17.61 18.42 17.54
output1 41.93 29.43 30.83 29.25
peek 35.07 26.18 26.43 26.05
psdes-random 18.59 17.80 17.39 17.51
ratio-regions 130.03 137.29 102.16 137.09
ray 17.21 17.10 13.86 17.08
raytrace 21.59 20.28 24.13 20.40
simple 23.29 23.77 23.29 23.99
smith-normal-form 8.79 9.30 9.31 9.28
tailfib 23.78 24.19 23.70 23.91
tak 32.94 31.85 32.11 32.02
tensor 22.87 22.73 27.37 22.73
tsp 22.09 26.13 26.32 26.38
tyan 27.68 27.68 28.05 27.95
vector-concat 30.32 29.42 29.93 30.02
vector-rev 46.90 49.51 41.51 52.45
vliw 33.26 26.49 24.56 27.28
wc-input1 35.34 28.76 35.20 29.10
wc-scanStream 29.17 29.61 32.64 30.03
zebra 41.32 41.16 40.80 40.38
zern 25.69 22.62 13.76 23.06
============================================================
FENRIR (Dual-processor Dual-core Intel Xeon 2.0GHz, 2GB Memory, MacOS 10.4)
MLton0 -- ~/devel/mlton/mlton-20070826-1/build/bin/mlton
MLton1 -- ~/devel/mlton/mlton.svn.trunk/build/bin/mlton
MLton2 -- ~/devel/mlton/mlton.git-svn.trunk/build/bin/mlton -polyvariance-hofo false
MLton3 -- ~/devel/mlton/mlton.git-svn.trunk/build/bin/mlton -polyvariance-hofo true
run time ratio
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 1.00 1.05 0.93 1.05
boyer 1.00 1.10 1.02 1.10
checksum 1.00 1.00 1.00 1.00
count-graphs 1.00 0.93 0.93 0.93
DLXSimulator 1.00 0.94 1.01 0.94
fft 1.00 1.00 1.00 1.00
fib 1.00 1.12 1.12 1.12
flat-array 1.00 1.00 1.00 1.00
hamlet 1.00 1.05 1.02 1.07
imp-for 1.00 1.00 1.00 1.00
knuth-bendix 1.00 1.02 1.01 1.02
lexgen 1.00 0.98 1.27 0.98
life 1.00 1.01 0.97 1.01
logic 1.00 0.99 0.98 0.98
mandelbrot 1.00 1.00 1.00 1.00
matrix-multiply 1.00 1.00 1.00 1.00
md5 1.00 1.00 0.82 1.01
merge 1.00 1.00 1.01 1.01
mlyacc 1.00 0.96 1.10 0.96
model-elimination 1.00 0.99 1.02 0.99
mpuz 1.00 1.06 1.04 1.06
nucleic 1.00 0.94 1.04 0.94
output1 1.00 1.42 0.83 1.35
peek 1.00 0.99 0.99 1.02
psdes-random 1.00 0.98 0.99 1.00
ratio-regions 1.00 1.02 0.87 1.02
ray 1.00 0.99 0.96 0.98
raytrace 1.00 1.03 1.21 1.04
simple 1.00 0.91 0.92 0.96
smith-normal-form 1.00 1.00 1.00 1.00
tailfib 1.00 1.00 1.00 1.00
tak 1.00 0.97 0.97 0.97
tensor 1.00 1.01 1.00 1.00
tsp 1.00 1.04 1.01 1.04
tyan 1.00 1.00 1.00 1.00
vector-concat 1.00 1.00 1.00 1.00
vector-rev 1.00 1.00 0.99 1.00
vliw 1.00 0.92 0.84 0.92
wc-input1 1.00 1.01 1.00 1.01
wc-scanStream 1.00 0.99 0.99 0.99
zebra 1.00 1.00 0.96 1.00
zern 1.00 1.00 0.40 1.00
size
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 167,936 172,032 167,936 172,032
boyer 204,800 208,896 229,376 208,896
checksum 106,496 110,592 110,592 110,592
count-graphs 126,976 131,072 135,168 131,072
DLXSimulator 196,608 200,704 258,048 200,704
fft 126,976 131,072 131,072 131,072
fib 106,496 110,592 110,592 110,592
flat-array 102,400 110,592 110,592 110,592
hamlet 1,335,296 1,343,488 1,753,088 1,347,584
imp-for 106,496 110,592 110,592 110,592
knuth-bendix 176,128 184,320 245,760 184,320
lexgen 274,432 282,624 311,296 282,624
life 126,976 135,168 139,264 135,168
logic 172,032 180,224 180,224 180,224
mandelbrot 106,496 110,592 110,592 110,592
matrix-multiply 106,496 110,592 110,592 110,592
md5 139,264 143,360 147,456 143,360
merge 106,496 110,592 110,592 110,592
mlyacc 602,112 610,304 737,280 610,304
model-elimination 729,088 741,376 897,024 741,376
mpuz 114,688 114,688 114,688 114,688
nucleic 278,528 286,720 290,816 286,720
output1 143,360 151,552 151,552 151,552
peek 143,360 147,456 151,552 147,456
psdes-random 106,496 110,592 110,592 110,592
ratio-regions 131,072 135,168 139,264 135,168
ray 237,568 241,664 286,720 241,664
raytrace 331,776 339,968 475,136 339,968
simple 307,200 307,200 348,160 307,200
smith-normal-form 262,144 270,336 278,528 270,336
tailfib 102,400 110,592 110,592 110,592
tak 106,496 110,592 110,592 110,592
tensor 167,936 176,128 192,512 176,128
tsp 143,360 151,552 155,648 151,552
tyan 208,896 212,992 229,376 212,992
vector-concat 106,496 110,592 110,592 110,592
vector-rev 106,496 110,592 110,592 110,592
vliw 466,944 475,136 696,320 475,136
wc-input1 167,936 172,032 176,128 172,032
wc-scanStream 176,128 180,224 184,320 180,224
zebra 212,992 217,088 221,184 217,088
zern 135,168 139,264 143,360 139,264
compile time
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 5.71 5.63 5.62 5.54
boyer 5.60 5.65 5.88 5.65
checksum 4.44 4.50 4.47 4.51
count-graphs 4.85 4.82 4.88 4.83
DLXSimulator 5.87 5.93 6.98 5.92
fft 4.67 4.74 4.73 4.81
fib 4.41 4.47 4.53 4.54
flat-array 4.44 4.56 4.50 4.55
hamlet 22.38 23.57 30.65 21.91
imp-for 4.42 4.49 4.48 4.49
knuth-bendix 5.22 5.32 6.21 5.34
lexgen 6.72 6.87 7.16 6.72
life 4.69 4.73 4.79 4.73
logic 5.42 5.49 5.50 5.48
mandelbrot 4.43 4.53 4.52 4.52
matrix-multiply 4.46 4.54 4.49 4.56
md5 4.80 4.86 4.93 4.87
merge 4.71 4.49 4.59 4.68
mlyacc 14.82 14.33 17.08 14.25
model-elimination 13.23 12.75 15.07 13.10
mpuz 4.57 4.57 4.81 4.55
nucleic 6.59 6.58 6.67 6.70
output1 4.95 4.88 4.92 4.89
peek 5.24 4.94 4.92 4.88
psdes-random 4.45 4.63 4.54 4.53
ratio-regions 5.06 5.14 5.33 5.13
ray 6.38 6.41 7.10 6.49
raytrace 8.12 8.15 10.74 8.13
simple 7.25 7.05 7.90 7.02
smith-normal-form 6.12 6.18 6.42 6.21
tailfib 4.41 4.47 4.46 4.47
tak 4.39 4.48 4.47 4.49
tensor 5.65 5.71 5.89 5.70
tsp 4.97 5.06 5.13 5.09
tyan 6.00 6.04 6.39 6.04
vector-concat 4.40 4.49 4.47 4.51
vector-rev 4.42 4.47 4.47 4.51
vliw 10.08 10.22 15.17 10.59
wc-input1 5.10 5.22 5.30 5.20
wc-scanStream 5.24 5.32 5.40 5.32
zebra 6.10 6.13 6.30 6.13
zern 4.80 4.87 4.93 4.84
run time
benchmark MLton0 MLton1 MLton2 MLton3
barnes-hut 11.85 12.42 11.02 12.42
boyer 17.90 19.68 18.31 19.69
checksum 30.93 30.94 30.92 30.94
count-graphs 13.06 12.14 12.16 12.14
DLXSimulator 11.25 10.61 11.31 10.58
fft 12.53 12.50 12.47 12.49
fib 19.35 21.63 21.66 21.64
flat-array 13.85 13.84 13.84 13.83
hamlet 19.21 20.16 19.51 20.56
imp-for 13.38 13.37 13.37 13.37
knuth-bendix 11.66 11.86 11.73 11.87
lexgen 10.00 9.81 12.65 9.80
life 11.75 11.83 11.45 11.82
logic 11.75 11.59 11.52 11.50
mandelbrot 19.00 19.00 19.00 19.00
matrix-multiply 12.53 12.47 12.51 12.56
md5 18.61 18.55 15.28 18.71
merge 17.25 17.28 17.46 17.43
mlyacc 12.95 12.47 14.28 12.42
model-elimination 22.87 22.54 23.28 22.60
mpuz 12.54 13.28 13.02 13.24
nucleic 11.02 10.38 11.43 10.35
output1 14.21 20.24 11.84 19.25
peek 18.63 18.52 18.35 18.95
psdes-random 13.13 12.93 13.00 13.13
ratio-regions 48.68 49.60 42.49 49.59
ray 13.55 13.44 13.01 13.32
raytrace 11.39 11.77 13.74 11.87
simple 12.53 11.36 11.48 11.99
smith-normal-form 14.46 14.42 14.42 14.41
tailfib 13.62 13.62 13.62 13.62
tak 14.47 14.01 14.01 14.01
tensor 20.93 21.09 20.93 20.93
tsp 23.15 23.99 23.49 23.98
tyan 12.23 12.18 12.27 12.19
vector-concat 18.57 18.58 18.55 18.57
vector-rev 19.62 19.66 19.41 19.61
vliw 13.50 12.47 11.32 12.48
wc-input1 14.27 14.38 14.30 14.46
wc-scanStream 18.57 18.47 18.36 18.45
zebra 16.07 16.06 15.41 16.06
zern 14.72 14.71 5.84 14.76
----------------------------------------------------------------------
U mlton/trunk/mlton/control/control-flags.sig
U mlton/trunk/mlton/control/control-flags.sml
U mlton/trunk/mlton/main/main.fun
U mlton/trunk/mlton/xml/polyvariance.fun
U mlton/trunk/mlton/xml/sxml-simplify.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/control/control-flags.sig
===================================================================
--- mlton/trunk/mlton/control/control-flags.sig 2008-08-19 22:09:48 UTC (rev 6712)
+++ mlton/trunk/mlton/control/control-flags.sig 2008-08-19 22:09:55 UTC (rev 6713)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -271,6 +271,7 @@
*)
val polyvariance:
{
+ hofo: bool,
rounds: int,
small: int,
product: int
Modified: mlton/trunk/mlton/control/control-flags.sml
===================================================================
--- mlton/trunk/mlton/control/control-flags.sml 2008-08-19 22:09:48 UTC (rev 6712)
+++ mlton/trunk/mlton/control/control-flags.sml 2008-08-19 22:09:55 UTC (rev 6713)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -840,15 +840,17 @@
val polyvariance =
control {name = "polyvariance",
- default = SOME {rounds = 2,
+ default = SOME {hofo = true,
+ rounds = 2,
small = 30,
product = 300},
toString =
fn p =>
Layout.toString
(Option.layout
- (fn {rounds, small, product} =>
- Layout.record [("rounds", Int.layout rounds),
+ (fn {hofo, rounds, small, product} =>
+ Layout.record [("hofo", Bool.layout hofo),
+ ("rounds", Int.layout rounds),
("small", Int.layout small),
("product", Int.layout product)])
p)}
Modified: mlton/trunk/mlton/main/main.fun
===================================================================
--- mlton/trunk/mlton/main/main.fun 2008-08-19 22:09:48 UTC (rev 6712)
+++ mlton/trunk/mlton/main/main.fun 2008-08-19 22:09:55 UTC (rev 6713)
@@ -535,27 +535,39 @@
SpaceString (fn s => output := SOME s)),
(Expert, "polyvariance", " {true|false}", "use polyvariance",
Bool (fn b => if b then () else polyvariance := NONE)),
+ (Expert, "polyvariance-hofo", " {true|false}", "duplicate higher-order fns only",
+ Bool (fn hofo =>
+ case !polyvariance of
+ SOME {product, rounds, small, ...} =>
+ polyvariance := SOME {hofo = hofo,
+ product = product,
+ rounds = rounds,
+ small = small}
+ | _ => ())),
(Expert, "polyvariance-product", " <n>", "set polyvariance threshold (300)",
Int (fn product =>
case !polyvariance of
- SOME {rounds, small, ...} =>
- polyvariance := SOME {product = product,
+ SOME {hofo, rounds, small, ...} =>
+ polyvariance := SOME {hofo = hofo,
+ product = product,
rounds = rounds,
small = small}
| _ => ())),
(Expert, "polyvariance-rounds", " <n>", "set polyvariance rounds (2)",
Int (fn rounds =>
case !polyvariance of
- SOME {product, small, ...} =>
- polyvariance := SOME {product = product,
+ SOME {hofo, product, small, ...} =>
+ polyvariance := SOME {hofo = hofo,
+ product = product,
rounds = rounds,
small = small}
| _ => ())),
(Expert, "polyvariance-small", " <n>", "set polyvariance threshold (30)",
Int (fn small =>
case !polyvariance of
- SOME {product, rounds, ...} =>
- polyvariance := SOME {product = product,
+ SOME {hofo, product, rounds, ...} =>
+ polyvariance := SOME {hofo = hofo,
+ product = product,
rounds = rounds,
small = small}
| _ => ())),
Modified: mlton/trunk/mlton/xml/polyvariance.fun
===================================================================
--- mlton/trunk/mlton/xml/polyvariance.fun 2008-08-19 22:09:48 UTC (rev 6712)
+++ mlton/trunk/mlton/xml/polyvariance.fun 2008-08-19 22:09:55 UTC (rev 6713)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -79,7 +79,7 @@
size
end
-fun shouldDuplicate (program as Program.T {body, ...}, small, product)
+fun shouldDuplicate (program as Program.T {body, ...}, hofo, small, product)
: Var.t -> bool =
let
val costs: (Var.t * int * int * int) list ref = ref []
@@ -94,7 +94,7 @@
val {get = varInfo: Var.t -> info option, set = setVarInfo, ...} =
Property.getSetOnce (Var.plist, Property.initConst NONE)
fun new {lambda = _, ty, var}: unit =
- if Type.isHigherOrder ty
+ if not hofo orelse Type.isHigherOrder ty
then setVarInfo (var, SOME {numOccurrences = ref 0,
shouldDuplicate = ref false})
else ()
@@ -230,10 +230,11 @@
end
fun duplicate (program as Program.T {datatypes, body, overflow},
+ hofo: bool,
small: int,
product: int) =
let
- val shouldDuplicate = shouldDuplicate (program, small, product)
+ val shouldDuplicate = shouldDuplicate (program, hofo, small, product)
datatype info =
Replace of Var.t
| Dup of {
@@ -433,13 +434,13 @@
fn p =>
case !Control.polyvariance of
NONE => p
- | SOME {rounds, small, product} =>
+ | SOME {hofo, rounds, small, product} =>
let
fun loop (p, n) =
if n = 0
then p
else let
- val p = shrink (duplicate (p, small, product))
+ val p = shrink (duplicate (p, hofo, small, product))
val _ =
Control.message (Control.Detail, fn () =>
Program.layoutStats p)
Modified: mlton/trunk/mlton/xml/sxml-simplify.fun
===================================================================
--- mlton/trunk/mlton/xml/sxml-simplify.fun 2008-08-19 22:09:48 UTC (rev 6712)
+++ mlton/trunk/mlton/xml/sxml-simplify.fun 2008-08-19 22:09:55 UTC (rev 6713)
@@ -1,4 +1,4 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-2000 NEC Research Institute.
*
@@ -17,10 +17,10 @@
(* structure Uncurry = Uncurry (open S) *)
structure CPSTransform = CPSTransform (open S)
-fun polyvariance (rounds, small, product) p =
+fun polyvariance (hofo, rounds, small, product) p =
Ref.fluidLet
(Control.polyvariance,
- SOME {rounds = rounds, small = small, product = product},
+ SOME {hofo = hofo, rounds = rounds, small = small, product = product},
fn () => Polyvariance.duplicate p)
type pass = {name: string,
@@ -106,19 +106,21 @@
fn s =>
if String.hasPrefix (s, {prefix = "polyvariance"})
then let
- fun mk (rounds, small, product) =
+ fun mk (hofo, rounds, small, product) =
SOME {name = concat ["polyvariance(",
+ Bool.toString hofo, ",",
Int.toString rounds, ",",
Int.toString small, ",",
Int.toString product, ")#",
Int.toString (Counter.next count)],
enable = fn () => true,
- doit = polyvariance (rounds, small, product)}
+ doit = polyvariance (hofo, rounds, small, product)}
val s = String.dropPrefix (s, String.size "polyvariance")
in
case nums s of
- SOME [] => mk (2, 30, 300)
- | SOME [rounds, small, product] => mk (rounds, small, product)
+ SOME [] => mk (true, 2, 30, 300)
+ | SOME [hofo, rounds, small, product] =>
+ mk (hofo <> 0, rounds, small, product)
| _ => NONE
end
else NONE
More information about the MLton-commit
mailing list