[MLton-commit] r6478

Vesa Karvonen vesak at mlton.org
Sat Mar 15 02:14:13 PST 2008


Changed to use a new convention for using generics.  An application
defines a combination of generics as a library that exports the Generic
structure.  Libraries using generics refer to the application defined
combination through the APPLICATION variable:

  "${APPLICATION}/generic.use"  (* UseLib *)
  $(APPLICATION)/generic.mlb    (* MLB *)
  $APPLICATION/generic.cm       (* CM *)

This allows libraries using generics to be written without functorization.

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

A   mltonlib/trunk/com/ssh/async/unstable/Test.sh
A   mltonlib/trunk/com/ssh/async/unstable/test/app/
A   mltonlib/trunk/com/ssh/async/unstable/test/app/generic.mlb
A   mltonlib/trunk/com/ssh/async/unstable/test/app/generic.use
U   mltonlib/trunk/com/ssh/async/unstable/test.mlb
U   mltonlib/trunk/com/ssh/async/unstable/test.use
U   mltonlib/trunk/com/ssh/generic/unstable/Test-mlton.sh
U   mltonlib/trunk/com/ssh/generic/unstable/Test-polyml.sh
U   mltonlib/trunk/com/ssh/generic/unstable/Test-smlnj.sh
D   mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm
D   mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb
D   mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.use
A   mltonlib/trunk/com/ssh/generic/unstable/test/app/
A   mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.cm
A   mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.mlb
A   mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.sml
A   mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.use
U   mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml
D   mltonlib/trunk/com/ssh/generic/unstable/test/generic.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
U   mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun
U   mltonlib/trunk/com/ssh/generic/unstable/test.cm
U   mltonlib/trunk/com/ssh/generic/unstable/test.mlb
U   mltonlib/trunk/com/ssh/generic/unstable/test.use
D   mltonlib/trunk/com/ssh/unit-test/unstable/Check.bgb
D   mltonlib/trunk/com/ssh/unit-test/unstable/Check.sh
U   mltonlib/trunk/com/ssh/unit-test/unstable/Example.sh
D   mltonlib/trunk/com/ssh/unit-test/unstable/detail/generic.sml
D   mltonlib/trunk/com/ssh/unit-test/unstable/detail/mk-unit-test.fun
U   mltonlib/trunk/com/ssh/unit-test/unstable/detail/ml/smlnj/unsealed.cm
A   mltonlib/trunk/com/ssh/unit-test/unstable/detail/sorted-list.use
A   mltonlib/trunk/com/ssh/unit-test/unstable/detail/unit-test.sml
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/app/
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/app/generic.cm
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/app/generic.mlb
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/app/generic.sml
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/app/generic.use
D   mltonlib/trunk/com/ssh/unit-test/unstable/example/innocent.sml
A   mltonlib/trunk/com/ssh/unit-test/unstable/example/rev-test.sml
U   mltonlib/trunk/com/ssh/unit-test/unstable/example.cm
U   mltonlib/trunk/com/ssh/unit-test/unstable/example.mlb
U   mltonlib/trunk/com/ssh/unit-test/unstable/example.use
D   mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.cm
D   mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.mlb
D   mltonlib/trunk/com/ssh/unit-test/unstable/lib-with-default.use
U   mltonlib/trunk/com/ssh/unit-test/unstable/lib.mlb
U   mltonlib/trunk/com/ssh/unit-test/unstable/lib.use
U   mltonlib/trunk/com/ssh/unit-test/unstable/public/export.sml
D   mltonlib/trunk/com/ssh/unit-test/unstable/public/mk-unit-test-fun.sig
U   mltonlib/trunk/com/ssh/unit-test/unstable/public/unit-test.sig

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

Added: mltonlib/trunk/com/ssh/async/unstable/Test.sh
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/Test.sh	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/async/unstable/Test.sh	2008-03-15 10:14:10 UTC (rev 6478)
@@ -0,0 +1,33 @@
+#!/bin/bash
+
+# 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.
+
+set -e
+
+export APPLICATION="$(pwd)/test/app"
+export MLTON_LIB="$(cd ../../../.. && pwd)"
+
+if which poly > /dev/null ; then
+    pushd $MLTON_LIB/org/mlton/vesak/use-lib/unstable
+    ./Make.sh
+    popd
+    echo "use \"$MLTON_LIB/org/mlton/vesak/use-lib/unstable/polyml.use\" ;
+          use \"test.use\" ;" | poly
+fi
+
+if which mlton > /dev/null ; then
+    mkdir -p generated
+
+    echo "APPLICATION $APPLICATION
+MLTON_LIB $MLTON_LIB
+SML_COMPILER mlton" > generated/mlb-path-map
+
+    mlton -mlb-path-map generated/mlb-path-map \
+          -output generated/test               \
+          test.mlb
+
+    generated/test
+fi


