[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