[MLton-commit] r5638
Vesa Karvonen
vesak at mlton.org
Sun Jun 17 05:31:23 PDT 2007
Smarter layering of generics.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
U mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
A mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-generic-fun.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-rep-fun.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/layered-generic-rep.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-06-17 12:31:21 UTC (rev 5638)
@@ -4,85 +4,140 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-signature LAYER_GENERIC_REP_DOM = sig
- structure Outer : OPEN_GENERIC_REP
- structure Rep : CLOSED_GENERIC_REP
-end
+functor LayerGenericRep (Arg : LAYER_GENERIC_REP_DOM) :>
+ LAYERED_GENERIC_REP
+ where type 'a Closed.t = 'a Arg.Closed.t
+ where type 'a Closed.s = 'a Arg.Closed.s
+ where type ('a, 'k) Closed.p = ('a, 'k) Arg.Closed.p
-functor LayerGenericRep (Arg : LAYER_GENERIC_REP_DOM) :
- OPENED_GENERIC_REP
- where type 'a This.Closed.t = 'a Arg.Rep.t
- where type 'a This.Closed.s = 'a Arg.Rep.s
- where type ('a, 'k) This.Closed.p = ('a, 'k) Arg.Rep.p =
+ where type ('a, 'x) Outer.t = ('a, 'x) Arg.Outer.t
+ where type ('a, 'x) Outer.s = ('a, 'x) Arg.Outer.s
+ where type ('a, 'k, 'x) Outer.p = ('a, 'k, 'x) Arg.Outer.p =
struct
- structure Inner = OpenGenericRep (Arg.Rep)
- structure Joined = JoinGenericReps (open Arg structure Inner = Inner)
- open Joined
+ open Arg
+ structure Inner = struct
+ type ('a, 'x) t = 'a Closed.t * 'x
+ type ('a, 'x) s = 'a Closed.s * 'x
+ type ('a, 'k, 'x) p = ('a, 'k) Closed.p * 'x
+ val mkT = Fn.id
+ val mkS = Fn.id
+ val mkP = Fn.id
+ val mkY = Tie.tuple2
+ val getT = Pair.snd
+ val getS = Pair.snd
+ val getP = Pair.snd
+ val mapT = Pair.mapSnd
+ val mapS = Pair.mapSnd
+ val mapP = Pair.mapSnd
+ end
+ 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
- structure Rep = Joined
- structure Closed = Arg.Rep
- fun getT ? = Inner.This.getT (Arg.Outer.getT ?)
- fun getS ? = Inner.This.getS (Arg.Outer.getS ?)
- fun getP ? = Inner.This.getP (Arg.Outer.getP ?)
- fun mapT ? = Arg.Outer.mapT (Inner.This.mapT ?)
- fun mapS ? = Arg.Outer.mapS (Inner.This.mapS ?)
- fun mapP ? = Arg.Outer.mapP (Inner.This.mapP ?)
+ fun getT ? = Pair.fst (Outer.getT ?)
+ fun getS ? = Pair.fst (Outer.getS ?)
+ fun getP ? = Pair.fst (Outer.getP ?)
+ fun mapT ? = Outer.mapT (Pair.mapFst ?)
+ fun mapS ? = Outer.mapS (Pair.mapFst ?)
+ fun mapP ? = Outer.mapP (Pair.mapFst ?)
end
end
-functor LayerGeneric (Arg : LAYER_GENERIC_DOM) :
+functor LayerDepGeneric (Arg : LAYER_DEP_GENERIC_DOM) :>
OPEN_GENERIC
- where type ('a, 'x) Rep.t = ('a, 'x) Arg.Result.t
- where type ('a, 'x) Rep.s = ('a, 'x) Arg.Result.s
+ where type ('a, 'x) Rep.t = ('a, 'x) Arg.Result.t
+ where type ('a, 'x) Rep.s = ('a, 'x) Arg.Result.s
where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.Result.p =
struct
- fun op0 outer this x = outer (this, x)
- fun op1 outer this x2y a = outer (fn (_, x) => (this a, x2y x)) a
- fun op2 outer this xy2z ab =
- outer (fn ((_, x), (_, y)) => (this ab, xy2z (x, y))) ab
- fun morph outer this f b = outer (fn (_, y) => fn i => (this b i, f y i)) b
- val t = op1
+ structure Rep = Arg.Result
+
+ structure Inner = Arg.Result.Inner
+ structure Outer = Arg.Outer
+
+ fun op1 mk get outer this x2y a = outer (fn x => mk (this a, x2y (get x))) a
+ fun op2 mk getx gety outer this xy2z ab =
+ outer (fn (x, y) => mk (this ab, xy2z (getx x, gety y))) ab
+ fun m mk get outer this f b =
+ outer (fn y => fn i => mk (this b i, f (get y) i)) b
+
+ fun op0t outer this x = outer (Inner.mkT (this, x))
+ fun op1t ? = op1 Inner.mkT Inner.getT ?
+ fun t ? = op1 Inner.mkP Inner.getT ?
fun r outer this lx2y l a =
- outer (fn l => fn (_, x) => (this l a, lx2y l x)) l a
- fun c0 outer l2s l2x = outer (Pair.map (l2s, l2x) o Sq.mk)
- val c1 = r
- fun y outer x y = outer (Tie.tuple2 (x, y))
+ outer (fn l => fn x => Inner.mkP (this l a, lx2y l (Inner.getT x))) l a
+ fun p ? = op1 Inner.mkT Inner.getP ?
+ fun s ? = op1 Inner.mkT Inner.getS ?
+ fun c0 outer l2s l2x = outer (Inner.mkS o Pair.map (l2s, l2x) o Sq.mk)
+ fun c1 outer this cx2y c a =
+ outer (fn c => fn x => Inner.mkS (this c a, cx2y c (Inner.getT x))) c a
+ fun y outer x y = outer (Inner.mkY (x, y))
fun re outer this ex a =
- outer (fn (_, x) => fn e => (this a e : Unit.t ; ex x e : Unit.t)) a
- structure Rep = Arg.Result
- fun iso ? = morph Arg.Outer.iso Arg.iso ?
- fun isoProduct ? = morph Arg.Outer.isoProduct Arg.isoProduct ?
- fun isoSum ? = morph Arg.Outer.isoSum Arg.isoSum ?
- fun op *` ? = op2 Arg.Outer.*` Arg.*` ?
- fun T ? = t Arg.Outer.T Arg.T ?
- fun R ? = r Arg.Outer.R Arg.R ?
- fun tuple ? = op1 Arg.Outer.tuple Arg.tuple ?
- fun record ? = op1 Arg.Outer.record Arg.record ?
- fun op +` ? = op2 Arg.Outer.+` Arg.+` ?
- fun C0 ? = c0 Arg.Outer.C0 Arg.C0 ?
- fun C1 ? = c1 Arg.Outer.C1 Arg.C1 ?
- fun data ? = op1 Arg.Outer.data Arg.data ?
- fun unit ? = op0 Arg.Outer.unit Arg.unit ?
- fun Y ? = y Arg.Outer.Y Arg.Y ?
- fun op --> ? = op2 Arg.Outer.--> Arg.--> ?
- fun exn ? = op0 Arg.Outer.exn Arg.exn ?
- fun regExn ? = re Arg.Outer.regExn Arg.regExn ?
- fun array ? = op1 Arg.Outer.array Arg.array ?
- fun refc ? = op1 Arg.Outer.refc Arg.refc ?
- fun vector ? = op1 Arg.Outer.vector Arg.vector ?
- fun largeInt ? = op0 Arg.Outer.largeInt Arg.largeInt ?
- fun largeReal ? = op0 Arg.Outer.largeReal Arg.largeReal ?
- fun largeWord ? = op0 Arg.Outer.largeWord Arg.largeWord ?
- fun word8 ? = op0 Arg.Outer.word8 Arg.word8 ?
-(* val word16 ? = op0 Arg.Outer.word16 Arg.word16 ?
- (* Word16 not provided by SML/NJ *) *)
- fun word32 ? = op0 Arg.Outer.word32 Arg.word32 ?
- fun word64 ? = op0 Arg.Outer.word64 Arg.word64 ?
- fun list ? = op1 Arg.Outer.list Arg.list ?
- fun bool ? = op0 Arg.Outer.bool Arg.bool ?
- fun char ? = op0 Arg.Outer.char Arg.char ?
- fun int ? = op0 Arg.Outer.int Arg.int ?
- fun real ? = op0 Arg.Outer.real Arg.real ?
- fun string ? = op0 Arg.Outer.string Arg.string ?
- fun word ? = op0 Arg.Outer.word Arg.word ?
+ outer (fn x => fn e => (this a e : Unit.t ; ex (Inner.getS x) e : Unit.t)) a
+
+ fun iso ? = m Inner.mkT Inner.getT Outer.iso Arg.iso ?
+ fun isoProduct ? = m Inner.mkP Inner.getP Outer.isoProduct Arg.isoProduct ?
+ fun isoSum ? = m Inner.mkS Inner.getS Outer.isoSum Arg.isoSum ?
+ fun op *` ? = op2 Inner.mkP Inner.getP Inner.getP Outer.*` Arg.*` ?
+ fun T ? = t Outer.T Arg.T ?
+ fun R ? = r Outer.R Arg.R ?
+ fun tuple ? = p Outer.tuple Arg.tuple ?
+ fun record ? = p Outer.record Arg.record ?
+ fun op +` ? = op2 Inner.mkS Inner.getS Inner.getS Outer.+` Arg.+` ?
+ fun C0 ? = c0 Outer.C0 Arg.C0 ?
+ fun C1 ? = c1 Outer.C1 Arg.C1 ?
+ fun data ? = s Outer.data Arg.data ?
+ fun unit ? = op0t Outer.unit Arg.unit ?
+ fun Y ? = y Outer.Y Arg.Y ?
+ fun op --> ? = op2 Inner.mkT Inner.getT Inner.getT Outer.--> Arg.--> ?
+ fun exn ? = op0t Outer.exn Arg.exn ?
+ fun regExn ? = re Outer.regExn Arg.regExn ?
+ fun array ? = op1t Outer.array Arg.array ?
+ fun refc ? = op1t Outer.refc Arg.refc ?
+ fun vector ? = op1t Outer.vector Arg.vector ?
+ fun largeInt ? = op0t Outer.largeInt Arg.largeInt ?
+ 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 ?
+ fun bool ? = op0t Outer.bool Arg.bool ?
+ fun char ? = op0t Outer.char Arg.char ?
+ fun int ? = op0t Outer.int Arg.int ?
+ fun real ? = op0t Outer.real Arg.real ?
+ fun string ? = op0t Outer.string Arg.string ?
+ fun word ? = op0t Outer.word Arg.word ?
end
+
+functor LayerGeneric (Arg : LAYER_GENERIC_DOM) :>
+ OPEN_GENERIC
+ where type ('a, 'x) Rep.t = ('a, 'x) Arg.Result.t
+ where type ('a, 'x) Rep.s = ('a, 'x) Arg.Result.s
+ where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.Result.p =
+ LayerDepGeneric
+ (open Arg Arg.Result.This
+ fun iso b = Arg.iso (getT b)
+ fun isoProduct b = Arg.isoProduct (getP b)
+ fun isoSum b = Arg.isoSum (getS b)
+ fun op2 geta getb this = this o Pair.map (geta, getb)
+ fun op *` ? = op2 getP getP Arg.*` ?
+ fun op +` ? = op2 getS getS Arg.+` ?
+ fun op --> ? = op2 getT getT Arg.--> ?
+ fun array a = Arg.array (getT a)
+ fun vector a = Arg.vector (getT a)
+ fun list a = Arg.list (getT a)
+ fun refc a = Arg.refc (getT a)
+ fun T a = Arg.T (getT a)
+ fun R l a = Arg.R l (getT a)
+ fun tuple a = Arg.tuple (getP a)
+ fun record a = Arg.record (getP a)
+ fun C1 c a = Arg.C1 c (getT a)
+ fun data a = Arg.data (getS a)
+ fun regExn a e = Arg.regExn (getS a) e)
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-06-17 12:31:21 UTC (rev 5638)
@@ -29,9 +29,9 @@
datatype 'a t = IN of {gen : 'a G.t, cog : 'a -> Univ.t G.t UnOp.t}
fun out (IN r) = r
- structure Closed = MkClosedGenericRep (type 'a t = 'a t)
structure Arbitrary =
- LayerGenericRep (structure Outer = Arg.Rep and Rep = Closed)
+ LayerGenericRep (structure Outer = Arg.Rep
+ structure Closed = MkClosedGenericRep (type 'a t = 'a t))
open Arbitrary.This
@@ -41,8 +41,8 @@
fun arbitrary ? = #gen (out (getT ?))
fun withGen gen = mapT (fn IN {cog, ...} => IN {gen = gen, cog = cog})
- structure Layered = LayerGeneric
- (structure Rep = Closed and Outer = Arg and Result = Arbitrary
+ structure Layered = LayerDepGeneric
+ (structure Outer = Arg and Result = Arbitrary
fun iso' (IN {gen, cog}) (a2b, b2a) =
IN {gen = map b2a gen, cog = cog o a2b}
fun iso ? = iso' (getT ?)
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2007-06-17 12:31:21 UTC (rev 5638)
@@ -20,8 +20,6 @@
infixr 0 -->
(* SML/NJ workaround --> *)
- open GenericsUtil
-
structure W = Word
type 'a t = 'a -> {maxWidth : Int.t, maxDepth : Int.t} -> Word.t UnOp.t
@@ -36,14 +34,16 @@
fun lift toWord a _ r = r * 0w19 + toWord a
end
- structure Closed = MkClosedGenericRep (type 'a t = 'a t)
- structure Hash = LayerGenericRep (structure Outer = Arg.Rep and Rep = Closed)
+ structure Hash =
+ LayerGenericRep (structure Outer = Arg.Rep
+ structure Closed = MkClosedGenericRep (type 'a t = 'a t))
+
open Hash.This
fun hash t v = getT t v {maxWidth = 200, maxDepth = 10} 0wx2CA4B13
- structure Layered = LayerGeneric
- (structure Rep = Closed and Outer = Arg and Result = Hash
+ structure Layered = LayerDepGeneric
+ (structure Outer = Arg and Result = Hash
fun iso' bH (a2b, _) = bH o a2b
fun iso ? = iso' (getT ?)
fun isoProduct ? = iso' (getP ?)
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-17 12:31:21 UTC (rev 5638)
@@ -52,7 +52,10 @@
public/join-generics-fun.sig
detail/join-generics.fun
+ public/layered-generic-rep.sig
+ public/layer-dep-generic-fun.sig
public/layer-generic-fun.sig
+ public/layer-generic-rep-fun.sig
detail/layer-generic.fun
(* Values *)
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-17 12:31:21 UTC (rev 5638)
@@ -16,6 +16,8 @@
signature OPEN_GENERIC = OPEN_GENERIC
signature OPEN_GENERIC_REP = OPEN_GENERIC_REP
+signature LAYERED_GENERIC_REP = LAYERED_GENERIC_REP
+
signature GENERIC = GENERIC
signature GENERIC_EXTRA = GENERIC_EXTRA
@@ -83,6 +85,23 @@
* representation of the {Outer} generic.
*)
+signature LAYER_GENERIC_REP_DOM = LAYER_GENERIC_REP_DOM
+
+functor LayerGenericRep (Arg : LAYER_GENERIC_REP_DOM) :>
+ LAYERED_GENERIC_REP
+ where type 'a Closed.t = 'a Arg.Closed.t
+ where type 'a Closed.s = 'a Arg.Closed.s
+ where type ('a, 'k) Closed.p = ('a, 'k) Arg.Closed.p
+
+ where type ('a, 'x) Outer.t = ('a, 'x) Arg.Outer.t
+ where type ('a, 'x) Outer.s = ('a, 'x) Arg.Outer.s
+ where type ('a, 'k, 'x) Outer.p = ('a, 'k, 'x) Arg.Outer.p =
+ LayerGenericRep (Arg)
+(**
+ * Creates a layered representation for {LayerGeneric} and
+ * {LayerDepGeneric}.
+ *)
+
signature LAYER_GENERIC_DOM = LAYER_GENERIC_DOM
functor LayerGeneric (Arg : LAYER_GENERIC_DOM) :
@@ -92,8 +111,20 @@
where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.Result.p =
LayerGeneric (Arg)
(**
+ * Joins an outer open generic function and a closed generic function.
+ *)
+
+signature LAYER_DEP_GENERIC_DOM = LAYER_DEP_GENERIC_DOM
+
+functor LayerDepGeneric (Arg : LAYER_DEP_GENERIC_DOM) :>
+ OPEN_GENERIC
+ where type ('a, 'x) Rep.t = ('a, 'x) Arg.Result.t
+ where type ('a, 'x) Rep.s = ('a, 'x) Arg.Result.s
+ where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.Result.p =
+ LayerDepGeneric (Arg)
+(**
* Joins an outer open generic function and a closed generic function that
- * depends on the outer generic function.
+ * depends on the outer generic.
*)
functor WithExtra (Arg : GENERIC) : GENERIC_EXTRA = WithExtra (Arg)
Added: mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-generic-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-generic-fun.sig 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-generic-fun.sig 2007-06-17 12:31:21 UTC (rev 5638)
@@ -0,0 +1,48 @@
+(* 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 domain of the {LayerDepGeneric} functor.
+ *)
+signature LAYER_DEP_GENERIC_DOM = sig
+ structure Outer : OPEN_GENERIC
+ structure Result : LAYERED_GENERIC_REP
+ sharing Outer.Rep = Result.Outer
+ val iso : ('b, 'y) Result.t -> ('a, 'b) Iso.t -> 'a Result.Closed.t
+ val isoProduct : ('b, 'k, 'y) Result.p -> ('a, 'b) Iso.t -> ('a, 'k) Result.Closed.p
+ val isoSum : ('b, 'y) Result.s -> ('a, 'b) Iso.t -> 'a Result.Closed.s
+ val *` : ('a, 'k, 'x) Result.p * ('b, 'k, 'y) Result.p -> (('a, 'b) Product.t, 'k) Result.Closed.p
+ val T : ('a, 'x) Result.t -> ('a, Generics.Tuple.t) Result.Closed.p
+ val R : Generics.Label.t -> ('a, 'x) Result.t -> ('a, Generics.Record.t) Result.Closed.p
+ val tuple : ('a, Generics.Tuple.t, 'x) Result.p -> 'a Result.Closed.t
+ val record : ('a, Generics.Record.t, 'x) Result.p -> 'a Result.Closed.t
+ val +` : ('a, 'x) Result.s * ('b, 'y) Result.s -> (('a, 'b) Sum.t) Result.Closed.s
+ val C0 : Generics.Con.t -> Unit.t Result.Closed.s
+ val C1 : Generics.Con.t -> ('a, 'x) Result.t -> 'a Result.Closed.s
+ val data : ('a, 'x) Result.s -> 'a Result.Closed.t
+ val unit : Unit.t Result.Closed.t
+ val Y : 'a Result.Closed.t Tie.t
+ val --> : ('a, 'x) Result.t * ('b, 'y) Result.t -> ('a -> 'b) Result.Closed.t
+ val exn : Exn.t Result.Closed.t
+ val regExn : ('a, 'x) Result.s -> ('a, Exn.t) Emb.t Effect.t
+ val array : ('a, 'x) Result.t -> 'a Array.t Result.Closed.t
+ val refc : ('a, 'x) Result.t -> 'a Ref.t Result.Closed.t
+ val vector : ('a, 'x) Result.t -> 'a Vector.t Result.Closed.t
+ val largeInt : LargeInt.t Result.Closed.t
+ val largeReal : LargeReal.t Result.Closed.t
+ val largeWord : LargeWord.t Result.Closed.t
+ val word8 : Word8.t Result.Closed.t
+(* val word16 : Word16.t Result.Closed.t (* Word16 not provided by SML/NJ *) *)
+ val word32 : Word32.t Result.Closed.t
+ val word64 : Word64.t Result.Closed.t
+ val list : ('a, 'x) Result.t -> 'a List.t Result.Closed.t
+ val bool : Bool.t Result.Closed.t
+ val char : Char.t Result.Closed.t
+ val int : Int.t Result.Closed.t
+ val real : Real.t Result.Closed.t
+ val string : String.t Result.Closed.t
+ val word : Word.t Result.Closed.t
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-generic-fun.sig
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig 2007-06-17 12:31:21 UTC (rev 5638)
@@ -9,43 +9,8 @@
*)
signature LAYER_GENERIC_DOM = sig
structure Outer : OPEN_GENERIC
- structure Rep : CLOSED_GENERIC_REP
- structure Result : OPEN_GENERIC_REP
- where type ('a, 'x) t = ('a, 'a Rep.t * 'x) Outer.Rep.t
- where type ('a, 'x) s = ('a, 'a Rep.s * 'x) Outer.Rep.s
- where type ('a, 'k, 'x) p = ('a, 'k, ('a, 'k) Rep.p * 'x) Outer.Rep.p
- val iso : ('b, 'y) Result.t -> ('a, 'b) Iso.t -> 'a Rep.t
- val isoProduct : ('b, 'k, 'y) Result.p -> ('a, 'b) Iso.t -> ('a, 'k) Rep.p
- val isoSum : ('b, 'y) Result.s -> ('a, 'b) Iso.t -> 'a Rep.s
- val *` : ('a, 'k, 'x) Result.p * ('b, 'k, 'y) Result.p -> (('a, 'b) Product.t, 'k) Rep.p
- val T : ('a, 'x) Result.t -> ('a, Generics.Tuple.t) Rep.p
- val R : Generics.Label.t -> ('a, 'x) Result.t -> ('a, Generics.Record.t) Rep.p
- val tuple : ('a, Generics.Tuple.t, 'x) Result.p -> 'a Rep.t
- val record : ('a, Generics.Record.t, 'x) Result.p -> 'a Rep.t
- val +` : ('a, 'x) Result.s * ('b, 'y) Result.s -> (('a, 'b) Sum.t) Rep.s
- val C0 : Generics.Con.t -> Unit.t Rep.s
- val C1 : Generics.Con.t -> ('a, 'x) Result.t -> 'a Rep.s
- val data : ('a, 'x) Result.s -> 'a Rep.t
- val unit : Unit.t Rep.t
- val Y : 'a Rep.t Tie.t
- val --> : ('a, 'x) Result.t * ('b, 'y) Result.t -> ('a -> 'b) Rep.t
- val exn : Exn.t Rep.t
- val regExn : ('a, 'x) Result.s -> ('a, Exn.t) Emb.t Effect.t
- val array : ('a, 'x) Result.t -> 'a Array.t Rep.t
- val refc : ('a, 'x) Result.t -> 'a Ref.t Rep.t
- val vector : ('a, 'x) Result.t -> 'a Vector.t Rep.t
- val largeInt : LargeInt.t Rep.t
- val largeReal : LargeReal.t Rep.t
- val largeWord : LargeWord.t Rep.t
- 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
- val list : ('a, 'x) Result.t -> 'a List.t Rep.t
- 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
+ structure Result : LAYERED_GENERIC_REP
+ sharing Outer.Rep = Result.Outer
+ include CLOSED_GENERIC
+ sharing Rep = Result.Closed
end
Added: mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-rep-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-rep-fun.sig 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-rep-fun.sig 2007-06-17 12:31:21 UTC (rev 5638)
@@ -0,0 +1,10 @@
+(* 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 LAYER_GENERIC_REP_DOM = sig
+ structure Outer : OPEN_GENERIC_REP
+ structure Closed : CLOSED_GENERIC_REP
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-rep-fun.sig
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/com/ssh/generic/unstable/public/layered-generic-rep.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layered-generic-rep.sig 2007-06-17 09:22:55 UTC (rev 5637)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layered-generic-rep.sig 2007-06-17 12:31:21 UTC (rev 5638)
@@ -0,0 +1,34 @@
+(* 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 layered representation types of generic values.
+ *)
+signature LAYERED_GENERIC_REP = sig
+ structure Outer : OPEN_GENERIC_REP
+ structure Closed : CLOSED_GENERIC_REP
+ structure Inner : sig
+ include OPEN_GENERIC_REP
+ val mkT : 'a Closed.t * 'x -> ('a, 'x) t
+ val mkS : 'a Closed.s * 'x -> ('a, 'x) s
+ val mkP : ('a, 'k) Closed.p * 'x -> ('a, 'k, 'x) p
+
+ val mkY : 'a Closed.t Tie.t * 'x Tie.t -> ('a, 'x) t Tie.t
+ end
+ include OPEN_GENERIC_REP
+ where type ('a, 'x) t = ('a, ('a, 'x) Inner.t) Outer.t
+ where type ('a, 'x) s = ('a, ('a, 'x) Inner.s) Outer.s
+ where type ('a, 'k, 'x) p = ('a, 'k, ('a, 'k, 'x) Inner.p) Outer.p
+ structure This : sig
+ val getT : ('a, 'x) t -> 'a Closed.t
+ val getS : ('a, 'x) s -> 'a Closed.s
+ val getP : ('a, 'k, 'x) p -> ('a, 'k) Closed.p
+
+ val mapT : 'a Closed.t UnOp.t -> ('a, 'x) t UnOp.t
+ val mapS : 'a Closed.s UnOp.t -> ('a, 'x) s UnOp.t
+ val mapP : ('a, 'k) Closed.p UnOp.t -> ('a, 'k, 'x) p UnOp.t
+ end
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/layered-generic-rep.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list