[MLton-commit] r6623

Vesa Karvonen vesak at mlton.org
Thu May 15 15:07:45 PDT 2008


Yet another example.
----------------------------------------------------------------------

A   mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.mlb
A   mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.sml

----------------------------------------------------------------------

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.mlb	2008-05-14 16:27:16 UTC (rev 6622)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.mlb	2008-05-15 22:07:44 UTC (rev 6623)
@@ -0,0 +1,17 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+../../basis.mlb
+
+local
+   ann
+      "warnUnused true"
+      "sequenceNonUnit warn"
+   in
+      pancakes.sml
+   end
+in
+end


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.sml	2008-05-14 16:27:16 UTC (rev 6622)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.sml	2008-05-15 22:07:44 UTC (rev 6623)
@@ -0,0 +1,60 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * This is based on Haskell code from the thread
+ *
+ *   Pancake sorting with the shortest series of flips, a la brute force,
+ *   from new Haskeller.
+ *   http://groups.google.com/group/comp.lang.haskell/browse_frm/thread/9151e2be8aef1cc4#
+ *
+ * on comp.lang.haskell.  Of course, this version uses iterators in SML
+ * rather than lazy lists in Haskell.
+ *)
+
+open Cvt Iter
+
+val filter = Monad.filter
+
+val rec isSorted =
+ fn []      => true
+  | [_]     => true
+  | f::s::r => f <= s andalso isSorted (s::r)
+
+fun reverseTop (n, s) = List.revAppend (List.split (s, n))
+
+fun variations m n = let
+   fun vars y =
+    fn 0 => return []
+     | n => filter (notEq y) (upTo (m+1) From 2 $) >>= (fn x =>
+            vars x (n-1) >>= (fn xs =>
+            return (x::xs)))
+in
+   vars 0 n
+end
+
+fun incVariations m = up From 1 $ >>= variations m
+
+fun exec ? = foldl reverseTop ?
+
+fun search xs =
+    if isSorted xs
+    then SOME []
+    else first (filter (isSorted o exec xs) (incVariations (length xs)))
+
+val xs = List.mapPartial Int.fromString (CommandLine.arguments ())
+
+val () =
+    case search xs
+     of NONE    => println "Impossible!"
+      | SOME is =>
+        recur (is & xs) (fn lp =>
+           fn []    &  _ => ()
+            | i::is & xs =>
+              case reverseTop (i, xs)
+               of ys =>
+                  (printlns ["reverseTop (", D i, ", ", L D xs, ") => ", L D ys]
+                 ; lp (is & ys)))


Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/example/iter/pancakes.sml
___________________________________________________________________
Name: svn:eol-style
   + native




More information about the MLton-commit mailing list