[MLton-commit] r5835
Vesa Karvonen
vesak at mlton.org
Wed Aug 8 10:25:25 PDT 2007
Removed join-generics, which is no longer used.
Reorganized the exports.
----------------------------------------------------------------------
D mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
U mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
----------------------------------------------------------------------
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun 2007-08-08 08:35:36 UTC (rev 5834)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun 2007-08-08 17:25:24 UTC (rev 5835)
@@ -1,51 +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 JoinCases (Arg : JOIN_CASES_DOM) :>
- 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 Rep = JoinGenericReps (structure Outer = Outer.Rep
- structure Inner = Inner.Rep)
- fun iso ? = Outer.iso (Inner.iso ?)
- fun isoProduct ? = Outer.isoProduct (Inner.isoProduct ?)
- fun isoSum ? = Outer.isoSum (Inner.isoSum ?)
- fun op *` ? = Outer.*` (Inner.*` ?)
- fun T ? = Outer.T (Inner.T ?)
- fun R ? = Outer.R (Inner.R ?)
- fun tuple ? = Outer.tuple (Inner.tuple ?)
- fun record ? = Outer.record (Inner.record ?)
- fun op +` ? = Outer.+` (Inner.+` ?)
- fun C0 ? = Outer.C0 (Inner.C0 ?)
- fun C1 ? = Outer.C1 (Inner.C1 ?)
- fun data ? = Outer.data (Inner.data ?)
- fun unit ? = Outer.unit (Inner.unit ?)
- fun Y ? = Outer.Y (Inner.Y ?)
- fun op --> ? = Outer.--> (Inner.--> ?)
- fun exn ? = Outer.exn (Inner.exn ?)
- fun regExn ? = Outer.regExn (Inner.regExn ?)
- fun array ? = Outer.array (Inner.array ?)
- fun refc ? = Outer.refc (Inner.refc ?)
- fun vector ? = Outer.vector (Inner.vector ?)
- fun largeInt ? = Outer.largeInt (Inner.largeInt ?)
- fun largeReal ? = Outer.largeReal (Inner.largeReal ?)
- fun largeWord ? = Outer.largeWord (Inner.largeWord ?)
- fun word8 ? = Outer.word8 (Inner.word8 ?)
-(* fun word16 ? = Outer.word16 (Inner.word16 ?)
- (* Word16 not provided by SML/NJ *) *)
- fun word32 ? = Outer.word32 (Inner.word32 ?)
- fun word64 ? = Outer.word64 (Inner.word64 ?)
- fun list ? = Outer.list (Inner.list ?)
- fun bool ? = Outer.bool (Inner.bool ?)
- fun char ? = Outer.char (Inner.char ?)
- fun int ? = Outer.int (Inner.int ?)
- fun real ? = Outer.real (Inner.real ?)
- fun string ? = Outer.string (Inner.string ?)
- fun word ? = Outer.word (Inner.word ?)
-end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-08-08 08:35:36 UTC (rev 5834)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-08-08 17:25:24 UTC (rev 5835)
@@ -4,32 +4,6 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-signature JOIN_REPS_DOM = sig
- structure Outer : OPEN_REP
- structure Inner : OPEN_REP
-end
-
-functor JoinReps (Arg : JOIN_REPS_DOM) :>
- OPEN_REP
- where type ('a, 'x) t = ('a, ('a, 'x) Arg.Inner.t) Arg.Outer.t
- where type ('a, 'x) s = ('a, ('a, 'x) Arg.Inner.s) Arg.Outer.s
- where type ('a,'k,'x) p = ('a,'k,('a,'k,'x) Arg.Inner.p) Arg.Outer.p =
-struct
- open Arg
-
- type ('a, 'x) t = ('a, ('a, 'x) Inner.t) Outer.t
- type ('a, 'x) s = ('a, ('a, 'x) Inner.s) Outer.s
- type ('a, 'k, 'x) p = ('a, 'k, ('a, 'k, 'x) Inner.p) Outer.p
-
- fun getT ? = Inner.getT (Outer.getT ?)
- fun getS ? = Inner.getS (Outer.getS ?)
- fun getP ? = Inner.getP (Outer.getP ?)
-
- fun mapT ? = Outer.mapT (Inner.mapT ?)
- fun mapS ? = Outer.mapS (Inner.mapS ?)
- fun mapP ? = Outer.mapP (Inner.mapP ?)
-end
-
functor LayerRep (Arg : LAYER_REP_DOM) :>
LAYERED_REP
where type 'a Closed.t = 'a Arg.Closed.t
@@ -56,8 +30,15 @@
val mapS = Pair.mapSnd
val mapP = Pair.mapSnd
end
- structure Result = JoinReps (structure Outer=Outer and Inner=Inner)
- open Result
+ type ('a, 'x) t = ('a, ('a, 'x) Inner.t) Outer.t
+ type ('a, 'x) s = ('a, ('a, 'x) Inner.s) Outer.s
+ type ('a, 'k, 'x) p = ('a, 'k, ('a, 'k, 'x) Inner.p) Outer.p
+ fun getT ? = Inner.getT (Outer.getT ?)
+ fun getS ? = Inner.getS (Outer.getS ?)
+ fun getP ? = Inner.getP (Outer.getP ?)
+ fun mapT ? = Outer.mapT (Inner.mapT ?)
+ fun mapS ? = Outer.mapS (Inner.mapS ?)
+ fun mapP ? = Outer.mapP (Inner.mapP ?)
structure This = struct
fun getT ? = Pair.fst (Outer.getT ?)
fun getS ? = Pair.fst (Outer.getS ?)
@@ -123,7 +104,6 @@
fun largeReal ? = op0t Outer.largeReal Arg.largeReal ?
fun largeWord ? = op0t Outer.largeWord Arg.largeWord ?
fun word8 ? = op0t Outer.word8 Arg.word8 ?
-(* val word16 ? = op0t Outer.word16 Arg.word16 ? (* Word16 not provided by SML/NJ *) *)
fun word32 ? = op0t Outer.word32 Arg.word32 ?
fun word64 ? = op0t Outer.word64 Arg.word64 ?
fun list ? = op1t Outer.list Arg.list ?
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-08-08 08:35:36 UTC (rev 5834)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-08-08 17:25:24 UTC (rev 5835)
@@ -4,12 +4,8 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-(** == Exported Signatures == *)
+(** == Abstract Signatures == *)
-signature GENERICS = GENERICS
-
-signature GENERICS_UTIL = GENERICS_UTIL
-
signature CLOSED_CASES = CLOSED_CASES
signature CLOSED_REP = CLOSED_REP
@@ -19,54 +15,18 @@
signature LAYERED_REP = LAYERED_REP
signature GENERIC = GENERIC
-signature GENERIC_EXTRA = GENERIC_EXTRA
-(** === Value Signatures === *)
+(** == Auxiliary Modules == *)
-signature ARBITRARY = ARBITRARY
-signature ARBITRARY_CASES = ARBITRARY_CASES
-
-signature DATA_REC_INFO = DATA_REC_INFO
-signature DATA_REC_INFO_CASES = DATA_REC_INFO_CASES
-
-signature DYNAMIC = DYNAMIC
-signature DYNAMIC_CASES = DYNAMIC_CASES
-
-signature EQ = EQ
-signature EQ_CASES = EQ_CASES
-
-signature HASH = HASH
-signature HASH_CASES = HASH_CASES
-
-signature ORD = ORD
-signature ORD_CASES = ORD_CASES
-
-signature PICKLE = PICKLE
-signature PICKLE_CASES = PICKLE_CASES
-
-signature PRETTY = PRETTY
-signature PRETTY_CASES = PRETTY_CASES
-
-signature REDUCE = REDUCE
-signature REDUCE_CASES = REDUCE_CASES
-
-signature SOME = SOME
-signature SOME_CASES = SOME_CASES
-
-signature TRANSFORM = TRANSFORM
-signature TRANSFORM_CASES = TRANSFORM_CASES
-
-signature TYPE_INFO = TYPE_INFO
-signature TYPE_INFO_CASES = TYPE_INFO_CASES
-
-(** == Exported Structures == *)
-
+signature GENERICS = GENERICS
structure Generics : GENERICS = Generics
+
+signature GENERICS_UTIL = GENERICS_UTIL
structure GenericsUtil : GENERICS_UTIL = GenericsUtil
structure RootGeneric : OPEN_CASES = RootGeneric
-(** == Exported Functors == *)
+(** == Framework Functors == *)
functor CloseCases (Arg : OPEN_CASES) :
CLOSED_CASES
@@ -74,7 +34,7 @@
where type 'a Rep.s = ('a, Unit.t) Arg.Rep.s
where type ('a, 'k) Rep.p = ('a, 'k, Unit.t) Arg.Rep.p =
CloseCases (Arg)
-(** Closes an open generic. *)
+(** Closes open structural cases. *)
signature LAYER_REP_DOM = LAYER_REP_DOM
@@ -89,8 +49,7 @@
where type ('a, 'k, 'x) Outer.p = ('a, 'k, 'x) Arg.Outer.p =
LayerRep (Arg)
(**
- * Creates a layered representation for {LayerGeneric} and
- * {LayerDepGeneric}.
+ * Creates a layered representation for {LayerCases} and {LayerDepCases}.
*)
signature LAYER_CASES_DOM = LAYER_CASES_DOM
@@ -118,6 +77,7 @@
* depends on the outer generic.
*)
+signature GENERIC_EXTRA = GENERIC_EXTRA
functor WithExtra (Arg : GENERIC) : GENERIC_EXTRA = WithExtra (Arg)
(**
* Implements a number of frequently used type representations for
@@ -126,12 +86,10 @@
* is likely to grow over time.
*)
-(** === Value Functors === *)
+(** == Auxiliary Generics == *)
-signature WITH_ARBITRARY_DOM = WITH_ARBITRARY_DOM
-functor WithArbitrary (Arg : WITH_ARBITRARY_DOM) : ARBITRARY_CASES =
- WithArbitrary (Arg)
-
+signature DATA_REC_INFO = DATA_REC_INFO
+signature DATA_REC_INFO_CASES = DATA_REC_INFO_CASES
functor WithDataRecInfo (Arg : OPEN_CASES) : DATA_REC_INFO_CASES =
WithDataRecInfo (Arg)
@@ -143,27 +101,53 @@
* - exception constructors are globally unique.
*)
+signature TYPE_INFO = TYPE_INFO
+signature TYPE_INFO_CASES = TYPE_INFO_CASES
+functor WithTypeInfo (Arg : OPEN_CASES) : TYPE_INFO_CASES = WithTypeInfo (Arg)
+
+(** == Generics == *)
+
+signature ARBITRARY = ARBITRARY
+signature ARBITRARY_CASES = ARBITRARY_CASES
+signature WITH_ARBITRARY_DOM = WITH_ARBITRARY_DOM
+functor WithArbitrary (Arg : WITH_ARBITRARY_DOM) : ARBITRARY_CASES =
+ WithArbitrary (Arg)
+
+signature DYNAMIC = DYNAMIC
+signature DYNAMIC_CASES = DYNAMIC_CASES
functor WithDynamic (Arg : OPEN_CASES) : DYNAMIC_CASES = WithDynamic (Arg)
+signature EQ = EQ
+signature EQ_CASES = EQ_CASES
functor WithEq (Arg : OPEN_CASES) : EQ_CASES = WithEq (Arg)
+signature HASH = HASH
+signature HASH_CASES = HASH_CASES
signature WITH_HASH_DOM = WITH_HASH_DOM
functor WithHash (Arg : WITH_HASH_DOM) : HASH_CASES = WithHash (Arg)
+signature ORD = ORD
+signature ORD_CASES = ORD_CASES
functor WithOrd (Arg : OPEN_CASES) : ORD_CASES = WithOrd (Arg)
+signature PICKLE = PICKLE
+signature PICKLE_CASES = PICKLE_CASES
signature WITH_PICKLE_DOM = WITH_PICKLE_DOM
functor WithPickle (Arg : WITH_PICKLE_DOM) : PICKLE_CASES = WithPickle (Arg)
+signature PRETTY = PRETTY
+signature PRETTY_CASES = PRETTY_CASES
functor WithPretty (Arg : OPEN_CASES) : PRETTY_CASES = WithPretty (Arg)
+signature REDUCE = REDUCE
+signature REDUCE_CASES = REDUCE_CASES
functor WithReduce (Arg : OPEN_CASES) : REDUCE_CASES = WithReduce (Arg)
+signature SOME = SOME
+signature SOME_CASES = SOME_CASES
signature WITH_SOME_DOM = WITH_SOME_DOM
functor WithSome (Arg : WITH_SOME_DOM) : SOME_CASES = WithSome (Arg)
-functor WithTransform (Arg : OPEN_CASES) : TRANSFORM_CASES =
- WithTransform (Arg)
-
-functor WithTypeInfo (Arg : OPEN_CASES) : TYPE_INFO_CASES =
- WithTypeInfo (Arg)
+signature TRANSFORM = TRANSFORM
+signature TRANSFORM_CASES = TRANSFORM_CASES
+functor WithTransform (Arg : OPEN_CASES) : TRANSFORM_CASES = WithTransform (Arg)
More information about the MLton-commit
mailing list