https://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