You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
142 lines
6.5 KiB
142 lines
6.5 KiB
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
|