[MLton-commit] r6630
Vesa Karvonen
vesak at mlton.org
Fri May 30 06:12:39 PDT 2008
Indentation.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/example/canonize-uni.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/read.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/some.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/uniplate.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -357,7 +357,7 @@
end
fun mkSeq (Ops.S {length, toSlice, getItem, fromList, ...})
- (P {rd = aR, wr = aW, ...}) =
+ (P {rd = aR, wr = aW, ...}) =
P {rd = let
open I
fun lp (0, es) = return (fromList (rev es))
Modified: mltonlib/trunk/com/ssh/generic/unstable/example/canonize-uni.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/example/canonize-uni.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/example/canonize-uni.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -72,9 +72,9 @@
in
fun free term =
difference
- (union (refs term,
- reduceC Lambda.t empty union free term),
- decs term)
+ (union (refs term,
+ reduceC Lambda.t empty union free term),
+ decs term)
end
(* To understand how the {free} function works, note that the {refs} and
* {decs} functions return just the immediate variable references and
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -12,26 +12,26 @@
in
val () =
unitTests
- (title "Generic.Fmap")
+ (title "Generic.Fmap")
- (testEq (list word)
+ (testEq (list word)
+ (fn () =>
+ {expect = [0w1, 0w2, 0w3],
+ actual = ListF.map Word.fromInt [1, 2, 3]}))
+
+ let
+ open BinTree BinTreeF
+ in
+ testEq (t word)
(fn () =>
- {expect = [0w1, 0w2, 0w3],
- actual = ListF.map Word.fromInt [1, 2, 3]}))
+ {expect = BR (BR (LF, 0w0, LF),
+ 0w1,
+ BR (LF, 0w2, BR (LF, 0w3, LF))),
+ actual = map Word.fromInt
+ (BR (BR (LF, 0, LF),
+ 1,
+ BR (LF, 2, BR (LF, 3, LF))))})
+ end
- let
- open BinTree BinTreeF
- in
- testEq (t word)
- (fn () =>
- {expect = BR (BR (LF, 0w0, LF),
- 0w1,
- BR (LF, 0w2, BR (LF, 0w3, LF))),
- actual = map Word.fromInt
- (BR (BR (LF, 0, LF),
- 1,
- BR (LF, 2, BR (LF, 3, LF))))})
- end
-
- $
+ $
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -27,31 +27,31 @@
val p = pickle t (some t)
in
thatRaises'
- (fn Pickle.TypeMismatch => ())
- (fn () => unpickle u p)
+ (fn Pickle.TypeMismatch => ())
+ (fn () => unpickle u p)
end)
in
unitTests
- (title "Generic.Pickle")
+ (title "Generic.Pickle")
- (testAllSeq (vector (option (list real))))
- (testAllSeq (tuple2 (fixedInt, largeInt)))
- (testAllSeq (largeReal &` largeWord))
- (testAllSeq (tuple3 (word8, word32, int32)))
- (testAllSeq (bool &` char &` int &` real &` string &` word))
+ (testAllSeq (vector (option (list real))))
+ (testAllSeq (tuple2 (fixedInt, largeInt)))
+ (testAllSeq (largeReal &` largeWord))
+ (testAllSeq (tuple3 (word8, word32, int32)))
+ (testAllSeq (bool &` char &` int &` real &` string &` word))
- (title "Generic.Pickle.Cyclic")
+ (title "Generic.Pickle.Cyclic")
- (testSeq (Graph.t int) Graph.intGraph1)
- (testSeq (array exn) ExnArray.exnArray1)
+ (testSeq (Graph.t int) Graph.intGraph1)
+ (testSeq (array exn) ExnArray.exnArray1)
- (title "Generic.Pickle.TypeMismatch")
+ (title "Generic.Pickle.TypeMismatch")
- (testTypeMismatch int word)
- (testTypeMismatch (list char) (vector word8))
- (testTypeMismatch (array real) (option largeReal))
+ (testTypeMismatch int word)
+ (testTypeMismatch (list char) (vector word8))
+ (testTypeMismatch (array real) (option largeReal))
- (title "Generic.Pickle.Customization")
+ (title "Generic.Pickle.Customization")
(test (fn () => let
(* This test shows how pickles can be versioned and multiple
@@ -77,18 +77,18 @@
(fn {id = a, extra = b, name = c} => a & b & c,
fn a & b & c => {id = a, extra = b, name = c})
- (* Then we assign version {2} to the new type, keeping the
- * version {1} for the old type: *)
+ (* Then we assign version {2} to the new type, keeping the version
+ * {1} for the old type: *)
val t = versioned (version 1 t1
- (fn {id, name} =>
- {id = id, extra = false, name = name}))
+ (fn {id, name} =>
+ {id = id, extra = false, name = name}))
$ 2 t2
- (* Note that the original versioned {t} is no longer needed.
- * In an actual program, you would have just edited the
- * original definition instead of introducing a new one.
- * However, the old type rep is required if you wish to be
- * able to unpickle old versions. *)
+ (* Note that the original versioned {t} is no longer needed. In
+ * an actual program, you would have just edited the original
+ * definition instead of introducing a new one. However, the old
+ * type rep is required if you wish to be able to unpickle old
+ * versions. *)
in
thatEq t {expect = {id = 1, extra = false, name = "whatever"},
actual = unpickle t v1pickle}
@@ -100,8 +100,8 @@
(title "Generic.Pickle.Format")
(test (fn () => let
- (* The main purpose of this highly ad hoc test is to help
- * notice when the pickle format changes. *)
+ (* The main purpose of this highly ad hoc test is to help notice
+ * when the pickle format changes. *)
datatype t =
NIL
| CON of {bool : Bool.t Vector.t,
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -13,134 +13,134 @@
testEq string (fn () => {expect = s, actual = render n (fmt t f v)})
in
unitTests
- (title "Generic.Pretty")
+ (title "Generic.Pretty")
- (tst NONE Fmt.default unit "()" ())
+ (tst NONE Fmt.default unit "()" ())
- (tst NONE Fmt.default word "0wx15" 0wx15)
+ (tst NONE Fmt.default word "0wx15" 0wx15)
- (tst (SOME 6) Fmt.default (list int)
- "[1,\n 2,\n 3]"
- [1, 2, 3])
+ (tst (SOME 6) Fmt.default (list int)
+ "[1,\n 2,\n 3]"
+ [1, 2, 3])
- (tst (SOME 2) Fmt.default (vector bool)
- "#[true,\n\
- \ false]"
- (Vector.fromList [true, false]))
+ (tst (SOME 2) Fmt.default (vector bool)
+ "#[true,\n\
+ \ false]"
+ (Vector.fromList [true, false]))
- (tst (SOME 15) Fmt.default (tuple3 (option unit, string, exn))
- "(NONE,\n\
- \ \"a\",\n\
- \ Empty)"
- (NONE, "a", Empty))
+ (tst (SOME 15) Fmt.default (tuple3 (option unit, string, exn))
+ "(NONE,\n\
+ \ \"a\",\n\
+ \ Empty)"
+ (NONE, "a", Empty))
- (tst NONE Fmt.default (array unit) "#()" (Array.array (0, ())))
+ (tst NONE Fmt.default (array unit) "#()" (Array.array (0, ())))
- (tst NONE Fmt.default real "~3.141" ~3.141)
+ (tst NONE Fmt.default real "~3.141" ~3.141)
- (tst (SOME 22) Fmt.default
- ((order |` unit) &` order &` (unit |` order))
- "INL LESS\n\
- \& EQUAL\n\
- \& INR GREATER"
- (INL LESS & EQUAL & INR GREATER))
+ (tst (SOME 22) Fmt.default
+ ((order |` unit) &` order &` (unit |` order))
+ "INL LESS\n\
+ \& EQUAL\n\
+ \& INR GREATER"
+ (INL LESS & EQUAL & INR GREATER))
- let
- fun chk s e = tst (SOME 11) Fmt.default string e s
- in
- fn ? =>
- (pass ?)
- (chk "does not fit" "\"does not fit\"")
- (chk "does\nnot\nfit" "\"does\\n\\\n\\not\\n\\\n\\fit\"")
- (chk "does fit" "\"does fit\"")
- (chk "does\nfit" "\"does\\nfit\"")
- end
+ let
+ fun chk s e = tst (SOME 11) Fmt.default string e s
+ in
+ fn ? =>
+ (pass ?)
+ (chk "does not fit" "\"does not fit\"")
+ (chk "does\nnot\nfit" "\"does\\n\\\n\\not\\n\\\n\\fit\"")
+ (chk "does fit" "\"does fit\"")
+ (chk "does\nfit" "\"does\\nfit\"")
+ end
- let
- exception Unknown
- in
- tst NONE Fmt.default exn "#Unknown" Unknown
- end
+ let
+ exception Unknown
+ in
+ tst NONE Fmt.default exn "#Unknown" Unknown
+ end
- (tst (SOME 9)
- let open Fmt in default & fieldNest := SOME 4 end
- (iso (record (R' "1" int
- *` R' "+" (unOp int)
- *` R' "long" char))
- (fn {1 = a, + = b, long = c} => a & b & c,
- fn a & b & c => {1 = a, + = b, long = c}))
- "{1 = 200000000,\n\
- \ + = #fn,\n\
- \ long =\n\
- \ #\"d\"}"
- {1 = 200000000, + = id, long = #"d"})
+ (tst (SOME 9)
+ let open Fmt in default & fieldNest := SOME 4 end
+ (iso (record (R' "1" int
+ *` R' "+" (unOp int)
+ *` R' "long" char))
+ (fn {1 = a, + = b, long = c} => a & b & c,
+ fn a & b & c => {1 = a, + = b, long = c}))
+ "{1 = 200000000,\n\
+ \ + = #fn,\n\
+ \ long =\n\
+ \ #\"d\"}"
+ {1 = 200000000, + = id, long = #"d"})
- let
- datatype s = S of s Option.t Ref.t Sq.t
- val x as S (l, r) = S (ref NONE, ref NONE)
- val () = (l := SOME x ; r := SOME x)
- in
- tst (SOME 50) Fmt.default
- ((Tie.fix Y)
- (fn s =>
- iso (data (C1' "S" (sq (refc (option s)))))
- (fn S ? => ?, S)))
- "S\n\
- \ (#0=ref\n\
- \ (SOME (S (#0, #1=ref (SOME (S (#0, #1)))))),\n\
- \ #1)"
- x
- end
+ let
+ datatype s = S of s Option.t Ref.t Sq.t
+ val x as S (l, r) = S (ref NONE, ref NONE)
+ val () = (l := SOME x ; r := SOME x)
+ in
+ tst (SOME 50) Fmt.default
+ ((Tie.fix Y)
+ (fn s =>
+ iso (data (C1' "S" (sq (refc (option s)))))
+ (fn S ? => ?, S)))
+ "S\n\
+ \ (#0=ref\n\
+ \ (SOME (S (#0, #1=ref (SOME (S (#0, #1)))))),\n\
+ \ #1)"
+ x
+ end
- (tst (SOME 50) Fmt.default (Graph.t int)
- "ref\n\
- \ [VTX\n\
- \ (1,\n\
- \ #0=ref\n\
- \ [VTX\n\
- \ (2,\n\
- \ #4=ref\n\
- \ [VTX\n\
- \ (3,\n\
- \ #5=ref\n\
- \ [VTX (1, #0),\n\
- \ VTX\n\
- \ (6,\n\
- \ #1=ref\n\
- \ [VTX\n\
- \ (5,\n\
- \ #2=ref\n\
- \ [VTX\n\
- \ (4,\n\
- \ #3=ref\n\
- \ [VTX (6, #1)])])])]),\n\
- \ VTX (5, #2)]),\n\
- \ VTX (4, #3)]),\n\
- \ VTX (2, #4),\n\
- \ VTX (3, #5),\n\
- \ VTX (4, #3),\n\
- \ VTX (5, #2),\n\
- \ VTX (6, #1)]"
- Graph.intGraph1)
+ (tst (SOME 50) Fmt.default (Graph.t int)
+ "ref\n\
+ \ [VTX\n\
+ \ (1,\n\
+ \ #0=ref\n\
+ \ [VTX\n\
+ \ (2,\n\
+ \ #4=ref\n\
+ \ [VTX\n\
+ \ (3,\n\
+ \ #5=ref\n\
+ \ [VTX (1, #0),\n\
+ \ VTX\n\
+ \ (6,\n\
+ \ #1=ref\n\
+ \ [VTX\n\
+ \ (5,\n\
+ \ #2=ref\n\
+ \ [VTX\n\
+ \ (4,\n\
+ \ #3=ref\n\
+ \ [VTX (6, #1)])])])]),\n\
+ \ VTX (5, #2)]),\n\
+ \ VTX (4, #3)]),\n\
+ \ VTX (2, #4),\n\
+ \ VTX (3, #5),\n\
+ \ VTX (4, #3),\n\
+ \ VTX (5, #2),\n\
+ \ VTX (6, #1)]"
+ Graph.intGraph1)
- let
- open BinTree Prettier Pretty Pretty.Fixity
- fun withAngles xP x =
- xP x >>= (fn (_, d) => return (ATOMIC, angles d))
- in
- tst (SOME 30)
- let open Fmt in default & conNest := NONE end
- (BinTree.t (mapPrinter withAngles int))
- "BR (BR (LF, <0>, LF),\n\
- \ <1>,\n\
- \ BR (LF,\n\
- \ <2>,\n\
- \ BR (LF, <3>, LF)))"
- (BR (BR (LF, 0, LF), 1, BR (LF, 2, BR (LF, 3, LF))))
- end
+ let
+ open BinTree Prettier Pretty Pretty.Fixity
+ fun withAngles xP x =
+ xP x >>= (fn (_, d) => return (ATOMIC, angles d))
+ in
+ tst (SOME 30)
+ let open Fmt in default & conNest := NONE end
+ (BinTree.t (mapPrinter withAngles int))
+ "BR (BR (LF, <0>, LF),\n\
+ \ <1>,\n\
+ \ BR (LF,\n\
+ \ <2>,\n\
+ \ BR (LF, <3>, LF)))"
+ (BR (BR (LF, 0, LF), 1, BR (LF, 2, BR (LF, 3, LF))))
+ end
- (tst NONE let open Fmt in default & intRadix := StringCvt.HEX end
- int "~0x10" ~16)
+ (tst NONE let open Fmt in default & intRadix := StringCvt.HEX end
+ int "~0x10" ~16)
- $
+ $
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/read.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/read.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/read.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -19,7 +19,7 @@
app (fn format =>
thatSeq t {expect = x,
actual = read t (Prettier.render
- (SOME 5) (fmt t format x))})
+ (SOME 5) (fmt t format x))})
formats)
fun testRs t ss =
@@ -39,13 +39,13 @@
in
fun ps t =
mapPrinter
- (fn p => fn x =>
- p x >>= (fn (a, d) =>
- return (if Word.isOdd (hash t x)
- then (a, d)
- else (Fixity.ATOMIC,
- txt " (* (*:-)*) *) ( (* :-( *) " <^> d <^>
- txt " (*) *) ) (* foo *) "))))
+ (fn p => fn x =>
+ p x >>= (fn (a, d) =>
+ return (if Word.isOdd (hash t x)
+ then (a, d)
+ else (Fixity.ATOMIC,
+ txt " (* (*:-)*) *) ( (* :-( *) " <^> d <^>
+ txt " (*) *) ) (* foo *) "))))
t
end
@@ -67,32 +67,32 @@
fn a & b & c => {foo = a, + = b, bar = c}))
in
unitTests
- (title "Generic.Read")
+ (title "Generic.Read")
- (testSR word (fmts Fmt.wordRadix radices))
- (testSR int (fmts Fmt.intRadix radices))
+ (testSR word (fmts Fmt.wordRadix radices))
+ (testSR int (fmts Fmt.intRadix radices))
- (testSR (array (refc order)) [Fmt.default])
+ (testSR (array (refc order)) [Fmt.default])
- (testSR foobar [Fmt.default])
+ (testSR foobar [Fmt.default])
- (testRs foobar [("{+ = ( ( ) ) , bar = #\"3\", foo = true}",
- {foo = true, + = (), bar = #"3"})])
+ (testRs foobar [("{+ = ( ( ) ) , bar = #\"3\", foo = true}",
+ {foo = true, + = (), bar = #"3"})])
- (testRs (tuple2 (int, string))
- [("{1 = 3, 2 = \"4\"}",
- {1 = 3, 2 = "4"}),
- ("((*;)*)({2 = \"2\", 1 = 1}(*;)*))) (*;)*)",
- {1 = 1, 2 = "2"}),
- ("(2, \"1\")",
- (2, "1"))])
+ (testRs (tuple2 (int, string))
+ [("{1 = 3, 2 = \"4\"}",
+ {1 = 3, 2 = "4"}),
+ ("((*;)*)({2 = \"2\", 1 = 1}(*;)*))) (*;)*)",
+ {1 = 1, 2 = "2"}),
+ ("(2, \"1\")",
+ (2, "1"))])
- (testRs real [("-2.0e~10", ~2.0e~10), (" ( 1.2 ) ", 1.2)])
+ (testRs real [("-2.0e~10", ~2.0e~10), (" ( 1.2 ) ", 1.2)])
- (testSR (tuple2 (tuple2 (string, vector (option unit)), list char))
- [Fmt.default])
+ (testSR (tuple2 (tuple2 (string, vector (option unit)), list char))
+ [Fmt.default])
- (testFails (fn () => read int "0 garbage accepted"))
+ (testFails (fn () => read int "0 garbage accepted"))
- $
+ $
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -27,39 +27,39 @@
in
fun free (IN term) =
difference
- (union (refs term,
- makeReduce f t empty union free term),
- decs term)
+ (union (refs term,
+ makeReduce f t empty union free term),
+ decs term)
end
in
val () =
unitTests
- (title "Generic.Reduce")
+ (title "Generic.Reduce")
- (testReduce list int int 0 op + id [1, 2, 3] 6)
- (testReduce list real int 0 op + (const 1) [1.0, 4.0, 6.0] 3)
- (testReduce (fn t => tuple (T t *` T int *` T t)) int int 0 op + id
- (1 & 3 & 7) 8)
+ (testReduce list int int 0 op + id [1, 2, 3] 6)
+ (testReduce list real int 0 op + (const 1) [1.0, 4.0, 6.0] 3)
+ (testReduce (fn t => tuple (T t *` T int *` T t)) int int 0 op + id
+ (1 & 3 & 7) 8)
- let open BinTree in
- testReduce t int (list int) [] op @ (fn x => [x])
- (BR (BR (LF, 0, LF), 1, BR (LF, 2, BR (LF, 3, LF))))
- [0, 1, 2, 3]
- end
+ let open BinTree in
+ testReduce t int (list int) [] op @ (fn x => [x])
+ (BR (BR (LF, 0, LF), 1, BR (LF, 2, BR (LF, 3, LF))))
+ [0, 1, 2, 3]
+ end
- (testEq (list string)
- (fn () => let
- open Lambda
- fun ` f = IN o f
- in
- {actual = free (`APP (`FUN ("x",
- `APP (`REF "y", `REF "x")),
- `FUN ("z",
- `APP (`REF "x",
- `APP (`REF "y",
- `REF "x"))))),
- expect = ["y", "x"]}
- end))
+ (testEq (list string)
+ (fn () => let
+ open Lambda
+ fun ` f = IN o f
+ in
+ {actual = free (`APP (`FUN ("x",
+ `APP (`REF "y", `REF "x")),
+ `FUN ("z",
+ `APP (`REF "x",
+ `APP (`REF "y",
+ `REF "x"))))),
+ expect = ["y", "x"]}
+ end))
- $
+ $
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/some.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/some.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/some.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -7,30 +7,30 @@
val () = let
open Generic UnitTest
- fun listEither pair sumIn sumOut a =
+ fun listEither swap mirror a =
(Tie.fix Y)
- (fn aListLeft =>
- iso (data (op +` (pair (C0' "nil",
- C1' "::" (tuple2 (a, aListLeft))))))
- (sumIn o (fn [] => INL () | op :: ? => INR ?),
- (fn INL () => [] | INR ? => op :: ?) o sumOut))
+ (fn aListLeft =>
+ iso (data (op +` (swap (C0' "nil",
+ C1' "::" (tuple2 (a, aListLeft))))))
+ (mirror <--> (fn [] => INL () | op :: ? => INR ?,
+ fn INL () => [] | INR ? => op :: ?)))
- fun listL ? = listEither id id id ?
- fun listR ? = listEither Pair.swap Sum.swap Sum.swap ?
+ fun listL ? = listEither id (id, id) ?
+ fun listR ? = listEither swap (mirror, mirror) ?
in
unitTests
- (title "Generic.Some")
+ (title "Generic.Some")
- (* Test that generation terminates both ways. *)
- (testEq (list int)
- (fn () =>
- {actual = some (listL int),
- expect = some (listR int)}))
+ (* Test that generation terminates both ways. *)
+ (testEq (list int)
+ (fn () =>
+ {actual = some (listL int),
+ expect = some (listR int)}))
- (testEq (BinTree.t int)
- (fn () =>
- {actual = some (BinTree.t int),
- expect = BinTree.LF}))
+ (testEq (BinTree.t int)
+ (fn () =>
+ {actual = some (BinTree.t int),
+ expect = BinTree.LF}))
- $
+ $
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -7,28 +7,27 @@
val () = let
open Generic UnitTest
- fun testTransform t2t t unOp value expect = let
- val transform = makeTransform t2t t unOp
- in
- testEq (t2t t) (fn () => {expect = expect, actual = transform value})
- end
+ fun testTransform t2t t unOp value expect =
+ case makeTransform t2t t unOp
+ of transform =>
+ testEq (t2t t) (fn () => {expect = expect, actual = transform value})
in
unitTests
- (title "Generic.Transform")
+ (title "Generic.Transform")
- (testTransform list int (1 <\ op +) [1, 2, 3] [2, 3, 4])
- (testTransform (fn t => tuple (T int *` T t)) int op ~ (1 & 3) (1 & ~3))
+ (testTransform list int (1 <\ op +) [1, 2, 3] [2, 3, 4])
+ (testTransform (fn t => tuple (T int *` T t)) int op ~ (1 & 3) (1 & ~3))
- let
- datatype t = datatype BinTree.t
- in
- testTransform
- BinTree.t int (1 <\ op +)
- (BR (BR (LF, 0, LF), 1, BR (LF, 2, BR (LF, 3, LF))))
- (BR (BR (LF, 1, LF), 2, BR (LF, 3, BR (LF, 4, LF))))
- end
+ let
+ datatype t = datatype BinTree.t
+ in
+ testTransform
+ BinTree.t int (1 <\ op +)
+ (BR (BR (LF, 0, LF), 1, BR (LF, 2, BR (LF, 3, LF))))
+ (BR (BR (LF, 1, LF), 2, BR (LF, 3, BR (LF, 4, LF))))
+ end
- (testTransform Graph.t int op ~ Graph.intGraph1 Graph.intGraph1)
+ (testTransform Graph.t int op ~ Graph.intGraph1 Graph.intGraph1)
- $
+ $
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/uniplate.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/uniplate.sml 2008-05-30 13:09:30 UTC (rev 6629)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/uniplate.sml 2008-05-30 13:12:34 UTC (rev 6630)
@@ -39,42 +39,42 @@
(holesU t x)))
in
unitTests
- (title "Generic.Uniplate")
+ (title "Generic.Uniplate")
- (testUniplate (BinTree.t int))
- (testUniplate (list int))
+ (testUniplate (BinTree.t int))
+ (testUniplate (list int))
- (title "Generic.Uniplate.foldU")
+ (title "Generic.Uniplate.foldU")
- (testFoldU (BinTree.t int))
- (testFoldU (list int))
+ (testFoldU (BinTree.t int))
+ (testFoldU (list int))
- (title "Generic.Uniplate.rewrite")
+ (title "Generic.Uniplate.rewrite")
- let
- open BinTree
- val tryL =
- fn BR (BR (a, x, b), y, r) =>
- if y < x then SOME (BR (BR (a, y, b), x, r)) else NONE
- | _ => NONE
- val tryR =
- fn BR (l, y, BR (c, z, d)) =>
- if z < y then SOME (BR (l, z, BR (c, y, d))) else NONE
- | _ => NONE
- in
- testRewrite
- (t int)
- (fn x => case tryL x of NONE => tryR x | some => some)
- end
+ let
+ open BinTree
+ val tryL =
+ fn BR (BR (a, x, b), y, r) =>
+ if y < x then SOME (BR (BR (a, y, b), x, r)) else NONE
+ | _ => NONE
+ val tryR =
+ fn BR (l, y, BR (c, z, d)) =>
+ if z < y then SOME (BR (l, z, BR (c, y, d))) else NONE
+ | _ => NONE
+ in
+ testRewrite
+ (t int)
+ (fn x => case tryL x of NONE => tryR x | some => some)
+ end
- (testRewrite (list int)
- (fn x::y::r => if y < x then SOME (y::x::r) else NONE
- | _ => NONE))
+ (testRewrite (list int)
+ (fn x::y::r => if y < x then SOME (y::x::r) else NONE
+ | _ => NONE))
- (title "Generic.Uniplate.holesU")
+ (title "Generic.Uniplate.holesU")
- (testHolesU (BinTree.t int))
- (testHolesU (list int))
+ (testHolesU (BinTree.t int))
+ (testHolesU (list int))
- $
+ $
end
More information about the MLton-commit
mailing list