[MLton-commit] r5608
Vesa Karvonen
vesak at mlton.org
Sun Jun 10 04:54:27 PDT 2007
Refactoring the generics library. The goal is to clarify the conceptual
framework (with closed/open generics) and make the library more
straightforward to use.
----------------------------------------------------------------------
A mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun
D mltonlib/trunk/com/ssh/generic/unstable/detail/default.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/ext-generic.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/generic.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun
D mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
A mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/with-convenience.fun
U mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm
U mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
A mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic-rep.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic-with-convenience.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
D mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic-index.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/generic-with-convenience.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/join-generics-fun.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/open-generic-rep.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/open-generic.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/arbitrary.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/dummy.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/eq.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/ord.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/show.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/type-info.sig
----------------------------------------------------------------------
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun (from rev 5607, mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,59 @@
+(* 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.
+ *)
+
+functor CloseGeneric (Arg : OPEN_GENERIC) :>
+ CLOSED_GENERIC
+ where type 'a Rep.t = ('a, Unit.t) Arg.Rep.t
+ where type 'a Rep.s = ('a, Unit.t) Arg.Rep.s
+ where type ('a, 'k) Rep.p = ('a, 'k, Unit.t) Arg.Rep.p =
+struct
+ (* <-- SML/NJ workaround *)
+ open TopLevel
+ (* SML/NJ workaround --> *)
+
+ structure Rep : CLOSED_GENERIC_REP = struct
+ type 'a t = ('a, Unit.t) Arg.Rep.t
+ type 'a s = ('a, Unit.t) Arg.Rep.s
+ type ('a, 'k) p = ('a, 'k, Unit.t) Arg.Rep.p
+ end
+
+ fun morph m = m (const ignore)
+
+ fun iso ? = morph Arg.iso ?
+ fun isoProduct ? = morph Arg.isoProduct ?
+ fun isoSum ? = morph Arg.isoSum ?
+ fun op *` ? = Arg.*` ignore ?
+ fun T ? = Arg.T ignore ?
+ fun R ? = Arg.R (const ignore) ?
+ fun tuple ? = Arg.tuple ignore ?
+ fun record ? = Arg.record ignore ?
+ fun op +` ? = Arg.+` ignore ?
+ fun C0 ? = Arg.C0 (const ()) ?
+ fun C1 ? = Arg.C1 (const ignore) ?
+ fun data ? = Arg.data ignore ?
+ val unit = Arg.unit ()
+ fun Y ? = Arg.Y Tie.unit ?
+ fun op --> ? = Arg.--> ignore ?
+ val exn = Arg.exn ()
+ fun regExn ? = Arg.regExn (const ignore) ?
+ fun array ? = Arg.array ignore ?
+ fun refc ? = Arg.refc ignore ?
+ fun vector ? = Arg.vector ignore ?
+ val largeInt = Arg.largeInt ()
+ val largeReal = Arg.largeReal ()
+ val largeWord = Arg.largeWord ()
+ val word8 = Arg.word8 ()
+(* val word16 = Arg.word16 () (* Word16 not provided by SML/NJ *) *)
+ val word32 = Arg.word32 ()
+ val word64 = Arg.word64 ()
+ fun list ? = Arg.list ignore ?
+ val bool = Arg.bool ()
+ val char = Arg.char ()
+ val int = Arg.int ()
+ val real = Arg.real ()
+ val string = Arg.string ()
+ val word = Arg.word ()
+end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/default.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/default.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/default.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,49 +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.
- *)
-
-structure Generic : sig
- structure Ext : EXT_GENERIC
-
- include GENERIC_WITH_CONVENIENCE
- where type 'a Index.t = ('a, Unit.t) Ext.Index.t
- where type 'a Index.s = ('a, Unit.t) Ext.Index.s
- where type ('a, 'k) Index.p = ('a, 'k, Unit.t) Ext.Index.p
-
- include ARBITRARY sharing Ext.Index = Arbitrary
- include DUMMY sharing Ext.Index = Dummy
- include EQ sharing Ext.Index = Eq
- include ORD sharing Ext.Index = Ord
- include SHOW sharing Ext.Index = Show
- include TYPE_INFO sharing Ext.Index = TypeInfo
-end = struct
- structure Ext = ExtGeneric
-
- structure Ext = WithShow (Ext) open Ext
- structure Ext = WithTypeInfo (Ext) open Ext structure TypeInfo = Ext
- structure Ext = WithEq (Ext) open Ext
- structure Ext = WithOrd (Ext) open Ext
- structure Ext = WithDummy (Ext) open Ext
-
- structure Ext = struct
- structure Outer = Ext
- structure TypeInfo = struct
- open TypeInfo
- structure TypeInfo = Outer.Index
- end
- structure RandomGen = RanQD1Gen
- end
-
- structure Ext = WithArbitrary (Ext) open Ext
-
- structure Arbitrary = Ext.Index
- structure Dummy = Ext.Index
- structure Eq = Ext.Index
- structure Ord = Ext.Index
- structure Show = Ext.Index
- structure TypeInfo = Ext.Index
-
- structure Grounded = WithConvenience (GroundGeneric (Ext)) open Grounded
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/ext-generic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ext-generic.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ext-generic.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,60 +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.
- *)
-
-structure ExtGeneric :> EXT_GENERIC = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- structure Index = struct
- type ('a, 'x) t = 'x
- val getT = id
- val mapT = id
-
- type ('a, 'x) s = 'x
- val getS = id
- val mapS = id
-
- type ('a, 'k, 'x) p = 'x
- val getP = id
- val mapP = id
- end
-
- val iso = id
- val isoProduct = id
- val isoSum = id
- val op *` = id
- val T = id
- val R = id
- val tuple = id
- val record = id
- val op +` = id
- val C0 = id
- val C1 = id
- val data = id
- val unit = id
- val Y = id
- val op --> = id
- val exn = id
- val regExn = id
- val array = id
- val refc = id
- val vector = id
- val largeInt = id
- val largeReal = id
- val largeWord = id
- val word8 = id
-(* val word16 = id (* Word16 not provided by SML/NJ *) *)
- val word32 = id
- val word64 = id
- val list = id
- val bool = id
- val char = id
- val int = id
- val real = id
- val string = id
- val word = id
-end
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/generic.sml (from rev 5603, mltonlib/trunk/com/ssh/generic/unstable/detail/default.sml)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/default.sml 2007-06-09 15:44:57 UTC (rev 5603)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/generic.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,49 @@
+(* 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 : sig
+ structure Open : OPEN_GENERIC
+
+ include CLOSED_GENERIC_WITH_CONVENIENCE
+ where type 'a Rep.t = ('a, Unit.t) Open.Rep.t
+ where type 'a Rep.s = ('a, Unit.t) Open.Rep.s
+ where type ('a, 'k) Rep.p = ('a, 'k, Unit.t) Open.Rep.p
+
+ include ARBITRARY sharing Open.Rep = Arbitrary
+ include DUMMY sharing Open.Rep = Dummy
+ include EQ sharing Open.Rep = Eq
+ include ORD sharing Open.Rep = Ord
+ include SHOW sharing Open.Rep = Show
+ include TYPE_INFO sharing Open.Rep = TypeInfo
+end = struct
+ structure Open = RootGeneric
+
+ structure Open = WithShow (Open) open Open
+ structure Open = WithTypeInfo (Open) open Open structure TypeInfo = Open
+ structure Open = WithEq (Open) open Open
+ structure Open = WithOrd (Open) open Open
+ structure Open = WithDummy (Open) open Open
+
+ structure Open = struct
+ structure Outer = Open
+ structure TypeInfo = struct
+ open TypeInfo
+ structure TypeInfo = Outer.Rep
+ end
+ structure RandomGen = RanQD1Gen
+ end
+
+ structure Open = WithArbitrary (Open) open Open
+
+ structure Arbitrary = Open.Rep
+ structure Dummy = Open.Rep
+ structure Eq = Open.Rep
+ structure Ord = Open.Rep
+ structure Show = Open.Rep
+ structure TypeInfo = Open.Rep
+
+ structure Closed = WithConvenience (CloseGeneric (Open)) open Closed
+end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,59 +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.
- *)
-
-functor GroundGeneric (Arg : EXT_GENERIC) :>
- GENERIC
- where type 'a Index.t = ('a, Unit.t) Arg.Index.t
- where type 'a Index.s = ('a, Unit.t) Arg.Index.s
- where type ('a, 'k) Index.p = ('a, 'k, Unit.t) Arg.Index.p =
-struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- structure Index : GENERIC_INDEX = struct
- type 'a t = ('a, Unit.t) Arg.Index.t
- type 'a s = ('a, Unit.t) Arg.Index.s
- type ('a, 'k) p = ('a, 'k, Unit.t) Arg.Index.p
- end
-
- fun morph m = m (const ignore)
-
- fun iso ? = morph Arg.iso ?
- fun isoProduct ? = morph Arg.isoProduct ?
- fun isoSum ? = morph Arg.isoSum ?
- fun op *` ? = Arg.*` ignore ?
- fun T ? = Arg.T ignore ?
- fun R ? = Arg.R (const ignore) ?
- fun tuple ? = Arg.tuple ignore ?
- fun record ? = Arg.record ignore ?
- fun op +` ? = Arg.+` ignore ?
- fun C0 ? = Arg.C0 (const ()) ?
- fun C1 ? = Arg.C1 (const ignore) ?
- fun data ? = Arg.data ignore ?
- val unit = Arg.unit ()
- fun Y ? = Arg.Y Tie.unit ?
- fun op --> ? = Arg.--> ignore ?
- val exn = Arg.exn ()
- fun regExn ? = Arg.regExn (const ignore) ?
- fun array ? = Arg.array ignore ?
- fun refc ? = Arg.refc ignore ?
- fun vector ? = Arg.vector ignore ?
- val largeInt = Arg.largeInt ()
- val largeReal = Arg.largeReal ()
- val largeWord = Arg.largeWord ()
- val word8 = Arg.word8 ()
-(* val word16 = Arg.word16 () (* Word16 not provided by SML/NJ *) *)
- val word32 = Arg.word32 ()
- val word64 = Arg.word64 ()
- fun list ? = Arg.list ignore ?
- val bool = Arg.bool ()
- val char = Arg.char ()
- val int = Arg.int ()
- val real = Arg.real ()
- val string = Arg.string ()
- val word = Arg.word ()
-end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun 2007-06-10 11:54:24 UTC (rev 5608)
@@ -5,28 +5,28 @@
*)
functor JoinGenerics (Arg : JOIN_GENERICS_DOM) :>
- EXT_GENERIC
- where type ('a, 'x) Index.t =
- ('a, ('a, 'x) Arg.Inner.Index.t) Arg.Outer.Index.t
- where type ('a, 'x) Index.s =
- ('a, ('a, 'x) Arg.Inner.Index.s) Arg.Outer.Index.s
- where type ('a, 'k, 'x) Index.p =
- ('a, 'k, ('a, 'k, 'x) Arg.Inner.Index.p) Arg.Outer.Index.p =
+ OPEN_GENERIC
+ where type ('a, 'x) Rep.t =
+ ('a, ('a, 'x) Arg.Inner.Rep.t) Arg.Outer.Rep.t
+ where type ('a, 'x) Rep.s =
+ ('a, ('a, 'x) Arg.Inner.Rep.s) Arg.Outer.Rep.s
+ where type ('a, 'k, 'x) Rep.p =
+ ('a, 'k, ('a, 'k, 'x) Arg.Inner.Rep.p) Arg.Outer.Rep.p =
struct
open Arg
- structure Index : EXT_GENERIC_INDEX = struct
- type ('a, 'x) t = ('a, ('a, 'x) Inner.Index.t) Outer.Index.t
- fun getT ? = Inner.Index.getT (Outer.Index.getT ?)
- fun mapT ? = Outer.Index.mapT (Inner.Index.mapT ?)
+ structure Rep : OPEN_GENERIC_REP = struct
+ type ('a, 'x) t = ('a, ('a, 'x) Inner.Rep.t) Outer.Rep.t
+ fun getT ? = Inner.Rep.getT (Outer.Rep.getT ?)
+ fun mapT ? = Outer.Rep.mapT (Inner.Rep.mapT ?)
- type ('a, 'x) s = ('a, ('a, 'x) Inner.Index.s) Outer.Index.s
- fun getS ? = Inner.Index.getS (Outer.Index.getS ?)
- fun mapS ? = Outer.Index.mapS (Inner.Index.mapS ?)
+ type ('a, 'x) s = ('a, ('a, 'x) Inner.Rep.s) Outer.Rep.s
+ fun getS ? = Inner.Rep.getS (Outer.Rep.getS ?)
+ fun mapS ? = Outer.Rep.mapS (Inner.Rep.mapS ?)
- type ('a, 'k, 'x) p = ('a, 'k, ('a, 'k, 'x) Inner.Index.p) Outer.Index.p
- fun getP ? = Inner.Index.getP (Outer.Index.getP ?)
- fun mapP ? = Outer.Index.mapP (Inner.Index.mapP ?)
+ type ('a, 'k, 'x) p = ('a, 'k, ('a, 'k, 'x) Inner.Rep.p) Outer.Rep.p
+ fun getP ? = Inner.Rep.getP (Outer.Rep.getP ?)
+ fun mapP ? = Outer.Rep.mapP (Inner.Rep.mapP ?)
end
fun iso ? = Outer.iso (Inner.iso ?)
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,73 +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.
- *)
-
-functor LiftGeneric (Arg : GENERIC) :>
- EXT_GENERIC
- where type ('a, 'x) Index.t = 'a Arg.Index.t * 'x
- where type ('a, 'x) Index.s = 'a Arg.Index.s * 'x
- where type ('a, 'k, 'x) Index.p = ('a, 'k) Arg.Index.p * 'x =
-struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- structure Index : EXT_GENERIC_INDEX = struct
- val get = Pair.snd
- fun map f = Pair.map (id, f)
-
- type ('a, 'x) t = 'a Arg.Index.t * 'x
- val getT = get
- val mapT = map
-
- type ('a, 'x) s = 'a Arg.Index.s * 'x
- val getS = get
- val mapS = map
-
- type ('a, 'k, 'x) p = ('a, 'k) Arg.Index.p * 'x
- val getP = get
- val mapP = map
- end
-
- fun unary arg fx = Pair.map (arg, fx)
- fun binary arg fxy x = Pair.map (arg x, fxy x)
- fun binop arg fxy = Pair.map (arg, fxy) o Pair.swizzle
- fun morph arg f (a, x) aIb = (arg a aIb, f x aIb)
-
- fun iso ? = morph Arg.iso ?
- fun isoProduct ? = morph Arg.isoProduct ?
- fun isoSum ? = morph Arg.isoSum ?
- fun op *` ? = binop Arg.*` ?
- fun T ? = unary Arg.T ?
- fun R ? = binary Arg.R ?
- fun tuple ? = unary Arg.tuple ?
- fun record ? = unary Arg.record ?
- fun op +` ? = binop Arg.+` ?
- fun C0 fc c = (Arg.C0 c, fc c)
- fun C1 ? = binary Arg.C1 ?
- fun data ? = unary Arg.data ?
- fun unit x = (Arg.unit, x)
- fun Y y = Tie.tuple2 (Arg.Y, y)
- fun op --> ? = binop Arg.--> ?
- fun exn x = (Arg.exn, x)
- fun regExn x2ef (a, x) = Pair.app (Arg.regExn a, x2ef x) o Sq.mk
- fun array ? = unary Arg.array ?
- fun refc ? = unary Arg.refc ?
- fun vector ? = unary Arg.vector ?
- fun largeInt x = (Arg.largeInt, x)
- fun largeReal x = (Arg.largeReal, x)
- fun largeWord x = (Arg.largeWord, x)
- fun word8 x = (Arg.word8, x)
-(* fun word16 x = (Arg.word16, x) (* Word16 not provided by SML/NJ *) *)
- fun word32 x = (Arg.word32, x)
- fun word64 x = (Arg.word64, x)
- fun list ? = unary Arg.list ?
- fun bool x = (Arg.bool, x)
- fun char x = (Arg.char, x)
- fun int x = (Arg.int, x)
- fun real x = (Arg.real, x)
- fun string x = (Arg.string, x)
- fun word x = (Arg.word, x)
-end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-06-10 11:54:24 UTC (rev 5608)
@@ -8,26 +8,26 @@
../../../../../extended-basis/unstable/basis.cm
../../../../../prettier/unstable/lib.cm
../../../../../random/unstable/lib.cm
- ../../../public/ext-generic-index.sig
- ../../../public/ext-generic.sig
- ../../../public/generic-index.sig
- ../../../public/generic-with-convenience.sig
- ../../../public/generic.sig
+ ../../../public/closed-generic-rep.sig
+ ../../../public/closed-generic-with-convenience.sig
+ ../../../public/closed-generic.sig
../../../public/generics-util.sig
../../../public/generics.sig
../../../public/join-generics-fun.sig
+ ../../../public/open-generic-rep.sig
+ ../../../public/open-generic.sig
../../../public/value/arbitrary.sig
../../../public/value/dummy.sig
../../../public/value/eq.sig
../../../public/value/ord.sig
../../../public/value/show.sig
../../../public/value/type-info.sig
- ../../ext-generic.sml
+ ../../close-generic.fun
../../generics-util.sml
../../generics.sml
- ../../ground-generic.fun
../../join-generics.fun
- ../../lift-generic.fun
+ ../../open-generic.fun
+ ../../root-generic.sml
../../sml-syntax.sml
../../value/arbitrary.sml
../../value/dummy.sml
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun (from rev 5607, mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,73 @@
+(* 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.
+ *)
+
+functor OpenGeneric (Arg : CLOSED_GENERIC) :>
+ OPEN_GENERIC
+ where type ('a, 'x) Rep.t = 'a Arg.Rep.t * 'x
+ where type ('a, 'x) Rep.s = 'a Arg.Rep.s * 'x
+ where type ('a, 'k, 'x) Rep.p = ('a, 'k) Arg.Rep.p * 'x =
+struct
+ (* <-- SML/NJ workaround *)
+ open TopLevel
+ (* SML/NJ workaround --> *)
+
+ structure Rep : OPEN_GENERIC_REP = struct
+ val get = Pair.snd
+ fun map f = Pair.map (id, f)
+
+ type ('a, 'x) t = 'a Arg.Rep.t * 'x
+ val getT = get
+ val mapT = map
+
+ type ('a, 'x) s = 'a Arg.Rep.s * 'x
+ val getS = get
+ val mapS = map
+
+ type ('a, 'k, 'x) p = ('a, 'k) Arg.Rep.p * 'x
+ val getP = get
+ val mapP = map
+ end
+
+ fun unary arg fx = Pair.map (arg, fx)
+ fun binary arg fxy x = Pair.map (arg x, fxy x)
+ fun binop arg fxy = Pair.map (arg, fxy) o Pair.swizzle
+ fun morph arg f (a, x) aIb = (arg a aIb, f x aIb)
+
+ fun iso ? = morph Arg.iso ?
+ fun isoProduct ? = morph Arg.isoProduct ?
+ fun isoSum ? = morph Arg.isoSum ?
+ fun op *` ? = binop Arg.*` ?
+ fun T ? = unary Arg.T ?
+ fun R ? = binary Arg.R ?
+ fun tuple ? = unary Arg.tuple ?
+ fun record ? = unary Arg.record ?
+ fun op +` ? = binop Arg.+` ?
+ fun C0 fc c = (Arg.C0 c, fc c)
+ fun C1 ? = binary Arg.C1 ?
+ fun data ? = unary Arg.data ?
+ fun unit x = (Arg.unit, x)
+ fun Y y = Tie.tuple2 (Arg.Y, y)
+ fun op --> ? = binop Arg.--> ?
+ fun exn x = (Arg.exn, x)
+ fun regExn x2ef (a, x) = Pair.app (Arg.regExn a, x2ef x) o Sq.mk
+ fun array ? = unary Arg.array ?
+ fun refc ? = unary Arg.refc ?
+ fun vector ? = unary Arg.vector ?
+ fun largeInt x = (Arg.largeInt, x)
+ fun largeReal x = (Arg.largeReal, x)
+ fun largeWord x = (Arg.largeWord, x)
+ fun word8 x = (Arg.word8, x)
+(* fun word16 x = (Arg.word16, x) (* Word16 not provided by SML/NJ *) *)
+ fun word32 x = (Arg.word32, x)
+ fun word64 x = (Arg.word64, x)
+ fun list ? = unary Arg.list ?
+ fun bool x = (Arg.bool, x)
+ fun char x = (Arg.char, x)
+ fun int x = (Arg.int, x)
+ fun real x = (Arg.real, x)
+ fun string x = (Arg.string, x)
+ fun word x = (Arg.word, x)
+end
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml (from rev 5607, mltonlib/trunk/com/ssh/generic/unstable/detail/ext-generic.sml)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ext-generic.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,60 @@
+(* 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 RootGeneric :> OPEN_GENERIC = struct
+ (* <-- SML/NJ workaround *)
+ open TopLevel
+ (* SML/NJ workaround --> *)
+
+ structure Rep = struct
+ type ('a, 'x) t = 'x
+ val getT = id
+ val mapT = id
+
+ type ('a, 'x) s = 'x
+ val getS = id
+ val mapS = id
+
+ type ('a, 'k, 'x) p = 'x
+ val getP = id
+ val mapP = id
+ end
+
+ val iso = id
+ val isoProduct = id
+ val isoSum = id
+ val op *` = id
+ val T = id
+ val R = id
+ val tuple = id
+ val record = id
+ val op +` = id
+ val C0 = id
+ val C1 = id
+ val data = id
+ val unit = id
+ val Y = id
+ val op --> = id
+ val exn = id
+ val regExn = id
+ val array = id
+ val refc = id
+ val vector = id
+ val largeInt = id
+ val largeReal = id
+ val largeWord = id
+ val word8 = id
+(* val word16 = id (* Word16 not provided by SML/NJ *) *)
+ val word32 = id
+ val word64 = id
+ val list = id
+ val bool = id
+ val char = id
+ val int = id
+ val real = id
+ val string = id
+ val word = id
+end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -28,33 +28,33 @@
datatype 'a u = IN of {gen : 'a G.t, cog : 'a -> Univ.t G.t UnOp.t}
fun out (IN r) = r
- structure Index : EXT_GENERIC_INDEX = struct
+ structure Rep : OPEN_GENERIC_REP = struct
fun get get = Pair.snd o get
fun map map f = map (Pair.map (id, f))
- type ('a, 'x) t = ('a, 'a u * 'x) Outer.Index.t
- fun getT ? = get Outer.Index.getT ?
- fun mapT ? = map Outer.Index.mapT ?
+ type ('a, 'x) t = ('a, 'a u * 'x) Outer.Rep.t
+ fun getT ? = get Outer.Rep.getT ?
+ fun mapT ? = map Outer.Rep.mapT ?
- type ('a, 'x) s = ('a, 'a u * 'x) Outer.Index.s
- fun getS ? = get Outer.Index.getS ?
- fun mapS ? = map Outer.Index.mapS ?
+ type ('a, 'x) s = ('a, 'a u * 'x) Outer.Rep.s
+ fun getS ? = get Outer.Rep.getS ?
+ fun mapS ? = map Outer.Rep.mapS ?
- type ('a, 'k, 'x) p = ('a, 'k, 'a u * 'x) Outer.Index.p
- fun getP ? = get Outer.Index.getP ?
- fun mapP ? = map Outer.Index.mapP ?
+ type ('a, 'k, 'x) p = ('a, 'k, 'a u * 'x) Outer.Rep.p
+ fun getP ? = get Outer.Rep.getP ?
+ fun mapP ? = map Outer.Rep.mapP ?
end
- structure Arbitrary = Index
+ structure Arbitrary = Rep
fun universally ? = G.mapUnOp (Univ.newIso ()) ?
val map = G.Monad.map
val op >>= = G.>>=
- fun arbitrary ? = (#gen o out o Pair.fst o Outer.Index.getT) ?
+ fun arbitrary ? = (#gen o out o Pair.fst o Outer.Rep.getT) ?
fun withGen gen =
- Outer.Index.mapT
+ Outer.Rep.mapT
(Pair.map (fn IN {cog, ...} => IN {gen = gen,cog = cog},
id))
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -13,8 +13,8 @@
infixr 0 -->
(* SML/NJ workaround --> *)
- structure Lifted = LiftGeneric
- (structure Index = struct
+ structure Opened = OpenGeneric
+ (structure Rep = struct
type 'a t = 'a Option.t
type 'a s = 'a t
type ('a, 'k) p = 'a t
@@ -46,9 +46,9 @@
fun vector _ = SOME (Vector.tabulate (0, undefined))
- val largeInt : LargeInt.t Index.t = SOME 0
- val largeReal : LargeReal.t Index.t = SOME 0.0
- val largeWord : LargeWord.t Index.t = SOME 0w0
+ val largeInt : LargeInt.t Rep.t = SOME 0
+ val largeReal : LargeReal.t Rep.t = SOME 0.0
+ val largeWord : LargeWord.t Rep.t = SOME 0w0
fun list _ = SOME []
@@ -60,10 +60,10 @@
val unit = SOME ()
val word = SOME 0w0
- val word8 : Word8.t Index.t = SOME 0w0
- (* val word16 : Word16.t Index.t = SOME 0w0 (* Word16 not provided by SML/NJ *) *)
- val word32 : Word32.t Index.t = SOME 0w0
- val word64 : Word64.t Index.t = SOME 0w0
+ val word8 : Word8.t Rep.t = SOME 0w0
+ (* val word16 : Word16.t Rep.t = SOME 0w0 (* Word16 not provided by SML/NJ *) *)
+ val word32 : Word32.t Rep.t = SOME 0w0
+ val word64 : Word64.t Rep.t = SOME 0w0
(* Trivialities *)
@@ -79,9 +79,9 @@
fun C1 _ = id
val data = id)
- open Lifted
+ open Opened
- structure Dummy = Index
+ structure Dummy = Rep
exception Dummy
fun dummy (vo, _) =
@@ -92,10 +92,10 @@
fun noDummy (_, x) = (NONE, x)
end
-functor WithDummy (Outer : EXT_GENERIC) : DUMMY_GENERIC = struct
+functor WithDummy (Outer : OPEN_GENERIC) : DUMMY_GENERIC = struct
structure Joined = JoinGenerics (structure Outer = Outer and Inner = Dummy)
open Dummy Joined
- structure Dummy = Index
- val dummy = fn ? => dummy (Outer.Index.getT ?)
- val noDummy = fn ? => Outer.Index.mapT noDummy ?
+ structure Dummy = Rep
+ val dummy = fn ? => dummy (Outer.Rep.getT ?)
+ val noDummy = fn ? => Outer.Rep.mapT noDummy ?
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -13,8 +13,8 @@
infixr 0 -->
(* SML/NJ workaround --> *)
- structure Lifted = LiftGeneric
- (structure Index = struct
+ structure Opened = OpenGeneric
+ (structure Rep = struct
type 'a t = 'a BinPr.t
type 'a s = 'a t
type ('a, 'k) p = 'a t
@@ -33,7 +33,7 @@
fun _ --> _ = raising e
end
- val exn : Exn.t Index.t Ref.t = ref GenericsUtil.failExnSq
+ val exn : Exn.t Rep.t Ref.t = ref GenericsUtil.failExnSq
fun regExn t (_, prj) =
Ref.modify (fn exn =>
fn (l, r) =>
@@ -82,19 +82,19 @@
fun C1 _ = id
val data = id)
- open Lifted
+ open Opened
- structure Eq = Index
+ structure Eq = Rep
val eq = Pair.fst
fun notEq (eq, _) = negate eq
end
-functor WithEq (Outer : EXT_GENERIC) : EQ_GENERIC = struct
+functor WithEq (Outer : OPEN_GENERIC) : EQ_GENERIC = struct
structure Joined = JoinGenerics (structure Outer = Outer and Inner = Eq)
open Eq Joined
- structure Eq = Index
- fun mk f = f o Outer.Index.getT
+ structure Eq = Rep
+ fun mk f = f o Outer.Rep.getT
val eq = fn ? => mk eq ?
val notEq = fn ? => mk notEq ?
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -13,8 +13,8 @@
infixr 0 -->
(* SML/NJ workaround --> *)
- structure Lifted = LiftGeneric
- (structure Index = struct
+ structure Opened = OpenGeneric
+ (structure Rep = struct
type 'a t = 'a Cmp.t
type 'a s = 'a t
type ('a, 'k) p = 'a t
@@ -38,7 +38,7 @@
* a reasonable answer as long as at least one of the exception
* variants (involved in a comparison) has been registered.
*)
- val exn : Exn.t Index.t Ref.t = ref GenericsUtil.failExnSq
+ val exn : Exn.t Rep.t Ref.t = ref GenericsUtil.failExnSq
fun regExn t (_, prj) =
Ref.modify (fn exn =>
fn (l, r) =>
@@ -87,16 +87,16 @@
fun C1 _ = id
val data = id)
- open Lifted
+ open Opened
- structure Ord = Index
+ structure Ord = Rep
val compare = Pair.fst
end
-functor WithOrd (Outer : EXT_GENERIC) : ORD_GENERIC = struct
+functor WithOrd (Outer : OPEN_GENERIC) : ORD_GENERIC = struct
structure Joined = JoinGenerics (structure Outer = Outer and Inner = Ord)
open Ord Joined
- structure Ord = Index
- val compare = fn ? => compare (Outer.Index.getT ?)
+ structure Ord = Rep
+ val compare = fn ? => compare (Outer.Rep.getT ?)
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -24,7 +24,7 @@
infixr 0 -->
(* SML/NJ workaround --> *)
- structure Lifted = LiftGeneric
+ structure Opened = OpenGeneric
(local
open Prettier
type u = Bool.t * t
@@ -65,7 +65,7 @@
val c2s = Con.toString
end
- structure Index = struct
+ structure Rep = struct
type 'a t = exn list * 'a -> u
type 'a s = 'a t
type ('a, 'k) p = 'a t
@@ -103,7 +103,7 @@
val Y = Tie.function
- val exn : Exn.t Index.t ref =
+ val exn : Exn.t Rep.t ref =
ref (txt o "#" <\ op ^ o General.exnName o #2)
fun regExn t (_, prj) =
Ref.modify (fn exn => fn (env, e) =>
@@ -169,7 +169,7 @@
(#"\n" <\ op =) s)))})
end
- fun mk toS : 'a Index.t = txt o toS o Pair.snd
+ fun mk toS : 'a Rep.t = txt o toS o Pair.snd
fun enc l r toS x = concat [l, toS x, r]
fun mkWord toString = mk ("0wx" <\ op ^ o toString)
@@ -189,18 +189,18 @@
val word32 = mkWord Word32.toString
val word64 = mkWord Word64.toString)
- open Lifted
+ open Opened
- structure Show = Index
+ structure Show = Rep
fun layout (t, _) x = Pair.snd (t ([], x))
fun show m t = Prettier.pretty m o layout t
end
-functor WithShow (Outer : EXT_GENERIC) : SHOW_GENERIC = struct
+functor WithShow (Outer : OPEN_GENERIC) : SHOW_GENERIC = struct
structure Joined = JoinGenerics (structure Outer = Outer and Inner = Show)
open Joined
- fun layout ? = Show.layout (Outer.Index.getT ?)
- fun show m = Show.show m o Outer.Index.getT
- structure Show = Index
+ fun layout ? = Show.layout (Outer.Rep.getT ?)
+ fun show m = Show.show m o Outer.Rep.getT
+ structure Show = Rep
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -54,8 +54,8 @@
List.revAppend (lp ([], ys))
end
- structure Lifted = LiftGeneric
- (structure Index = struct
+ structure Opened = OpenGeneric
+ (structure Rep = struct
type 'a t = u
type 'a s = u
type ('a, 'k) p = u
@@ -139,9 +139,9 @@
fun C1 _ = id
val data = id)
- open Lifted
+ open Opened
- structure TypeInfo = Index
+ structure TypeInfo = Rep
fun out (IN t, _) = t
@@ -153,16 +153,16 @@
fun canBeCyclic ? = (isRefOrArray andAlso (hasExn orElse hasRecData)) ?
end
-functor WithTypeInfo (Outer : EXT_GENERIC) : TYPE_INFO_GENERIC = struct
+functor WithTypeInfo (Outer : OPEN_GENERIC) : TYPE_INFO_GENERIC = struct
structure Joined = JoinGenerics (structure Outer = Outer and Inner = TypeInfo)
open TypeInfo Joined
- structure TypeInfo = Index
- fun mk f = f o Outer.Index.getT
+ structure TypeInfo = Rep
+ fun mk f = f o Outer.Rep.getT
val canBeCyclic = fn ? => mk canBeCyclic ?
val hasExn = fn ? => mk hasExn ?
val hasRecData = fn ? => mk hasRecData ?
val isRefOrArray = fn ? => mk isRefOrArray ?
- fun mk f = f o Outer.Index.getS
+ fun mk f = f o Outer.Rep.getS
val hasBaseCase = fn ? => mk hasBaseCase ?
val numConsecutiveAlts = fn ? => mk numConsecutiveAlts ?
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/with-convenience.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/with-convenience.fun 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/with-convenience.fun 2007-06-10 11:54:24 UTC (rev 5608)
@@ -4,7 +4,7 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-functor WithConvenience (Arg : GENERIC) : GENERIC_WITH_CONVENIENCE = struct
+functor WithConvenience (Arg : CLOSED_GENERIC) : CLOSED_GENERIC_WITH_CONVENIENCE = struct
(* <-- SML/NJ workaround *)
open TopLevel
infix 7 *`
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.cm 2007-06-10 11:54:24 UTC (rev 5608)
@@ -6,9 +6,9 @@
library
library(lib.cm)
- source(detail/default.sml)
+ source(detail/generic.sml)
is
../../extended-basis/unstable/basis.cm
../../random/unstable/lib.cm
- detail/default.sml
+ detail/generic.sml
lib.cm
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib-with-default.mlb 2007-06-10 11:54:24 UTC (rev 5608)
@@ -9,5 +9,5 @@
$(MLTON_LIB)/com/ssh/random/unstable/lib.mlb
in
lib.mlb
- detail/default.sml
+ detail/generic.sml
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-10 11:54:24 UTC (rev 5608)
@@ -25,19 +25,19 @@
public/generics-util.sig
detail/generics-util.sml
- public/generic-index.sig
- public/generic.sig
+ public/closed-generic-rep.sig
+ public/closed-generic.sig
- public/generic-with-convenience.sig
+ public/closed-generic-with-convenience.sig
detail/with-convenience.fun
- public/ext-generic-index.sig
- public/ext-generic.sig
+ public/open-generic-rep.sig
+ public/open-generic.sig
- detail/ext-generic.sml
+ detail/root-generic.sml
- detail/ground-generic.fun
- detail/lift-generic.fun
+ detail/close-generic.fun
+ detail/open-generic.fun
public/join-generics-fun.sig
detail/join-generics.fun
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic-rep.sig (from rev 5602, mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig 2007-06-08 16:11:10 UTC (rev 5602)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic-rep.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,19 @@
+(* 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 for the types of type-indices of generic functions.
+ *)
+signature CLOSED_GENERIC_REP = sig
+ type 'a t
+ (** Type of complete type-indices. *)
+
+ type 'a s
+ (** Type of incomplete sum type-indices. *)
+
+ type ('a, 'k) p
+ (** Type of incomplete product type-indices. *)
+end
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic-with-convenience.sig (from rev 5603, mltonlib/trunk/com/ssh/generic/unstable/public/generic-with-convenience.sig)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-with-convenience.sig 2007-06-09 15:44:57 UTC (rev 5603)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic-with-convenience.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,58 @@
+(* 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 CLOSED_GENERIC_WITH_CONVENIENCE = sig
+ include GENERICS CLOSED_GENERIC
+
+ (** == Shorthands for Types with Labels or Constructors ==
+ *
+ * These should only be used for defining monomorphic type-indices.
+ *)
+
+ val C0' : String.t -> Unit.t Rep.s
+ val C1' : String.t -> 'a Rep.t -> 'a Rep.s
+
+ val R' : String.t -> 'a Rep.t -> ('a, Generics.Record.t) Rep.p
+
+ val regExn0 : Exn.t -> (Exn.t -> Unit.t Option.t) -> String.t Effect.t
+ val regExn1 : ('a -> Exn.t) -> (Exn.t -> 'a Option.t) -> String.t -> 'a Rep.t Effect.t
+
+ (** == Tuples == *)
+
+ val tuple2 : 'a Rep.t * 'b Rep.t
+ -> ('a * 'b) Rep.t
+ val tuple3 : 'a Rep.t * 'b Rep.t * 'c Rep.t
+ -> ('a * 'b * 'c) Rep.t
+ val tuple4 : 'a Rep.t * 'b Rep.t * 'c Rep.t * 'd Rep.t
+ -> ('a * 'b * 'c * 'd) Rep.t
+
+ (** == Integer Types ==
+ *
+ * WARNING: The encodings of sized integer types are not optimal for
+ * serialization. (They do work, however.) For serialization, one
+ * should encode sized integer types in terms of the corresponding
+ * sized word types.
+ *)
+
+ val int32 : Int32.t Rep.t
+ val int64 : Int64.t Rep.t
+
+ (** == Some Standard Datatypes == *)
+
+ val option : 'a Rep.t -> 'a Option.t Rep.t
+ val order : order Rep.t
+
+ (** == Sums and Products == *)
+
+ val &` : 'a Rep.t * 'b Rep.t -> ('a,'b) Product.t Rep.t
+ val |` : 'a Rep.t * 'b Rep.t -> ('a,'b) Sum.t Rep.t
+
+ (** == Abbreviations for Common Types == *)
+
+ val sq : 'a Rep.t -> ('a * 'a) Rep.t
+ val uop : 'a Rep.t -> ('a -> 'a) Rep.t
+ val bop : 'a Rep.t -> ('a * 'a -> 'a) Rep.t
+end
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic.sig (from rev 5602, mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-06-08 16:11:10 UTC (rev 5602)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/closed-generic.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,129 @@
+(* 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.
+ *)
+
+(**
+ * A signature for type-indexed values based on a generic representation
+ * of datatypes.
+ *)
+signature CLOSED_GENERIC = sig
+ structure Rep : CLOSED_GENERIC_REP
+
+ (** == SUPPORT FOR USER-DEFINED TYPES == *)
+
+ val iso : 'b Rep.t -> ('a, 'b) Iso.t -> 'a Rep.t
+ (**
+ * Given a type-index {'b Rep.t} and an isomorphism between {'a} and
+ * {'b}, returns a type-index {'a Rep.t}. The purpose of {iso} is to
+ * support user-defined types.
+ *)
+
+ val isoProduct : ('b, 'k) Rep.p -> ('a, 'b) Iso.t -> ('a, 'k) Rep.p
+ (**
+ * Given a type-index {('b, 'k) Rep.p} and an isomorphism between
+ * {'a} and {'b}, returns a type-index {('a, 'k) Rep.p}.
+ *)
+
+ val isoSum : 'b Rep.s -> ('a, 'b) Iso.t -> 'a Rep.s
+ (**
+ * Given a type-index {'b Rep.s} and an isomorphism between {'a} and
+ * {'b}, returns a type-index {'a Rep.s}.
+ *)
+
+ (** == SUPPORT FOR TUPLES AND RECORDS == *)
+
+ val *` :
+ ('a, 'k) Rep.p * ('b, 'k) Rep.p -> (('a, 'b) Product.t, 'k) Rep.p
+ (**
+ * Given type-indices for fields of type {'a} and {'b} of the same kind
+ * {'k} (tuple or record), returns a type-index for the product {('a,
+ * 'b) Product.t}.
+ *)
+
+ val T : 'a Rep.t -> ('a, Generics.Tuple.t) Rep.p
+ (** Specifies a field of a tuple. *)
+
+ val R : Generics.Label.t -> 'a Rep.t -> ('a, Generics.Record.t) Rep.p
+ (** Specifies a field of a record. *)
+
+ val tuple : ('a, Generics.Tuple.t) Rep.p -> 'a Rep.t
+ (** Specifies a tuple. *)
+
+ val record : ('a, Generics.Record.t) Rep.p -> 'a Rep.t
+ (** Specifies a record. *)
+
+ (** == SUPPORT FOR DATATYPES == *)
+
+ val +` : 'a Rep.s * 'b Rep.s -> (('a, 'b) Sum.t) Rep.s
+ (**
+ * Given type-indices for variants of type {'a} and {'b}, returns a
+ * type-index for the sum {('a, 'b) Sum.t}.
+ *)
+
+ val C0 : Generics.Con.t -> Unit.t Rep.s
+ (** Specifies a nullary constructor. *)
+
+ val C1 : Generics.Con.t -> 'a Rep.t -> 'a Rep.s
+ (** Specifies a unary constructor. *)
+
+ val data : 'a Rep.s -> 'a Rep.t
+ (** Specifies a complete datatype. *)
+
+ val unit : Unit.t Rep.t
+ (**
+ * Type-index for the {unit} type. Using {unit} and {+} one can
+ * actually encode {bool}, {word}, and much more.
+ *)
+
+ val Y : 'a Rep.t Tie.t
+ (** Fixpoint tier to support recursive datatypes. *)
+
+ (** == SUPPORT FOR FUNCTIONS == *)
+
+ val --> : 'a Rep.t * 'b Rep.t -> ('a -> 'b) Rep.t
+
+ (** == SUPPORT FOR EXCEPTIONS == *)
+
+ val exn : Exn.t Rep.t
+ (** Universal type-index for exceptions. *)
+
+ val regExn : 'a Rep.s -> ('a, Exn.t) Emb.t Effect.t
+ (** Registers a handler for exceptions. *)
+
+ (** == SUPPORT FOR TYPES WITH IDENTITY == *)
+
+ val array : 'a Rep.t -> 'a Array.t Rep.t
+ val refc : 'a Rep.t -> 'a Ref.t Rep.t
+
+ (** == SUPPORT FOR FUNCTIONAL AGGREGATE TYPES == *)
+
+ val vector : 'a Rep.t -> 'a Vector.t Rep.t
+
+ (** == SUPPORT FOR ARBITRARY INTEGERS, WORDS, AND REALS == *)
+
+ val largeInt : LargeInt.t Rep.t
+ val largeReal : LargeReal.t Rep.t
+ val largeWord : LargeWord.t Rep.t
+
+ (** == SUPPORT FOR BINARY DATA == *)
+
+ val word8 : Word8.t Rep.t
+(* val word16 : Word16.t Rep.t (* Word16 not provided by SML/NJ *) *)
+ val word32 : Word32.t Rep.t
+ val word64 : Word64.t Rep.t
+
+ (** == SUPPORT FOR SOME BUILT-IN TYPE CONSTRUCTORS == *)
+
+ val list : 'a Rep.t -> 'a List.t Rep.t
+
+ (** == SUPPORT FOR SOME BUILT-IN BASE TYPES == *)
+
+ val bool : Bool.t Rep.t
+ val char : Char.t Rep.t
+ val int : Int.t Rep.t
+ val real : Real.t Rep.t
+ val string : String.t Rep.t
+ val word : Word.t Rep.t
+end
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-10 11:54:24 UTC (rev 5608)
@@ -10,13 +10,13 @@
signature GENERICS_UTIL = GENERICS_UTIL
-signature GENERIC = GENERIC
-signature GENERIC_INDEX = GENERIC_INDEX
+signature CLOSED_GENERIC = CLOSED_GENERIC
+signature CLOSED_GENERIC_REP = CLOSED_GENERIC_REP
-signature GENERIC_WITH_CONVENIENCE = GENERIC_WITH_CONVENIENCE
+signature OPEN_GENERIC = OPEN_GENERIC
+signature OPEN_GENERIC_REP = OPEN_GENERIC_REP
-signature EXT_GENERIC = EXT_GENERIC
-signature EXT_GENERIC_INDEX = EXT_GENERIC_INDEX
+signature CLOSED_GENERIC_WITH_CONVENIENCE = CLOSED_GENERIC_WITH_CONVENIENCE
(** === Value Signatures === *)
@@ -43,36 +43,36 @@
structure Generics : GENERICS = Generics
structure GenericsUtil : GENERICS_UTIL = GenericsUtil
-structure ExtGeneric : EXT_GENERIC = ExtGeneric
+structure RootGeneric : OPEN_GENERIC = RootGeneric
(** == Exported Functors == *)
-functor GroundGeneric (Arg : EXT_GENERIC) :
- GENERIC
- where type 'a Index.t = ('a, Unit.t) Arg.Index.t
- where type 'a Index.s = ('a, Unit.t) Arg.Index.s
- where type ('a, 'k) Index.p = ('a, 'k, Unit.t) Arg.Index.p =
- GroundGeneric (Arg)
-(** Grounds an extensible generic to an ordinary generic. *)
+functor CloseGeneric (Arg : OPEN_GENERIC) :
+ CLOSED_GENERIC
+ where type 'a Rep.t = ('a, Unit.t) Arg.Rep.t
+ where type 'a Rep.s = ('a, Unit.t) Arg.Rep.s
+ where type ('a, 'k) Rep.p = ('a, 'k, Unit.t) Arg.Rep.p =
+ CloseGeneric (Arg)
+(** Closes an open generic. *)
-functor LiftGeneric (Arg : GENERIC) :
- EXT_GENERIC
- where type ('a, 'x) Index.t = 'a Arg.Index.t * 'x
- where type ('a, 'x) Index.s = 'a Arg.Index.s * 'x
- where type ('a, 'k, 'x) Index.p = ('a, 'k) Arg.Index.p * 'x =
- LiftGeneric (Arg)
-(** Lifts an ordinary generic to an extensible generic. *)
+functor OpenGeneric (Arg : CLOSED_GENERIC) :
+ OPEN_GENERIC
+ where type ('a, 'x) Rep.t = 'a Arg.Rep.t * 'x
+ where type ('a, 'x) Rep.s = 'a Arg.Rep.s * 'x
+ where type ('a, 'k, 'x) Rep.p = ('a, 'k) Arg.Rep.p * 'x =
+ OpenGeneric (Arg)
+(** Opens a closed generic. *)
signature JOIN_GENERICS_DOM = JOIN_GENERICS_DOM
functor JoinGenerics (Arg : JOIN_GENERICS_DOM) :
- EXT_GENERIC
- where type ('a, 'b) Index.t =
- ('a, ('a, 'b) Arg.Inner.Index.t) Arg.Outer.Index.t
- where type ('a, 'b) Index.s =
- ('a, ('a, 'b) Arg.Inner.Index.s) Arg.Outer.Index.s
- where type ('a, 'b, 'c) Index.p =
- ('a, 'b, ('a, 'b, 'c) Arg.Inner.Index.p) Arg.Outer.Index.p =
+ OPEN_GENERIC
+ where type ('a, 'b) Rep.t =
+ ('a, ('a, 'b) Arg.Inner.Rep.t) Arg.Outer.Rep.t
+ where type ('a, 'b) Rep.s =
+ ('a, ('a, 'b) Arg.Inner.Rep.s) Arg.Outer.Rep.s
+ where type ('a, 'b, 'c) Rep.p =
+ ('a, 'b, ('a, 'b, 'c) Arg.Inner.Rep.p) Arg.Outer.Rep.p =
JoinGenerics (Arg)
(**
* Joins two extensible generic functions. As can be read from the where
@@ -80,8 +80,8 @@
* with the type-indices of the {Outer} generic.
*)
-functor WithConvenience (Arg : GENERIC) : GENERIC_WITH_CONVENIENCE =
- WithConvenience (Arg)
+functor WithConvenience (Arg : CLOSED_GENERIC) :
+ CLOSED_GENERIC_WITH_CONVENIENCE = WithConvenience (Arg)
(**
* Implements a number of frequently used type-indices for convenience.
* As a side-effect, this functor also registers handlers for most
@@ -96,13 +96,13 @@
functor WithArbitrary (Arg : WITH_ARBITRARY_DOM) : ARBITRARY_GENERIC =
WithArbitrary (Arg)
-functor WithDummy (Arg : EXT_GENERIC) : DUMMY_GENERIC = WithDummy (Arg)
+functor WithDummy (Arg : OPEN_GENERIC) : DUMMY_GENERIC = WithDummy (Arg)
-functor WithEq (Arg : EXT_GENERIC) : EQ_GENERIC = WithEq (Arg)
+functor WithEq (Arg : OPEN_GENERIC) : EQ_GENERIC = WithEq (Arg)
-functor WithOrd (Arg : EXT_GENERIC) : ORD_GENERIC = WithOrd (Arg)
+functor WithOrd (Arg : OPEN_GENERIC) : ORD_GENERIC = WithOrd (Arg)
-functor WithShow (Arg : EXT_GENERIC) : SHOW_GENERIC = WithShow (Arg)
+functor WithShow (Arg : OPEN_GENERIC) : SHOW_GENERIC = WithShow (Arg)
-functor WithTypeInfo (Arg : EXT_GENERIC) : TYPE_INFO_GENERIC =
+functor WithTypeInfo (Arg : OPEN_GENERIC) : TYPE_INFO_GENERIC =
WithTypeInfo (Arg)
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic-index.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic-index.sig 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic-index.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,19 +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.
- *)
-
-signature EXT_GENERIC_INDEX = sig
- type ('a, 'x) t
- val getT : ('a, 'x) t -> 'x
- val mapT : 'x UnOp.t -> ('a, 'x) t UnOp.t
-
- type ('a, 'x) s
- val getS : ('a, 'x) s -> 'x
- val mapS : 'x UnOp.t -> ('a, 'x) s UnOp.t
-
- type ('a, 'k, 'x) p
- val getP : ('a, 'k, 'x) p -> 'x
- val mapP : 'x UnOp.t -> ('a, 'k, 'x) p UnOp.t
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic.sig 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,43 +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.
- *)
-
-signature EXT_GENERIC = sig
- structure Index : EXT_GENERIC_INDEX
- val iso : ('y -> ('a, 'b) Iso.t -> 'x) -> ('b, 'y) Index.t -> ('a, 'b) Iso.t -> ('a, 'x) Index.t
- val isoProduct : ('y -> ('a, 'b) Iso.t -> 'x) -> ('b, 'k, 'y) Index.p -> ('a, 'b) Iso.t -> ('a, 'k, 'x) Index.p
- val isoSum : ('y -> ('a, 'b) Iso.t -> 'x) -> ('b, 'y) Index.s -> ('a, 'b) Iso.t -> ('a, 'x) Index.s
- val *` : ('x * 'y -> 'z) -> ('a, 'k, 'x) Index.p * ('b, 'k, 'y) Index.p -> (('a, 'b) Product.t, 'k, 'z) Index.p
- val T : ('x -> 'y) -> ('a, 'x) Index.t -> ('a, Generics.Tuple.t, 'y) Index.p
- val R : (Generics.Label.t -> 'x -> 'y) -> Generics.Label.t -> ('a, 'x) Index.t -> ('a, Generics.Record.t, 'y) Index.p
- val tuple : ('x -> 'y) -> ('a, Generics.Tuple.t, 'x) Index.p -> ('a, 'y) Index.t
- val record : ('x -> 'y) -> ('a, Generics.Record.t, 'x) Index.p -> ('a, 'y) Index.t
- val +` : ('x * 'y -> 'z) -> ('a, 'x) Index.s * ('b, 'y) Index.s -> (('a, 'b) Sum.t, 'z) Index.s
- val C0 : (Generics.Con.t -> 'x) -> Generics.Con.t -> (Unit.t, 'x) Index.s
- val C1 : (Generics.Con.t -> 'x -> 'y) -> Generics.Con.t -> ('a, 'x) Index.t -> ('a, 'y) Index.s
- val data : ('x -> 'y) -> ('a, 'x) Index.s -> ('a, 'y) Index.t
- val unit : 'x -> (Unit.t, 'x) Index.t
- val Y : 'x Tie.t -> ('a, 'x) Index.t Tie.t
- val --> : ('x * 'y -> 'z) -> ('a, 'x) Index.t * ('b, 'y) Index.t -> ('a -> 'b, 'z) Index.t
- val exn : 'x -> (Exn.t, 'x) Index.t
- val regExn : ('x -> ('a, Exn.t) Emb.t Effect.t) -> ('a, 'x) Index.s -> ('a, Exn.t) Emb.t Effect.t
- val array : ('x -> 'y) -> ('a, 'x) Index.t -> ('a Array.t, 'y) Index.t
- val refc : ('x -> 'y) -> ('a, 'x) Index.t -> ('a Ref.t, 'y) Index.t
- val vector : ('x -> 'y) -> ('a, 'x) Index.t -> ('a Vector.t, 'y) Index.t
- val largeInt : 'x -> (LargeInt.t, 'x) Index.t
- val largeReal : 'x -> (LargeReal.t, 'x) Index.t
- val largeWord : 'x -> (LargeWord.t, 'x) Index.t
- val word8 : 'x -> (Word8.t, 'x) Index.t
-(* val word16 : 'x -> (Word16.t, 'x) Index.t (* Word16 not provided by SML/NJ *) *)
- val word32 : 'x -> (Word32.t, 'x) Index.t
- val word64 : 'x -> (Word64.t, 'x) Index.t
- val list : ('x -> 'y) -> ('a, 'x) Index.t -> ('a List.t, 'y) Index.t
- val bool : 'x -> (Bool.t, 'x) Index.t
- val char : 'x -> (Char.t, 'x) Index.t
- val int : 'x -> (Int.t, 'x) Index.t
- val real : 'x -> (Real.t, 'x) Index.t
- val string : 'x -> (String.t, 'x) Index.t
- val word : 'x -> (Word.t, 'x) Index.t
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,19 +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.
- *)
-
-(**
- * Signature for the types of type-indices of generic functions.
- *)
-signature GENERIC_INDEX = sig
- type 'a t
- (** Type of complete type-indices. *)
-
- type 'a s
- (** Type of incomplete sum type-indices. *)
-
- type ('a, 'k) p
- (** Type of incomplete product type-indices. *)
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/generic-with-convenience.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-with-convenience.sig 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic-with-convenience.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,58 +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.
- *)
-
-signature GENERIC_WITH_CONVENIENCE = sig
- include GENERICS GENERIC
-
- (** == Shorthands for Types with Labels or Constructors ==
- *
- * These should only be used for defining monomorphic type-indices.
- *)
-
- val C0' : String.t -> Unit.t Index.s
- val C1' : String.t -> 'a Index.t -> 'a Index.s
-
- val R' : String.t -> 'a Index.t -> ('a, Generics.Record.t) Index.p
-
- val regExn0 : Exn.t -> (Exn.t -> Unit.t Option.t) -> String.t Effect.t
- val regExn1 : ('a -> Exn.t) -> (Exn.t -> 'a Option.t) -> String.t -> 'a Index.t Effect.t
-
- (** == Tuples == *)
-
- val tuple2 : 'a Index.t * 'b Index.t
- -> ('a * 'b) Index.t
- val tuple3 : 'a Index.t * 'b Index.t * 'c Index.t
- -> ('a * 'b * 'c) Index.t
- val tuple4 : 'a Index.t * 'b Index.t * 'c Index.t * 'd Index.t
- -> ('a * 'b * 'c * 'd) Index.t
-
- (** == Integer Types ==
- *
- * WARNING: The encodings of sized integer types are not optimal for
- * serialization. (They do work, however.) For serialization, one
- * should encode sized integer types in terms of the corresponding
- * sized word types.
- *)
-
- val int32 : Int32.t Index.t
- val int64 : Int64.t Index.t
-
- (** == Some Standard Datatypes == *)
-
- val option : 'a Index.t -> 'a Option.t Index.t
- val order : order Index.t
-
- (** == Sums and Products == *)
-
- val &` : 'a Index.t * 'b Index.t -> ('a,'b) Product.t Index.t
- val |` : 'a Index.t * 'b Index.t -> ('a,'b) Sum.t Index.t
-
- (** == Abbreviations for Common Types == *)
-
- val sq : 'a Index.t -> ('a * 'a) Index.t
- val uop : 'a Index.t -> ('a -> 'a) Index.t
- val bop : 'a Index.t -> ('a * 'a -> 'a) Index.t
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -1,129 +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.
- *)
-
-(**
- * A signature for type-indexed values based on a generic representation
- * of datatypes.
- *)
-signature GENERIC = sig
- structure Index : GENERIC_INDEX
-
- (** == SUPPORT FOR USER-DEFINED TYPES == *)
-
- val iso : 'b Index.t -> ('a, 'b) Iso.t -> 'a Index.t
- (**
- * Given a type-index {'b Index.t} and an isomorphism between {'a} and
- * {'b}, returns a type-index {'a Index.t}. The purpose of {iso} is to
- * support user-defined types.
- *)
-
- val isoProduct : ('b, 'k) Index.p -> ('a, 'b) Iso.t -> ('a, 'k) Index.p
- (**
- * Given a type-index {('b, 'k) Index.p} and an isomorphism between
- * {'a} and {'b}, returns a type-index {('a, 'k) Index.p}.
- *)
-
- val isoSum : 'b Index.s -> ('a, 'b) Iso.t -> 'a Index.s
- (**
- * Given a type-index {'b Index.s} and an isomorphism between {'a} and
- * {'b}, returns a type-index {'a Index.s}.
- *)
-
- (** == SUPPORT FOR TUPLES AND RECORDS == *)
-
- val *` :
- ('a, 'k) Index.p * ('b, 'k) Index.p -> (('a, 'b) Product.t, 'k) Index.p
- (**
- * Given type-indices for fields of type {'a} and {'b} of the same kind
- * {'k} (tuple or record), returns a type-index for the product {('a,
- * 'b) Product.t}.
- *)
-
- val T : 'a Index.t -> ('a, Generics.Tuple.t) Index.p
- (** Specifies a field of a tuple. *)
-
- val R : Generics.Label.t -> 'a Index.t -> ('a, Generics.Record.t) Index.p
- (** Specifies a field of a record. *)
-
- val tuple : ('a, Generics.Tuple.t) Index.p -> 'a Index.t
- (** Specifies a tuple. *)
-
- val record : ('a, Generics.Record.t) Index.p -> 'a Index.t
- (** Specifies a record. *)
-
- (** == SUPPORT FOR DATATYPES == *)
-
- val +` : 'a Index.s * 'b Index.s -> (('a, 'b) Sum.t) Index.s
- (**
- * Given type-indices for variants of type {'a} and {'b}, returns a
- * type-index for the sum {('a, 'b) Sum.t}.
- *)
-
- val C0 : Generics.Con.t -> Unit.t Index.s
- (** Specifies a nullary constructor. *)
-
- val C1 : Generics.Con.t -> 'a Index.t -> 'a Index.s
- (** Specifies a unary constructor. *)
-
- val data : 'a Index.s -> 'a Index.t
- (** Specifies a complete datatype. *)
-
- val unit : Unit.t Index.t
- (**
- * Type-index for the {unit} type. Using {unit} and {+} one can
- * actually encode {bool}, {word}, and much more.
- *)
-
- val Y : 'a Index.t Tie.t
- (** Fixpoint tier to support recursive datatypes. *)
-
- (** == SUPPORT FOR FUNCTIONS == *)
-
- val --> : 'a Index.t * 'b Index.t -> ('a -> 'b) Index.t
-
- (** == SUPPORT FOR EXCEPTIONS == *)
-
- val exn : Exn.t Index.t
- (** Universal type-index for exceptions. *)
-
- val regExn : 'a Index.s -> ('a, Exn.t) Emb.t Effect.t
- (** Registers a handler for exceptions. *)
-
- (** == SUPPORT FOR TYPES WITH IDENTITY == *)
-
- val array : 'a Index.t -> 'a Array.t Index.t
- val refc : 'a Index.t -> 'a Ref.t Index.t
-
- (** == SUPPORT FOR FUNCTIONAL AGGREGATE TYPES == *)
-
- val vector : 'a Index.t -> 'a Vector.t Index.t
-
- (** == SUPPORT FOR ARBITRARY INTEGERS, WORDS, AND REALS == *)
-
- val largeInt : LargeInt.t Index.t
- val largeReal : LargeReal.t Index.t
- val largeWord : LargeWord.t Index.t
-
- (** == SUPPORT FOR BINARY DATA == *)
-
- val word8 : Word8.t Index.t
-(* val word16 : Word16.t Index.t (* Word16 not provided by SML/NJ *) *)
- val word32 : Word32.t Index.t
- val word64 : Word64.t Index.t
-
- (** == SUPPORT FOR SOME BUILT-IN TYPE CONSTRUCTORS == *)
-
- val list : 'a Index.t -> 'a List.t Index.t
-
- (** == SUPPORT FOR SOME BUILT-IN BASE TYPES == *)
-
- val bool : Bool.t Index.t
- val char : Char.t Index.t
- val int : Int.t Index.t
- val real : Real.t Index.t
- val string : String.t Index.t
- val word : Word.t Index.t
-end
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/join-generics-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/join-generics-fun.sig 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/join-generics-fun.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -5,6 +5,6 @@
*)
signature JOIN_GENERICS_DOM = sig
- structure Outer : EXT_GENERIC
- structure Inner : EXT_GENERIC
+ structure Outer : OPEN_GENERIC
+ structure Inner : OPEN_GENERIC
end
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/open-generic-rep.sig (from rev 5602, mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic-index.sig)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic-index.sig 2007-06-08 16:11:10 UTC (rev 5602)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/open-generic-rep.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,19 @@
+(* 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 OPEN_GENERIC_REP = sig
+ type ('a, 'x) t
+ val getT : ('a, 'x) t -> 'x
+ val mapT : 'x UnOp.t -> ('a, 'x) t UnOp.t
+
+ type ('a, 'x) s
+ val getS : ('a, 'x) s -> 'x
+ val mapS : 'x UnOp.t -> ('a, 'x) s UnOp.t
+
+ type ('a, 'k, 'x) p
+ val getP : ('a, 'k, 'x) p -> 'x
+ val mapP : 'x UnOp.t -> ('a, 'k, 'x) p UnOp.t
+end
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/open-generic.sig (from rev 5602, mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic.sig)
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/ext-generic.sig 2007-06-08 16:11:10 UTC (rev 5602)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/open-generic.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -0,0 +1,43 @@
+(* 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 OPEN_GENERIC = sig
+ structure Rep : OPEN_GENERIC_REP
+ val iso : ('y -> ('a, 'b) Iso.t -> 'x) -> ('b, 'y) Rep.t -> ('a, 'b) Iso.t -> ('a, 'x) Rep.t
+ val isoProduct : ('y -> ('a, 'b) Iso.t -> 'x) -> ('b, 'k, 'y) Rep.p -> ('a, 'b) Iso.t -> ('a, 'k, 'x) Rep.p
+ val isoSum : ('y -> ('a, 'b) Iso.t -> 'x) -> ('b, 'y) Rep.s -> ('a, 'b) Iso.t -> ('a, 'x) Rep.s
+ val *` : ('x * 'y -> 'z) -> ('a, 'k, 'x) Rep.p * ('b, 'k, 'y) Rep.p -> (('a, 'b) Product.t, 'k, 'z) Rep.p
+ val T : ('x -> 'y) -> ('a, 'x) Rep.t -> ('a, Generics.Tuple.t, 'y) Rep.p
+ val R : (Generics.Label.t -> 'x -> 'y) -> Generics.Label.t -> ('a, 'x) Rep.t -> ('a, Generics.Record.t, 'y) Rep.p
+ val tuple : ('x -> 'y) -> ('a, Generics.Tuple.t, 'x) Rep.p -> ('a, 'y) Rep.t
+ val record : ('x -> 'y) -> ('a, Generics.Record.t, 'x) Rep.p -> ('a, 'y) Rep.t
+ val +` : ('x * 'y -> 'z) -> ('a, 'x) Rep.s * ('b, 'y) Rep.s -> (('a, 'b) Sum.t, 'z) Rep.s
+ val C0 : (Generics.Con.t -> 'x) -> Generics.Con.t -> (Unit.t, 'x) Rep.s
+ val C1 : (Generics.Con.t -> 'x -> 'y) -> Generics.Con.t -> ('a, 'x) Rep.t -> ('a, 'y) Rep.s
+ val data : ('x -> 'y) -> ('a, 'x) Rep.s -> ('a, 'y) Rep.t
+ val unit : 'x -> (Unit.t, 'x) Rep.t
+ val Y : 'x Tie.t -> ('a, 'x) Rep.t Tie.t
+ val --> : ('x * 'y -> 'z) -> ('a, 'x) Rep.t * ('b, 'y) Rep.t -> ('a -> 'b, 'z) Rep.t
+ val exn : 'x -> (Exn.t, 'x) Rep.t
+ val regExn : ('x -> ('a, Exn.t) Emb.t Effect.t) -> ('a, 'x) Rep.s -> ('a, Exn.t) Emb.t Effect.t
+ val array : ('x -> 'y) -> ('a, 'x) Rep.t -> ('a Array.t, 'y) Rep.t
+ val refc : ('x -> 'y) -> ('a, 'x) Rep.t -> ('a Ref.t, 'y) Rep.t
+ val vector : ('x -> 'y) -> ('a, 'x) Rep.t -> ('a Vector.t, 'y) Rep.t
+ val largeInt : 'x -> (LargeInt.t, 'x) Rep.t
+ val largeReal : 'x -> (LargeReal.t, 'x) Rep.t
+ val largeWord : 'x -> (LargeWord.t, 'x) Rep.t
+ val word8 : 'x -> (Word8.t, 'x) Rep.t
+(* val word16 : 'x -> (Word16.t, 'x) Rep.t (* Word16 not provided by SML/NJ *) *)
+ val word32 : 'x -> (Word32.t, 'x) Rep.t
+ val word64 : 'x -> (Word64.t, 'x) Rep.t
+ val list : ('x -> 'y) -> ('a, 'x) Rep.t -> ('a List.t, 'y) Rep.t
+ val bool : 'x -> (Bool.t, 'x) Rep.t
+ val char : 'x -> (Char.t, 'x) Rep.t
+ val int : 'x -> (Int.t, 'x) Rep.t
+ val real : 'x -> (Real.t, 'x) Rep.t
+ val string : 'x -> (String.t, 'x) Rep.t
+ val word : 'x -> (Word.t, 'x) Rep.t
+end
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/arbitrary.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/arbitrary.sig 2007-06-10 10:38:16 UTC (rev 5607)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/arbitrary.sig 2007-06-10 11:54:24 UTC (rev 5608)
@@ -11,7 +11,7 @@
* Koen Claessen and John Hughes.
*)
signature ARBITRARY = sig
- structure Arbitrary : EXT_GENERIC_INDEX
+ structure Arbitrary : OPEN_GENERIC_REP
structure RandomGen : RANDOM_GEN
(** The underlying random value generator. *)
@@ -24,13 +24,13 @@
end
signature ARBITRARY_GENERIC = sig
- include ARBITRARY EXT_GENERIC
- sharing Arbitrary = Index
+ include ARBITRARY OPEN_GENERIC
+ sharing Arbitrary = Rep
end
signature WITH_ARBITRARY_DOM = sig
- structure Outer : EXT_GENERIC
+ structure Outer : OPEN_GENERIC
More information about the MLton-commit
mailing list