[gentoo-commits] gentoo-x86 commit in dev-lang/polyml/files: polyml-5.5.1-inputN-return-for-zero-chars.patch polyml-5.5.1-optimize-closure.patch polyml-5.5.1-mprotect-exec.patch

[Mark Wright (gienah)]

gienah      14/02/11 14:35:09

  Added:                polyml-5.5.1-inputN-return-for-zero-chars.patch
                        polyml-5.5.1-optimize-closure.patch
                        polyml-5.5.1-mprotect-exec.patch
  Log:
  Bump polyml to 5.5.1. Fix bug 453146 - dev-lang/polyml-5.5.0: fails to build (pax kernel?) by paxmark m poly and polyimport.
  
  (Portage version: 2.2.8-r1/cvs/Linux x86_64, signed Manifest commit with key 618E971F)

Revision  Changes    Path
1.1                  dev-lang/polyml/files/polyml-5.5.1-inputN-return-for-zero-chars.patch

file : http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-lang/polyml/files/polyml-5.5.1-inputN-return-for-zero-chars.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-lang/polyml/files/polyml-5.5.1-inputN-return-for-zero-chars.patch?rev=1.1&content-type=text/plain

Index: polyml-5.5.1-inputN-return-for-zero-chars.patch
===================================================================
http://sourceforge.net/p/polyml/code/1875/
Required for sci-mathematics/isabelle-2013.2

------------------------------------------------------------------------
r1875 | dcjm | 2013-10-30 10:49:05 -0600 (Wed, 30 Oct 2013) | 1 line

Backport commit 1874 from trunk.  This fixes TextIO.inputN and StreamIO.inputN so they return immediately if the request is for zero characters.
Index: polyml/basis/BasicStreamIO.sml
===================================================================
--- polyml/basis/BasicStreamIO.sml	(revision 1851)
+++ polyml/basis/BasicStreamIO.sml	(working copy)
@@ -213,6 +213,8 @@
         fun inputN (f, n) =
         if n < 0
         then raise Size
+        else if n = 0 (* Defined to return the empty vector and f *)
+        then (emptyVec, f)
         else
         let
             val (vecs, f') = inputNList (f, n)
Index: polyml/basis/TextIO.sml
===================================================================
--- polyml/basis/TextIO.sml	(revision 1851)
+++ polyml/basis/TextIO.sml	(working copy)
@@ -597,6 +597,8 @@
         |   inputN' n (ref(Direct(strm as {buffer, bufp, buflimit, ...}))) =
             if n < 0 orelse n > CharVector.maxLen
             then raise Size
+            else if n = 0
+            then "" (* Return the empty string without blocking *)
             else if !buflimit = 0
             then (* Last read returned end-of-file.  Clear the EOF state once
                     we return this empty string. *)



1.1                  dev-lang/polyml/files/polyml-5.5.1-optimize-closure.patch

file : http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-lang/polyml/files/polyml-5.5.1-optimize-closure.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-lang/polyml/files/polyml-5.5.1-optimize-closure.patch?rev=1.1&content-type=text/plain

Index: polyml-5.5.1-optimize-closure.patch
===================================================================
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



1.1                  dev-lang/polyml/files/polyml-5.5.1-mprotect-exec.patch

file : http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-lang/polyml/files/polyml-5.5.1-mprotect-exec.patch?rev=1.1&view=markup
plain: http://sources.gentoo.org/viewvc.cgi/gentoo-x86/dev-lang/polyml/files/polyml-5.5.1-mprotect-exec.patch?rev=1.1&content-type=text/plain

Index: polyml-5.5.1-mprotect-exec.patch
===================================================================
--- polyml.5.5.1-orig/libpolyml/memmgr.cpp	2013-07-10 22:56:07.000000000 +1000
+++ polyml.5.5.1/libpolyml/memmgr.cpp	2014-02-10 14:08:51.866219101 +1100
@@ -80,7 +80,7 @@
     // Allocate the heap itself.
     size_t iSpace = size*sizeof(PolyWord);
     bottom  =
-        (PolyWord*)osMemoryManager->Allocate(iSpace, PERMISSION_READ|PERMISSION_WRITE|PERMISSION_EXEC);
+        (PolyWord*)osMemoryManager->Allocate(iSpace, PERMISSION_READ|PERMISSION_EXEC);
 
     if (bottom == 0)
         return false;
@@ -359,7 +359,7 @@
         // Allocate the memory itself.
         size_t iSpace = size*sizeof(PolyWord);
         space->bottom  =
-            (PolyWord*)osMemoryManager->Allocate(iSpace, PERMISSION_READ|PERMISSION_WRITE|PERMISSION_EXEC);
+            (PolyWord*)osMemoryManager->Allocate(iSpace, PERMISSION_READ|PERMISSION_EXEC);
 
         if (space->bottom == 0)
         {
@@ -728,7 +728,7 @@
             LocalMemSpace *space = lSpaces[i];
             if (! space->isMutable)
                 osMemoryManager->SetPermissions(space->bottom, (char*)space->top - (char*)space->bottom,
-                    on ? PERMISSION_READ|PERMISSION_EXEC : PERMISSION_READ|PERMISSION_EXEC|PERMISSION_WRITE);
+                    on ? PERMISSION_READ|PERMISSION_EXEC : PERMISSION_READ|PERMISSION_WRITE);
         }
     }
 }