Property changes on: mltonlib/trunk/com/ssh/async/unstable/Test.sh
___________________________________________________________________
Name: svn:executable
   + *
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/async/unstable/test/app/generic.mlb
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/test/app/generic.mlb	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/async/unstable/test/app/generic.mlb	2008-03-15 10:14:10 UTC (rev 6478)
@@ -0,0 +1,22 @@
+(* 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.
+ *)
+
+local
+   $(MLTON_LIB)/com/ssh/generic/unstable/lib.mlb
+   $(MLTON_LIB)/com/ssh/random/unstable/lib.mlb
+in
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/generic.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/eq.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/type-hash.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/type-info.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/hash.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/ord.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/pretty.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/arbitrary.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/size.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/shrink.sml
+   $(MLTON_LIB)/com/ssh/generic/unstable/with/close-pretty-with-extra.sml
+end


Property changes on: mltonlib/trunk/com/ssh/async/unstable/test/app/generic.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/async/unstable/test/app/generic.use
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/test/app/generic.use	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/async/unstable/test/app/generic.use	2008-03-15 10:14:10 UTC (rev 6478)
@@ -0,0 +1,19 @@
+(* 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.
+ *)
+
+lib ["${MLTON_LIB}/com/ssh/generic/unstable/lib.use",
+     "${MLTON_LIB}/com/ssh/random/unstable/lib.use",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/generic.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/eq.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/type-hash.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/type-info.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/hash.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/ord.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/pretty.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/arbitrary.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/size.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/shrink.sml",
+     "${MLTON_LIB}/com/ssh/generic/unstable/with/close-pretty-with-extra.sml"] ;


Property changes on: mltonlib/trunk/com/ssh/async/unstable/test/app/generic.use
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/async/unstable/test.mlb
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/test.mlb	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/async/unstable/test.mlb	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,17 +1,25 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-local
-   $(MLTON_LIB)/com/ssh/generic/unstable/lib-with-default.mlb
-   $(MLTON_LIB)/com/ssh/unit-test/unstable/lib-with-default.mlb
+$(MLTON_LIB)/com/ssh/unit-test/unstable/lib.mlb
 
