1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
http://sourceforge.net/p/polyml/code/1869/
Required for sci-mathematics/isabelle-2013.2
------------------------------------------------------------------------
r1869 | dcjm | 2013-10-11 05:59:58 -0600 (Fri, 11 Oct 2013) | 1 line
Back-port commits 1855 and 1867 from trunk. These fix two optimiser bugs. Includes the regression tests.
Index: polyml/mlsource/MLCompiler/CodeTree/CODETREE_OPTIMISER.sml
===================================================================
--- polyml/mlsource/MLCompiler/CodeTree/CODETREE_OPTIMISER.sml (revision 1851)
+++ polyml/mlsource/MLCompiler/CodeTree/CODETREE_OPTIMISER.sml (working copy)
@@ -645,8 +645,9 @@
(thisDec :: decs, thisArg @ args, LoadLocal newAddr :: mapList)
end
- | mapPattern(ArgPattCurry(currying, ArgPattTuple{allConst=false, filter, ...}) :: patts, n, m) =
- (* It's a function that returns a tuple. *)
+ | mapPattern(ArgPattCurry(currying as [_], ArgPattTuple{allConst=false, filter, ...}) :: patts, n, m) =
+ (* It's a function that returns a tuple. The function must not be curried because
+ otherwise it returns a function not a tuple. *)
let
val (thisDec, thisArg, thisMap) =
transformFunctionArgument(currying, [LoadArgument m], [LoadArgument n], SOME filter)
@@ -657,7 +658,7 @@
| mapPattern(ArgPattCurry(currying as firstArgSet :: _, _) :: patts, n, m) =
(* Transform it if it's curried or if there is a tuple in the first arg. *)
- if List.length currying >= 2 orelse
+ if (*List.length currying >= 2 orelse *) (* This transformation is unsafe. *)
List.exists(fn ArgPattTuple{allConst=false, ...} => true | _ => false) firstArgSet
then
let
@@ -685,6 +686,13 @@
and transformFunctionArgument(argumentArgs, loadPack, loadThisArg, filterOpt) =
let
+ (* Disable the transformation of curried arguments for the moment.
+ This is unsafe. See Test146. The problem is that this transformation
+ is only safe if the function is applied immediately to all the arguments.
+ However the usage information is propagated so that if the result of
+ the first application is bound to a variable and then that variable is
+ applied it still appears as curried. *)
+ val argumentArgs = [hd argumentArgs]
(* We have a function that takes a series of curried argument.
Change that so that the function takes a list of arguments. *)
val newAddr = ! localCounter before localCounter := ! localCounter + 1
@@ -1214,9 +1222,11 @@
let
fun checkArg (ArgPattTuple{allConst=false, ...}) = true
(* Function has at least one tupled arg. *)
- | checkArg (ArgPattCurry(_, ArgPattTuple{allConst=false, ...})) = true
- (* Function has an arg that is a function that returns a tuple. *)
- | checkArg (ArgPattCurry(_ :: _ :: _, _)) = true
+ | checkArg (ArgPattCurry([_], ArgPattTuple{allConst=false, ...})) = true
+ (* Function has an arg that is a function that returns a tuple.
+ It must not be curried otherwise it returns a function not a tuple. *)
+ (* This transformation is unsafe. See comment in transformFunctionArgument above. *)
+ (*| checkArg (ArgPattCurry(_ :: _ :: _, _)) = true *)
(* Function has an arg that is a curried function. *)
| checkArg (ArgPattCurry(firstArgSet :: _, _)) =
(* Function has an arg that is a function that
Index: polyml/Tests/Succeed/Test146.ML
===================================================================
--- polyml/Tests/Succeed/Test146.ML (revision 0)
+++ polyml/Tests/Succeed/Test146.ML (revision 1875)
@@ -0,0 +1,24 @@
+(* Bug in transformation of arguments which are curried functions. It is not
+ safe to transform "f" in the argument to "bar". Although it is curried
+ the application to the first argument "()" is not immediately followed
+ by the application to the second. *)
+
+local
+ val r = ref 0
+in
+ (* Foo should be called exactly once *)
+ fun foo () = (r:= !r+1; fn i => i)
+
+ fun checkOnce () = if !r = 1 then () else raise Fail "bad"
+end;
+
+fun bar f = let val r = f() in (r 1; r 2; List.map r [1, 2, 3]) end;
+
+bar foo;
+
+checkOnce();
+
+exception A and B and C;
+fun rA () = raise A and rB () = raise B;
+fun h (f, g) = let val a = f() in g(); a () end;
+h(rA, rB) handle A => ();
Property changes on: polyml/Tests/Succeed/Test146.ML
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Index: polyml/Tests/Succeed/Test147.ML
===================================================================
--- polyml/Tests/Succeed/Test147.ML (revision 0)
+++ polyml/Tests/Succeed/Test147.ML (revision 1875)
@@ -0,0 +1,31 @@
+(* Bug in optimiser transformation. A function argument that returns a tuple
+ can be transformed to take a container but only if it is not curried. *)
+
+(* Cut down example from Isabelle that caused an internal error exception. *)
+
+fun one _ [] = raise Fail "bad"
+ | one pred (x :: xs) =
+ if pred x then (x, xs) else raise Fail "bad";
+
+fun foo (scan, f) xs = let val (x, y) = scan xs in (f x, y) end;
+
+fun bar (scan1, scan2) xs =
+ let
+ val (x, ys) = scan1 xs;
+ val (y, zs) = scan2 x ys;
+ in ((x, y), zs) end;
+
+fun bub (scan1, scan2) = foo(bar(scan1, (fn _ => scan2)), op ^);
+
+val qqq: string list -> string * int = bub(one (fn _ => raise Match), (foo((fn _ => raise Match), String.concat)));
+
+(* Further example - This caused a segfault. *)
+
+PolyML.Compiler.maxInlineSize := 1;
+fun f g = let val (x,y) = g 1 2 in x+y end;
+
+fun r (x, y, z) = fn _ => (x, y+z);
+
+val h: int-> int*int = r (4,5,6);
+
+f (fn _ => h);
Property changes on: polyml/Tests/Succeed/Test147.ML
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
|
GitWeb