[MLton-commit] r5958

[Vesa Karvonen]

An extra test/example for transform and some minor refactorings.

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

U   mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
U   mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml
U   mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml
U   mltonlib/trunk/com/ssh/generic/unstable/test/utils.sml

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

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml	2007-08-25 21:57:37 UTC (rev 5957)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml	2007-08-26 18:18:56 UTC (rev 5958)
@@ -11,8 +11,7 @@
          structure Open = WithSeq (Open)
          structure Extra = CloseWithExtra (Open)
       in
-         val seq = Open.seq
-         open Extra
+         open Open Extra
       end
    end
 

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml	2007-08-25 21:57:37 UTC (rev 5957)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml	2007-08-26 18:18:56 UTC (rev 5958)
@@ -11,8 +11,7 @@
          structure Open = WithReduce (Open)
          structure Extra = CloseWithExtra (Open)
       in
-         val makeReduce = Open.makeReduce
-         open Extra
+         open Open Extra
       end
    end
 

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml	2007-08-25 21:57:37 UTC (rev 5957)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml	2007-08-26 18:18:56 UTC (rev 5958)
@@ -11,8 +11,7 @@
          structure Open = WithTransform (Open)
          structure Extra = CloseWithExtra (Open)
       in
-         val makeTransform = Open.makeTransform
-         open Extra
+         open Open Extra
       end
    end
 
@@ -23,6 +22,8 @@
    in
       testEq (t2t t) (fn () => {expect = expect, actual = transform value})
    end
+
+   structure BinTree = MkBinTree (Generic)
 in
    val () =
        unitTests
@@ -31,5 +32,14 @@
           (testTransform (1 <\ op +) int list [1, 2, 3] [2, 3, 4])
           (testTransform op ~ int (fn t => tuple (T int *` T t)) (1 & 3) (1 & ~3))
 
+          let
+             datatype t = datatype BinTree.t
+          in
+             testTransform
+                (1 <\ op +) int BinTree.t
+                (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
+
           $
 end

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/utils.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/utils.sml	2007-08-25 21:57:37 UTC (rev 5957)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/utils.sml	2007-08-26 18:18:56 UTC (rev 5958)
@@ -9,7 +9,7 @@
    WithExtra (structure Open = Open and Closed = CloseCases (Open) open Closed)
 
 (* Register basis library exceptions for the default generics. *)
-local structure ? = RegBasisExns (Generic) in end
+local structure ? = RegBasisExns (Generic) open ? in end
 
 (* A simplistic graph for testing with cyclic data. *)
 functor MkGraph (Generic : GENERIC_EXTRA) :> sig
@@ -62,3 +62,23 @@
    val exnArray1 = Array.fromList [Empty]
    val () = Array.update (exnArray1, 0, ExnArray exnArray1)
 end
+
+(* A simple binary tree. *)
+functor MkBinTree (Generic : GENERIC_EXTRA) :> sig
+   datatype 'a t = LF | BR of 'a t * 'a * 'a t
+   val t : 'a Generic.Rep.t -> 'a t Generic.Rep.t
+end = struct
+   datatype 'a t = LF | BR of 'a t * 'a * 'a t
+   local
+      open Generic
+      val lf = C "LF"
+      val br = C "BR"
+   in
+      fun t a =
+          (Tie.fix Y)
+             (fn aT =>
+                 iso (data (C0 lf +` C1 br (tuple3 (aT, a, aT))))
+                     (fn LF => INL () | BR ? => INR ?,
+                      fn INL () => LF | INR ? => BR ?))
+   end
+end