-   $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+$(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+$(MLTON_LIB)/com/ssh/generic/unstable/lib.mlb
 
-   lib.mlb
+$(APPLICATION)/generic.mlb
 
-   test/async.sml
+lib.mlb
+
+local
+   ann
+      "nonexhaustiveExnMatch ignore"
+      "sequenceNonUnit warn"
+      "warnUnused true"
+   in
+      test/async.sml
+   end
 in
 end

Modified: mltonlib/trunk/com/ssh/async/unstable/test.use
===================================================================
--- mltonlib/trunk/com/ssh/async/unstable/test.use	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/async/unstable/test.use	2008-03-15 10:14:10 UTC (rev 6478)
@@ -4,8 +4,9 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-lib ["${MLTON_LIB}/com/ssh/generic/unstable/lib-with-default.use",
-     "${MLTON_LIB}/com/ssh/unit-test/unstable/lib-with-default.use",
+lib ["${MLTON_LIB}/com/ssh/unit-test/unstable/lib.use",
+     "${MLTON_LIB}/com/ssh/generic/unstable/lib.use",
      "${MLTON_LIB}/com/ssh/extended-basis/unstable/basis.use",
+     "${APPLICATION}/generic.use",
      "lib.use",
      "test/async.sml"] ;

Modified: mltonlib/trunk/com/ssh/generic/unstable/Test-mlton.sh
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/Test-mlton.sh	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/Test-mlton.sh	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-# Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+# Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
 #
 # This code is released under the MLton license, a BSD-style license.
 # See the LICENSE file or http://mlton.org/License for details.
@@ -16,7 +16,8 @@
 mkdir -p generated
 
 echo "SML_COMPILER mlton
-MLTON_LIB $(cd ../../../.. && pwd)" > generated/mlb-path-map
+MLTON_LIB $(cd ../../../.. && pwd)
+APPLICATION $(pwd)/test/app" > generated/mlb-path-map
 
 time \
 mlton -mlb-path-map generated/mlb-path-map         \

Modified: mltonlib/trunk/com/ssh/generic/unstable/Test-polyml.sh
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/Test-polyml.sh	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/Test-polyml.sh	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-# Copyright (C) 2007 Vesa Karvonen
+# Copyright (C) 2007-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.
@@ -13,6 +13,8 @@
     exit 0
 fi
 
+export APPLICATION="$(pwd)/test/app"
+
 time \
 echo 'use "../../../../org/mlton/vesak/use-lib/unstable/polyml.use" ;
       use "test.use" ;' | poly

Modified: mltonlib/trunk/com/ssh/generic/unstable/Test-smlnj.sh
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/Test-smlnj.sh	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/Test-smlnj.sh	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,6 +1,6 @@
 #!/bin/bash
 
-# Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+# Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
 #
 # This code is released under the MLton license, a BSD-style license.
 # See the LICENSE file or http://mlton.org/License for details.
@@ -14,7 +14,8 @@
 fi
 
 export CM_LOCAL_PATHCONFIG=generated/smlnj-pathconfig
-echo "MLTON_LIB $(cd ../../../.. && pwd)" > $CM_LOCAL_PATHCONFIG
+echo "MLTON_LIB $(cd ../../../.. && pwd)
+APPLICATION $(pwd)/test/app" > $CM_LOCAL_PATHCONFIG
 
 eb=../../extended-basis/unstable
 
@@ -22,4 +23,4 @@
 echo '' | \
 sml -m test.cm \
     $eb/public/export/{open-top-level.sml,infixes.sml}  \
-    $(find test/ -name '*.sml' -a -not -name 'generic.sml' | sort)
+    test/*.sml

Deleted: mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,14 +0,0 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
- *
- * This code is released under the MLton license, a BSD-style license.
- * See the LICENSE file or http://mlton.org/License for details.
- *)
-
-library
-   library(lib.cm)
-   source(detail/generic.sml)
-is
-   ../../extended-basis/unstable/basis.cm
-   ../../random/unstable/lib.cm
-   detail/generic.sml
-   lib.cm

Deleted: mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,18 +0,0 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
- *
- * This code is released under the MLton license, a BSD-style license.
- * See the LICENSE file or http://mlton.org/License for details.
- *)
-
-lib.mlb
-
-(* Order matters: *)
-with/generic.sml
-with/eq.sml
-with/type-hash.sml
-with/type-info.sml
-with/hash.sml
-with/ord.sml
-with/pretty.sml
-with/read.sml
-with/close-pretty-with-extra.sml

Deleted: mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.use
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.use	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.use	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,16 +0,0 @@
-(* Copyright (C) 2007 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.
- *)
-
-lib ["lib.use",
-     "with/generic.sml",
-     "with/eq.sml",
-     "with/type-hash.sml",
-     "with/type-info.sml",
-     "with/hash.sml",
-     "with/ord.sml",
-     "with/pretty.sml",
-     "with/read.sml",
-     "with/close-pretty-with-extra.sml"] ;

Added: mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.cm	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.cm	2008-03-15 10:14:10 UTC (rev 6478)
@@ -0,0 +1,12 @@
+(* 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.
+ *)
+
+library
+   source(-)
+is
+   $MLTON_LIB/com/ssh/random/unstable/lib.cm
+   ../../lib.cm
+   generic.sml

Added: mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.mlb	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.mlb	2008-03-15 10:14:10 UTC (rev 6478)
@@ -0,0 +1,32 @@
+(* 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.
+ *)
+
+local
+   $(MLTON_LIB)/com/ssh/random/unstable/lib.mlb
+
+   ../../lib.mlb
+in
+   ../../with/generic.sml
+   ../../with/type-info.sml
+   ../../with/type-hash.sml
+   ../../with/hash.sml
+   ../../with/uniplate.sml
+   ../../with/pretty.sml
+   ../../with/eq.sml
+   ../../with/some.sml
+   ../../with/pickle.sml
+   ../../with/seq.sml
+   ../../with/read.sml
+   ../../with/reduce.sml
+   ../../with/transform.sml
+   ../../with/fmap.sml
+   ../../with/arbitrary.sml
+   ../../with/size.sml
+   ../../with/ord.sml
+   ../../with/shrink.sml
+   ../../with/close-pretty-with-extra.sml
+   ../../with/reg-basis-exns.sml
+end


Property changes on: mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.mlb
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.sml	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -0,0 +1,359 @@
+(* WARNING: This file was generated by running:
+ *
+ *> Generate-combination.sh test/app/generic.mlb test/app/generic.sml
+ *)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = CASES
+
+functor MkGeneric (Arg : Generic) : Generic = Arg
+
+structure Generic = RootGeneric
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic TYPE_INFO
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure TypeInfoRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithTypeInfo (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic TYPE_HASH
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure TypeHashRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithTypeHash (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic HASH
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure HashRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithHash (Generic)
+              open Generic Open)
+(* 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.
+ *)
+
+signature Generic = sig
+   include Generic UNIPLATE
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure UniplateRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithUniplate (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic PRETTY
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure PrettyRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithPretty (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic EQ
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure EqRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithEq (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic SOME
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure SomeRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithSome (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic PICKLE
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure PickleRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithPickle (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic SEQ
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure SeqRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithSeq (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 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.
+ *)
+
+(* WARNING: This file is generated! *)
+
+signature Generic = sig
+   include Generic READ
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure ReadRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithRead (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic REDUCE
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure ReduceRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithReduce (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic TRANSFORM
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure TransformRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithTransform (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic FMAP
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure FmapRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithFmap (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic ARBITRARY
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure ArbitraryRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open =
+                 WithArbitrary (open Generic
+                                structure RandomGen = RanQD1Gen)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic SIZE
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure SizeRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithSize (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic ORD
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure OrdRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithOrd (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature Generic = sig
+   include Generic SHRINK
+end
+
+functor MkGeneric (Arg : Generic) = struct
+   structure Open = MkGeneric (Arg)
+   open Arg Open
+   structure ShrinkRep = Open.Rep
+end
+
+structure Generic =
+   MkGeneric (structure Open = WithShrink (Generic)
+              open Generic Open)
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure Generic = struct
+   structure Rep = ClosePrettyWithExtra (Generic)
+   open Generic Rep
+end
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+local structure ? = RegBasisExns (Generic) open ? in end


Property changes on: mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.sml
___________________________________________________________________
Name: svn:eol-style
   + native

Added: mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.use
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.use	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.use	2008-03-15 10:14:10 UTC (rev 6478)
@@ -0,0 +1,28 @@
+(* 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.
+ *)
+
+lib ["${MLTON_LIB}/com/ssh/random/unstable/lib.use",
+     "../../lib.use",
+     "../../with/generic.sml",
+     "../../with/type-info.sml",
+     "../../with/type-hash.sml",
+     "../../with/hash.sml",
+     "../../with/uniplate.sml",
+     "../../with/pretty.sml",
+     "../../with/eq.sml",
+     "../../with/some.sml",
+     "../../with/pickle.sml",
+     "../../with/seq.sml",
+     "../../with/read.sml",
+     "../../with/reduce.sml",
+     "../../with/transform.sml",
+     "../../with/fmap.sml",
+     "../../with/arbitrary.sml",
+     "../../with/size.sml",
+     "../../with/ord.sml",
+     "../../with/shrink.sml",
+     "../../with/close-pretty-with-extra.sml",
+     "../../with/reg-basis-exns.sml"] ;


Property changes on: mltonlib/trunk/com/ssh/generic/unstable/test/app/generic.use
___________________________________________________________________
Name: svn:eol-style
   + native

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/fmap.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
@@ -7,8 +7,6 @@
 local
    open Generic UnitTest
 
-   structure BinTree = MkBinTree (Generic)
-
    structure ListF = MkFmap (open Generic List val t = list)
    structure BinTreeF = MkFmap (open Generic BinTree)
 in

Deleted: mltonlib/trunk/com/ssh/generic/unstable/test/generic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/generic.sml	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/generic.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,266 +0,0 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
- *
- * This code is released under the MLton license, a BSD-style license.
- * See the LICENSE file or http://mlton.org/License for details.
- *)
-
-(* WARNING: This file was generated by running:
- *
- *> Generate-combination.sh test.mlb test/generic.sml
- *)
-
-signature Generic = CASES
-
-functor MkGeneric (Arg : Generic) : Generic = Arg
-
-structure Generic = RootGeneric
-
-signature Generic = sig
-   include Generic TYPE_INFO
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure TypeInfoRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithTypeInfo (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic TYPE_HASH
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure TypeHashRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithTypeHash (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic HASH
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure HashRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithHash (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic UNIPLATE
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure UniplateRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithUniplate (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic PRETTY
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure PrettyRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithPretty (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic EQ
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure EqRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithEq (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic SOME
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure SomeRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithSome (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic PICKLE
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure PickleRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithPickle (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic SEQ
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure SeqRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithSeq (Generic)
-              open Generic Open)
-
-
-signature Generic = sig
-   include Generic READ
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure ReadRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithRead (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic REDUCE
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure ReduceRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithReduce (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic TRANSFORM
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure TransformRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithTransform (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic FMAP
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure FmapRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithFmap (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic ARBITRARY
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure ArbitraryRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open =
-                 WithArbitrary (open Generic
-                                structure RandomGen = RanQD1Gen)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic SIZE
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure SizeRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithSize (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic ORD
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure OrdRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithOrd (Generic)
-              open Generic Open)
-
-signature Generic = sig
-   include Generic SHRINK
-end
-
-functor MkGeneric (Arg : Generic) = struct
-   structure Open = MkGeneric (Arg)
-   open Arg Open
-   structure ShrinkRep = Open.Rep
-end
-
-structure Generic =
-   MkGeneric (structure Open = WithShrink (Generic)
-              open Generic Open)
-
-structure Generic = struct
-   structure Rep = ClosePrettyWithExtra (Generic)
-   open Generic Rep
-end
-
-local structure ? = RegBasisExns (Generic) open ? in end
-
-structure UnitTest = MkUnitTest (Generic)

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -4,10 +4,7 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-local
-   structure Graph = MkGraph (Generic)
-   structure ExnArray = MkExnArray (Generic)
-
+val () = let
    open Generic UnitTest
 
    fun thatSeq t args =
@@ -34,135 +31,134 @@
                       (fn () => unpickle u p)
                 end)
 in
-   val () =
-       unitTests
-          (title "Generic.Pickle")
+   unitTests
+      (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
-               * versions supported at the same time. *)
+    (test (fn () => let
+        (* This test shows how pickles can be versioned and multiple
+         * versions supported at the same time. *)
 
-              open Pickle
+        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})
+        (* 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})
 
-              (* Then we assign version {1} to the type: *)
-              val t = versioned $ 1 t1
+        (* Then we assign version {1} to the type: *)
+        val t = versioned $ 1 t1
 
-              val v1pickle = pickle t {id = 1, name = "whatever"}
+        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})
+        (* 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})
 
-              (* 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}))
-                                $ 2 t2
+        (* 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}))
+                          $ 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. *)
-           in
-              thatEq t {expect = {id = 1, extra = false, name = "whatever"},
-                        actual = unpickle t v1pickle}
-            ; thatEq t {expect = {id = 3, extra = true, name = "whenever"},
-                        actual = unpickle t (pickle t {id = 3, extra = true,
-                                                       name = "whenever"})}
-           end))
+        (* 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}
+      ; thatEq t {expect = {id = 3, extra = true, name = "whenever"},
+                  actual = unpickle t (pickle t {id = 3, extra = true,
+                                                 name = "whenever"})}
+     end))
 
-          (title "Generic.Pickle.Format")
+    (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. *)
-              datatype t =
-                 NIL
-               | CON of {bool : Bool.t Vector.t,
-                         char : Char.t Ref.t,
-                         ints : Int.t * FixedInt.t * LargeInt.t,
-                         reals : Real.t * LargeReal.t,
-                         string : String.t,
-                         words : Word.t * Word8.t * Word32.t * LargeWord.t,
-                         unit : Unit.t Option.t Array.t,
-                         exn : Exn.t,
-                         rest : t} List.t
-              val t : t Rep.t = Tie.fix Y (fn t =>
-                  data
-                  (isoSum
-                   (C0'"NIL"
-                 +` C1'"CON"
-                       (list
-                        (record
-                         (isoProduct
-                          (R'"bool" (vector bool)
-                        *` R'"char" (refc char)
-                        *` R'"ints" (tuple3 (int, fixedInt, largeInt))
-                        *` R'"reals" (tuple2 (real, largeReal))
-                        *` R'"string" string
-                        *` R'"words" (tuple4 (word, word8, word32, largeWord))
-                        *` R'"unit" (array (option unit))
-                        *` R'"exn" exn
-                        *` R'"rest" t)
-                          (fn {bool=a, char=b, ints=c, reals=d, string=e, words=f,
-                               unit=g, exn=h, rest=i} =>
-                              a & b & c & d & e & f & g & h & i,
-                           fn a & b & c & d & e & f & g & h & i =>
-                              {bool=a, char=b, ints=c, reals=d, string=e, words=f,
-                               unit=g, exn=h, rest=i})))))
-                   (fn NIL => INL () | CON ? => INR ?,
-                    fn INL () => NIL | INR ? => CON ?)))
-              val t = Pickle.withTypeHash t
-              val x =
-                  CON [{bool = Vector.fromList [true, false],
-                        char = ref #"z",
-                        ints = (1110101, ~102234, 303345223),
-                        reals = (1.1111, ~2.2222),
-                        string = "string",
-                        words = (0wx1FBC2, 0wx2E, 0wxDEADBEEF, 0wx51255D4C),
-                        unit = Array.fromList [NONE, SOME ()],
-                        exn = Fail "message",
-                        rest = NIL}]
-           in
-              thatEq string
-                     {expect = "\^A<\249=\^A\^@\^A\^@\^B\^A\^@\^@z\^@\^C\
-                               \U\240\^P\^C\166p\254\^DG\174\^T\^R\^@@\
-                               \\158^)\203\^P\199\241?@\158^)\203\^P\199\
-                               \\^A\192\^@\^Fstring\^@\^C\194\251\^A.\
-                               \\239\190\173\222\^DL]%Q\^@\^B\^@\^A\^@\
-                               \\^DFail\^@\amessage\^@",
-                      actual = Byte.bytesToString (pickle t x)}
-           end))
+    (test (fn () => let
+        (* 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,
+                   char : Char.t Ref.t,
+                   ints : Int.t * FixedInt.t * LargeInt.t,
+                   reals : Real.t * LargeReal.t,
+                   string : String.t,
+                   words : Word.t * Word8.t * Word32.t * LargeWord.t,
+                   unit : Unit.t Option.t Array.t,
+                   exn : Exn.t,
+                   rest : t} List.t
+        val t : t Rep.t = Tie.fix Y (fn t =>
+            data
+            (isoSum
+             (C0'"NIL"
+           +` C1'"CON"
+                 (list
+                  (record
+                   (isoProduct
+                    (R'"bool" (vector bool)
+                  *` R'"char" (refc char)
+                  *` R'"ints" (tuple3 (int, fixedInt, largeInt))
+                  *` R'"reals" (tuple2 (real, largeReal))
+                  *` R'"string" string
+                  *` R'"words" (tuple4 (word, word8, word32, largeWord))
+                  *` R'"unit" (array (option unit))
+                  *` R'"exn" exn
+                  *` R'"rest" t)
+                    (fn {bool=a, char=b, ints=c, reals=d, string=e, words=f,
+                         unit=g, exn=h, rest=i} =>
+                        a & b & c & d & e & f & g & h & i,
+                     fn a & b & c & d & e & f & g & h & i =>
+                        {bool=a, char=b, ints=c, reals=d, string=e, words=f,
+                         unit=g, exn=h, rest=i})))))
+             (fn NIL => INL () | CON ? => INR ?,
+              fn INL () => NIL | INR ? => CON ?)))
+        val t = Pickle.withTypeHash t
+        val x =
+            CON [{bool = Vector.fromList [true, false],
+                  char = ref #"z",
+                  ints = (1110101, ~102234, 303345223),
+                  reals = (1.1111, ~2.2222),
+                  string = "string",
+                  words = (0wx1FBC2, 0wx2E, 0wxDEADBEEF, 0wx51255D4C),
+                  unit = Array.fromList [NONE, SOME ()],
+                  exn = Fail "message",
+                  rest = NIL}]
+     in
+        thatEq string
+               {expect = "\^A<\249=\^A\^@\^A\^@\^B\^A\^@\^@z\^@\^C\
+                         \U\240\^P\^C\166p\254\^DG\174\^T\^R\^@@\
+                         \\158^)\203\^P\199\241?@\158^)\203\^P\199\
+                         \\^A\192\^@\^Fstring\^@\^C\194\251\^A.\
+                         \\239\190\173\222\^DL]%Q\^@\^B\^@\^A\^@\
+                         \\^DFail\^@\amessage\^@",
+                actual = Byte.bytesToString (pickle t x)}
+     end))
 
-          $
+    $
 end

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pretty.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,151 +1,146 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-local
+val () = let
    open Prettier Generic UnitTest
 
    infix |`
 
    fun tst n f t s v =
        testEq string (fn () => {expect = s, actual = render n (fmt t f v)})
-
-   structure Graph = MkGraph (Generic)
-   structure BinTree = MkBinTree (Generic)
 in
-   val () =
-       unitTests
-          (title "Generic.Pretty")
+   unitTests
+      (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-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/read.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -4,7 +4,7 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-local
+val () = let
    (* <-- SML/NJ workaround *)
    infix <^>
    (* SML/NJ workaround --> *)
@@ -66,34 +66,33 @@
                (fn {foo = a, + = b, bar = c} => a & b & c,
                 fn a & b & c => {foo = a, + = b, bar = c}))
 in
-   val () =
-       unitTests
-          (title "Generic.Read")
+   unitTests
+      (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-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/reduce.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
@@ -7,21 +7,12 @@
 local
    open Generic UnitTest
 
-   structure BinTree = MkBinTree (Generic)
-
    fun testReduce t2t fromT toT zero binOp to value expect = let
       val reduce = makeReduce t2t fromT zero binOp to
    in
       testEq toT (fn () => {expect = expect, actual = reduce value})
    end
 
-   structure Lambda =
-      MkLambda (structure Id = struct
-                   type t = String.t
-                   val t = string
-                end
-                open Generic)
-
    structure Set = struct
       val empty = []
       fun singleton x = [x]

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/some.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/some.sml	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/some.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,10 +1,10 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-local
+val () = let
    open Generic UnitTest
 
    fun listEither pair sumIn sumOut a =
@@ -17,23 +17,20 @@
 
    fun listL ? = listEither id        id       id       ?
    fun listR ? = listEither Pair.swap Sum.swap Sum.swap ?
-
-   structure BinTree = MkBinTree (Generic)
 in
-   val () =
-       unitTests
-          (title "Generic.Some")
+   unitTests
+      (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-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/transform.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,10 +1,10 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-local
+val () = let
    open Generic UnitTest
 
    fun testTransform t2t t unOp value expect = let
@@ -12,27 +12,23 @@
    in
       testEq (t2t t) (fn () => {expect = expect, actual = transform value})
    end
-
-   structure BinTree = MkBinTree (Generic)
-   structure Graph = MkGraph (Generic)
 in
-   val () =
-       unitTests
-          (title "Generic.Transform")
+   unitTests
+      (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-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/uniplate.sml	2008-03-15 10:14:10 UTC (rev 6478)
@@ -4,11 +4,9 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-local
+val () = let
    open Generic UnitTest
 
-   structure BinTree = MkBinTree (Generic)
-
    fun testUniplate t =
        testAll t (fn x =>
           case uniplate t x
@@ -40,44 +38,43 @@
                              actual = y2x y})
                (holesU t x)))
 in
-   val () =
-       unitTests
-          (title "Generic.Uniplate")
+   unitTests
+      (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

Modified: mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun	2008-03-15 09:44:01 UTC (rev 6477)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/utils.fun	2008-03-15 10:14:10 UTC (rev 6478)
@@ -1,138 +1,138 @@
-(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2007-2008 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-(* A simplistic graph for testing 



More information about the MLton-commit mailing list