[MLton-commit] r6660
Vesa Karvonen
vesak at mlton.org
Sun Jun 29 02:18:58 PDT 2008
Using new shorthands.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/extra/with-extra.fun
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/some.sml
U mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/extra/with-extra.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/extra/with-extra.fun 2008-06-29 09:08:23 UTC (rev 6659)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/extra/with-extra.fun 2008-06-29 09:18:54 UTC (rev 6660)
@@ -31,13 +31,9 @@
fun regExn1' n t e p = regExn1 (C n) t (e, lift p)
end
- local
- fun mk t = iso (tuple t)
- in
- fun tuple2 (a, b) = mk (T a *` T b) Product.isoTuple2
- fun tuple3 (a, b, c) = mk (T a *` T b *` T c) Product.isoTuple3
- fun tuple4 (a, b, c, d) = mk (T a *` T b *` T c *` T d) Product.isoTuple4
- end
+ fun tuple2 (a, b) = tuple' (T a *` T b) Product.isoTuple2
+ fun tuple3 (a, b, c) = tuple' (T a *` T b *` T c) Product.isoTuple3
+ fun tuple4 (a, b, c, d) = tuple' (T a *` T b *` T c *` T d) Product.isoTuple4
local
val fits = fn (SOME n, SOME m) => n <= m
@@ -60,19 +56,19 @@
val some = C "SOME"
in
fun option a =
- iso (data (C0 none +` C1 some a))
- (fn NONE => INL () | SOME a => INR a,
- fn INL () => NONE | INR a => SOME a)
+ data' (C0 none +` C1 some a)
+ (fn NONE => INL () | SOME a => INR a,
+ fn INL () => NONE | INR a => SOME a)
end
val order =
- iso (data (C0' "LESS" +` C0' "EQUAL" +` C0' "GREATER"))
- (fn LESS => INL (INL ())
- | EQUAL => INL (INR ())
- | GREATER => INR (),
- fn INL (INL ()) => LESS
- | INL (INR ()) => EQUAL
- | INR () => GREATER)
+ data' (C0' "LESS" +` C0' "EQUAL" +` C0' "GREATER")
+ (fn LESS => INL (INL ())
+ | EQUAL => INL (INR ())
+ | GREATER => INR (),
+ fn INL (INL ()) => LESS
+ | INL (INR ()) => EQUAL
+ | INR () => GREATER)
local
val et = C "&"
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2008-06-29 09:08:23 UTC (rev 6659)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2008-06-29 09:18:54 UTC (rev 6660)
@@ -60,10 +60,10 @@
open Pickle
(* First a plain old type rep for our data: *)
- val t1 = iso (record (R' "id" int
- *` R' "name" string))
- (fn {id = a, name = b} => a & b,
- fn a & b => {id = a, name = b})
+ val t1 = record' (R' "id" int
+ *` R' "name" string)
+ (fn {id = a, name = b} => a & b,
+ fn a & b => {id = a, name = b})
(* Then we assign version {1} to the type: *)
val t = versioned $ 1 t1
@@ -71,11 +71,11 @@
val v1pickle = pickle t {id = 1, name = "whatever"}
(* Then a plain old type rep for our new data: *)
- val t2 = iso (record (R' "id" int
- *` R' "extra" bool
- *` R' "name" string))
- (fn {id = a, extra = b, name = c} => a & b & c,
- fn a & b & c => {id = a, extra = b, name = c})
+ val t2 = record' (R' "id" int
+ *` R' "extra" bool
+ *` R' "name" string)
+ (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: *)
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml 2008-06-29 09:08:23 UTC (rev 6659)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml 2008-06-29 09:18:54 UTC (rev 6660)
@@ -64,11 +64,11 @@
(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}))
+ (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\
@@ -83,8 +83,8 @@
tst (SOME 50) Fmt.default
((Tie.fix Y)
(fn s =>
- iso (data (C1' "S" (sq (refc (option s)))))
- (fn S ? => ?, S)))
+ 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\
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/read.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/read.sml 2008-06-29 09:08:23 UTC (rev 6659)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/read.sml 2008-06-29 09:18:54 UTC (rev 6660)
@@ -62,9 +62,9 @@
val vector = fn ? => ps (vector ?)
val word = ps word
val foobar =
- ps (iso (record (R' "foo" bool *` R' "+" unit *` R' "bar" char))
- (fn {foo = a, + = b, bar = c} => a & b & c,
- fn a & b & c => {foo = a, + = b, bar = c}))
+ ps (record' (R' "foo" bool *` R' "+" unit *` R' "bar" char)
+ (fn {foo = a, + = b, bar = c} => a & b & c,
+ fn a & b & c => {foo = a, + = b, bar = c}))
in
unitTests
(title "Generic.Read")
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/some.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/some.sml 2008-06-29 09:08:23 UTC (rev 6659)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/some.sml 2008-06-29 09:18:54 UTC (rev 6660)
@@ -10,10 +10,10 @@
fun listEither swap mirror a =
(Tie.fix Y)
(fn aListLeft =>
- iso (data (op +` (swap (C0' "nil",
- C1' "::" (tuple2 (a, aListLeft))))))
- (mirror <--> (fn [] => INL () | op :: ? => INR ?,
- fn INL () => [] | INR ? => op :: ?)))
+ 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 swap (mirror, mirror) ?
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun 2008-06-29 09:08:23 UTC (rev 6659)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun 2008-06-29 09:18:54 UTC (rev 6660)
@@ -26,8 +26,8 @@
fun withT aV = refc (list aV)
in
fun v a = Tie.fix Y (fn aV =>
- iso (data (C1 cVTX (tuple2 (a, withT aV))))
- (fn VTX ? => ?, VTX))
+ data' (C1 cVTX (tuple2 (a, withT aV)))
+ (fn VTX ? => ?, VTX))
fun t a = withT (v a)
end
@@ -76,9 +76,9 @@
val cBR = C "BR"
in
fun t a = Tie.fix Y (fn aT =>
- iso (data (C0 cLF +` C1 cBR (tuple3 (aT, a, aT))))
- (fn LF => INL () | BR ? => INR ?,
- fn INL () => LF | INR ? => BR ?))
+ data' (C0 cLF +` C1 cBR (tuple3 (aT, a, aT)))
+ (fn LF => INL () | BR ? => INR ?,
+ fn INL () => LF | INR ? => BR ?))
end
end
@@ -118,21 +118,21 @@
val cREF = C "REF"
in
fun f t =
- iso (data (C1 cFUN (tuple2 (Id.t, t))
- +` C1 cAPP (sq t)
- +` C1 cREF Id.t))
- (fn FUN ? => INL (INL ?)
- | APP ? => INL (INR ?)
- | REF ? => INR ?,
- fn INL (INL ?) => FUN ?
- | INL (INR ?) => APP ?
- | INR ? => REF ?)
+ data' (C1 cFUN (tuple2 (Id.t, t))
+ +` C1 cAPP (sq t)
+ +` C1 cREF Id.t)
+ (fn FUN ? => INL (INL ?)
+ | APP ? => INL (INR ?)
+ | REF ? => INR ?,
+ fn INL (INL ?) => FUN ?
+ | INL (INR ?) => APP ?
+ | INR ? => REF ?)
end
local
val cIN = C "IN"
in
- val t = Tie.fix Y (fn t => iso (data (C1 cIN (f t))) (out, IN))
+ val t = Tie.fix Y (fn t => data' (C1 cIN (f t)) (out, IN))
end
end
end
More information about the MLton-commit
mailing list