[MLton-commit] r5637
Vesa Karvonen
vesak at mlton.org
Sun Jun 17 02:22:58 PDT 2007
Towards simpler layering of generics using functors.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
U mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun
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/hash.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
U mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
U mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -13,18 +13,6 @@
fun failCat ss = fail (concat ss)
fun failExn e = failCat ["unregistered exn ", `e]
fun failExnSq (l, r) = failCat ["unregistered exns ", `l, " and ", `r]
-
- fun op0 outer t x = outer (t, x)
- fun op1 outer f g = outer (Pair.map (f, g))
- fun op2 outer f g = outer (Pair.map (f, g) o Pair.swizzle)
- val t = op1
- fun r outer lt2p lx2y = outer (Pair.map o Pair.map (lt2p, lx2y) o Sq.mk)
- 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))
- fun morph outer iso' f = outer (fn (a, x) => fn i => (iso' a i, f x i))
- fun re outer ex ey =
- outer (fn (x, y) => fn e => (ex x e : Unit.t ; ey y e : Unit.t))
end
functor MkClosedGenericRep (type 'a t) : CLOSED_GENERIC_REP = struct
Added: mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-06-17 09:22:55 UTC (rev 5637)
@@ -0,0 +1,88 @@
+(* 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 Rep : CLOSED_GENERIC_REP
+end
+
+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 =
+struct
+ structure Inner = OpenGenericRep (Arg.Rep)
+ structure Joined = JoinGenericReps (open Arg structure Inner = Inner)
+ open Joined
+ 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 ?)
+ end
+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 =
+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
+ 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))
+ 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 ?
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
___________________________________________________________________
Name: svn:eol-style
+ native
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-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-06-17 09:22:55 UTC (rev 5637)
@@ -15,6 +15,7 @@
../../../public/generics-util.sig
../../../public/generics.sig
../../../public/join-generics-fun.sig
+ ../../../public/layer-generic-fun.sig
../../../public/open-generic-rep.sig
../../../public/open-generic.sig
../../../public/value/arbitrary.sig
@@ -29,6 +30,7 @@
../../generics-util.sml
../../generics.sml
../../join-generics.fun
+ ../../layer-generic.fun
../../open-generic.fun
../../root-generic.sml
../../sml-syntax.sml
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun 2007-06-17 09:22:55 UTC (rev 5637)
@@ -4,62 +4,101 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
+signature THIS_GENERIC_REP = sig
+ structure Rep : OPEN_GENERIC_REP
+ structure Closed : CLOSED_GENERIC_REP
+ val getT : ('a, 'x) Rep.t -> 'a Closed.t
+ val getS : ('a, 'x) Rep.s -> 'a Closed.s
+ val getP : ('a, 'k, 'x) Rep.p -> ('a, 'k) Closed.p
+ val mapT : 'a Closed.t UnOp.t -> ('a, 'x) Rep.t UnOp.t
+ val mapS : 'a Closed.s UnOp.t -> ('a, 'x) Rep.s UnOp.t
+ val mapP : ('a, 'k) Closed.p UnOp.t -> ('a, 'k, 'x) Rep.p UnOp.t
+end
+
+signature OPENED_GENERIC_REP = sig
+ include OPEN_GENERIC_REP
+ structure This : THIS_GENERIC_REP
+ sharing type t = This.Rep.t
+ sharing type s = This.Rep.s
+ sharing type p = This.Rep.p
+end
+
functor OpenGenericRep (Arg : CLOSED_GENERIC_REP) :
- OPEN_GENERIC_REP
- where type ('a, 'x) t = 'a Arg.t * 'x
- where type ('a, 'x) s = 'a Arg.s * 'x
- where type ('a, 'k, 'x) p = ('a, 'k) Arg.p * 'x =
+ OPENED_GENERIC_REP
+ where type 'a This.Closed.t = 'a Arg.t
+ where type 'a This.Closed.s = 'a Arg.s
+ where type ('a, 'k) This.Closed.p = ('a, 'k) Arg.p =
struct
- val get = Pair.snd
- fun map f = Pair.map (Fn.id, f)
+ structure This = struct
+ structure Rep = struct
+ type ('a, 'x) t = 'a Arg.t * 'x
+ type ('a, 'x) s = 'a Arg.s * 'x
+ type ('a, 'k, 'x) p = ('a, 'k) Arg.p * 'x
+ 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
+ structure Closed = Arg
+ val getT = Pair.fst
+ val getS = Pair.fst
+ val getP = Pair.fst
+ val mapT = Pair.mapFst
+ val mapS = Pair.mapFst
+ val mapP = Pair.mapFst
+ end
+ open This.Rep
+end
- type ('a, 'x) t = 'a Arg.t * 'x
- val getT = get
- val mapT = map
-
- type ('a, 'x) s = 'a Arg.s * 'x
- val getS = get
- val mapS = map
-
- type ('a, 'k, 'x) p = ('a, 'k) Arg.p * 'x
- val getP = get
- val mapP = map
+signature OPENED_GENERIC = sig
+ include OPEN_GENERIC
+ structure This : THIS_GENERIC_REP
+ sharing Rep = This.Rep
end
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 =
+ OPENED_GENERIC
+ 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 =
struct
(* <-- SML/NJ workaround *)
open TopLevel
(* SML/NJ workaround --> *)
structure Rep = OpenGenericRep (Arg.Rep)
+ structure This = Rep.This
- fun op0 ? = GenericsUtil.op0 id ?
- fun op1 ? = GenericsUtil.op1 id ?
- fun op2 ? = GenericsUtil.op2 id ?
- fun morph ? = GenericsUtil.morph id ?
+ fun op0 t x = (t, x)
+ fun op1 f g = Pair.map (f, g)
+ fun op2 f g = Pair.map (f, g) o Pair.swizzle
+ fun morph iso' f (a, x) i = (iso' a i, f x i)
+ val t = op1
+ fun r lt2p lx2y = Pair.map o Pair.map (lt2p, lx2y) o Sq.mk
+ fun c0 l2s l2x = Pair.map (l2s, l2x) o Sq.mk
+ val c1 = r
+ fun y x y = Tie.tuple2 (x, y)
+ fun re ex ey (x, y) e = (ex x e : Unit.t ; ey y e : Unit.t)
fun iso ? = morph Arg.iso ?
fun isoProduct ? = morph Arg.isoProduct ?
fun isoSum ? = morph Arg.isoSum ?
fun op *` ? = op2 Arg.*` ?
- fun T ? = GenericsUtil.t id Arg.T ?
- fun R ? = GenericsUtil.r id Arg.R ?
+ fun T ? = t Arg.T ?
+ fun R ? = r Arg.R ?
fun tuple ? = op1 Arg.tuple ?
fun record ? = op1 Arg.record ?
fun op +` ? = op2 Arg.+` ?
- fun C0 ? = GenericsUtil.c0 id Arg.C0 ?
- fun C1 ? = GenericsUtil.c1 id Arg.C1 ?
+ fun C0 ? = c0 Arg.C0 ?
+ fun C1 ? = c1 Arg.C1 ?
fun data ? = op1 Arg.data ?
fun unit ? = op0 Arg.unit ?
- fun Y ? = GenericsUtil.y id Arg.Y ?
+ fun Y ? = y Arg.Y ?
fun op --> ? = op2 Arg.--> ?
fun exn ? = op0 Arg.exn ?
- fun regExn ? = GenericsUtil.re id Arg.regExn ?
+ fun regExn ? = re Arg.regExn ?
fun array ? = op1 Arg.array ?
fun refc ? = op1 Arg.refc ?
fun vector ? = op1 Arg.vector ?
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -9,8 +9,6 @@
open TopLevel
infix 7 *`
infix 6 +`
- infixr 6 <^> <+>
- infixr 5 <$> <$$> </> <//>
infix 4 <\ \>
infixr 4 </ />
infix 2 >| andAlso
@@ -20,143 +18,107 @@
infixr 0 -->
(* SML/NJ workaround --> *)
- open GenericsUtil
-
structure RandomGen = Arg.RandomGen
structure G = RandomGen and I = Int and R = Real and W = Word
- datatype 'a t = IN of {gen : 'a G.t, cog : 'a -> Univ.t G.t UnOp.t}
- fun out (IN r) = r
-
- structure Rep =
- JoinGenericReps
- (structure Outer = Arg.Rep
- structure Inner =
- OpenGenericRep (MkClosedGenericRep (type 'a t = 'a t)))
-
- 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 Arg.Rep.getT) ?
- fun withGen gen =
- Arg.Rep.mapT
- (Pair.map (fn IN {cog, ...} => IN {gen = gen,cog = cog},
- id))
+ datatype 'a t = IN of {gen : 'a G.t, cog : 'a -> Univ.t G.t UnOp.t}
+ fun out (IN r) = r
- fun iso' (IN {gen, cog}) (a2b, b2a) =
- IN {gen = map b2a gen, cog = cog o a2b}
+ structure Closed = MkClosedGenericRep (type 'a t = 'a t)
+ structure Arbitrary =
+ LayerGenericRep (structure Outer = Arg.Rep and Rep = Closed)
- fun iso ? = morph Arg.iso iso' ?
- fun isoProduct ? = morph Arg.isoProduct iso' ?
- fun isoSum ? = morph Arg.isoSum iso' ?
+ open Arbitrary.This
- val unit' = IN {gen = G.return (), cog = const (G.variant 0)}
- fun unit ? = op0 Arg.unit unit' ?
- fun bool ? = op0 Arg.bool (IN {gen = G.bool, cog = G.variant o Bool.toInt}) ?
+ fun cogS ? = #cog (out (getS ?))
+ fun genS ? = #gen (out (getS ?))
- val int' = IN {gen = map (fn w => W.toIntX (w - G.RNG.maxValue div 0w2))
- (* XXX result may not fit an Int.t *)
- (G.lift G.RNG.value),
- cog = G.variant}
- fun int ? = op0 Arg.int int' ?
+ fun arbitrary ? = #gen (out (getT ?))
+ fun withGen gen = mapT (fn IN {cog, ...} => IN {gen = gen, cog = cog})
- val word' = IN {gen = G.lift G.RNG.value, cog = G.variant o W.toIntX}
- fun word ? = op0 Arg.word word' ?
+ structure Layered = LayerGeneric
+ (structure Rep = Closed and 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 ?)
+ fun isoProduct ? = iso' (getP ?)
+ fun isoSum ? = iso' (getS ?)
+ fun op *`` (IN {gen = aGen, cog = aCog}, IN {gen = bGen, cog = bCog}) =
+ IN {gen = G.Monad.>>& (aGen, bGen), cog = fn a & b => aCog a o bCog b}
+ fun op *` (a, b) = op *`` (getP a, getP b)
+ val T = getT
+ fun R _ = getT
+ val tuple = getP
+ val record = getP
+ fun op +` (aS, bS) = let
+ val aGen = map INL (genS aS)
+ val bGen = map INR (genS bS)
+ val gen = G.frequency [(Arg.numAlts aS, aGen),
+ (Arg.numAlts bS, bGen)]
+ val gen0 =
+ case Arg.hasBaseCase aS & Arg.hasBaseCase bS of
+ true & false => aGen
+ | false & true => bGen
+ | _ => gen
+ in
+ IN {gen = G.sized (fn 0 => gen0 | _ => gen),
+ cog = fn INL a => G.variant 0 o cogS aS a
+ | INR b => G.variant 1 o cogS bS b}
+ end
+ val unit = IN {gen = G.return (), cog = const (G.variant 0)}
+ fun C0 _ = unit
+ fun C1 _ = getT
+ val data = getS
+ fun Y ? = let open Tie in iso (G.Y *` function) end
+ (fn IN {gen = a, cog = b} => a & b,
+ fn a & b => IN {gen = a, cog = b}) ?
+ fun op -->` (IN {gen = aGen, cog = aCog}, IN {gen = bGen, cog = bCog}) =
+ IN {gen = G.promote (fn a => universally (aCog a) bGen),
+ cog = fn f => fn g =>
+ aGen >>= (fn a => universally (bCog (f a)) g)}
+ fun op --> (a, b) = op -->` (getT a, getT b)
+ val exn = IN {gen = G.return Empty,
+ cog = failing "Arbitrary.exn unsupported"}
+ fun regExn _ _ = ()
+ fun list' (IN {gen = xGen, cog = xCog}) = let
+ val xsGen = G.sized (0 <\ G.intInRange) >>= G.list xGen
+ fun xsCog [] = G.variant 0
+ | xsCog (x::xs) =
+ universally (xCog x) o G.variant 1 o universally (xsCog xs)
+ in
+ IN {gen = xsGen, cog = xsCog}
+ end
+ fun list ? = list' (getT ?)
+ fun array a = iso' (list a) Array.isoList
+ fun refc a = iso' (getT a) (!, ref)
+ fun vector a = iso' (list a) Vector.isoList
+ val int = IN {gen = map (fn w => W.toIntX (w - G.RNG.maxValue div 0w2))
+ (* XXX result may not fit an Int.t *)
+ (G.lift G.RNG.value),
+ cog = G.variant}
+ val largeInt = iso' int (Iso.swap I.isoLarge)
+ val word = IN {gen = G.lift G.RNG.value, cog = G.variant o W.toIntX}
+ val largeWord = iso' word (Iso.swap W.isoLarge)
+ local
+ fun mk large = iso' word (Iso.<--> (Iso.swap W.isoLarge, large))
+ in
+ val word8 = mk Word8.isoLarge
+ (* val word16 = mk Word16.isoLarge (* Word16 not provided by SML/NJ *) *)
+ val word32 = mk Word32.isoLarge
+ val word64 = mk Word64.isoLarge
+ end
+ val bool = IN {gen = G.bool, cog = G.variant o Bool.toInt}
+ val char = IN {gen = map chr (G.intInRange (0, Char.maxOrd)),
+ cog = G.variant o ord}
+ val string as IN {cog = stringCog, ...} = iso' (list' char) String.isoList
+ val real = IN {gen = G.sized ((fn r => G.realInRange (~r, r)) o real),
+ cog = stringCog o R.toString} (* XXX Real cog *)
+ val largeReal = iso' real (Iso.swap (R.isoLarge IEEEReal.TO_NEAREST)))
- fun Y ? = y Arg.Y (let open Tie in iso (G.Y *` function) end
- (fn IN {gen = a, cog = b} => a & b,
- fn a & b => IN {gen = a, cog = b})) ?
-
- fun op *` ? = op2 Arg.*`
- (fn (IN {gen = aGen, cog = aCog},
- IN {gen = bGen, cog = bCog}) =>
- IN {gen = G.Monad.>>& (aGen, bGen),
- cog = fn a & b => aCog a o bCog b}) ?
-
- fun op +` xy2z (a, b) =
- op2 Arg.+`
- (fn (IN {gen = aGen, cog = aCog}, IN {gen = bGen, cog = bCog}) => let
- val aGen = map INL aGen
- val bGen = map INR bGen
- val gen = G.frequency [(Arg.numAlts a, aGen),
- (Arg.numAlts b, bGen)]
- val gen0 =
- case Arg.hasBaseCase a & Arg.hasBaseCase b of
- true & false => aGen
- | false & true => bGen
- | _ => gen
- in
- IN {gen = G.sized (fn 0 => gen0 | _ => gen),
- cog = fn INL a => G.variant 0 o aCog a
- | INR b => G.variant 1 o bCog b}
- end) xy2z (a, b)
-
- fun op --> ? =
- op2 Arg.-->
- (fn (IN {gen = aGen, cog = aCog}, IN {gen = bGen, cog = bCog}) =>
- IN {gen = G.promote (fn a => universally (aCog a) bGen),
- cog = fn f => fn g =>
- aGen >>= (fn a => universally (bCog (f a)) g)}) ?
-
- fun exn ? =
- op0 Arg.exn (IN {gen = G.return Empty,
- cog = failing "Arbitrary.exn unsupported"}) ?
-
- fun regExn ? = re Arg.regExn (const ignore) ?
-
- fun list' (IN {gen = xGen, cog = xCog}) = let
- val xsGen = G.sized (0 <\ G.intInRange) >>= G.list xGen
- fun xsCog [] = G.variant 0
- | xsCog (x::xs) =
- universally (xCog x) o G.variant 1 o universally (xsCog xs)
- in
- IN {gen = xsGen, cog = xsCog}
- end
- fun list ? = op1 Arg.list list' ?
- val char' = IN {gen = map chr (G.intInRange (0, Char.maxOrd)),
- cog = G.variant o ord}
- fun char ? = op0 Arg.char char' ?
- val string' as IN {cog = stringCog', ...} = iso' (list' char') String.isoList
- fun string ? = op0 Arg.string string' ?
-
- fun array ? = op1 Arg.array (fn a => iso' (list' a) Array.isoList) ?
- fun refc ? = op1 Arg.refc (fn a => iso' a (!, ref)) ?
- fun vector ? = op1 Arg.vector (fn a => iso' (list' a) Vector.isoList) ?
-
- fun largeInt ? = op0 Arg.largeInt (iso' int' (Iso.swap I.isoLarge)) ?
- fun largeWord ? = op0 Arg.largeWord (iso' word' (Iso.swap W.isoLarge)) ?
-
- val real' = IN {gen = G.sized ((fn r => G.realInRange (~r, r)) o real),
- cog = stringCog' o R.toString} (* XXX Real cog *)
-
- fun real ? = op0 Arg.real real' ?
- fun largeReal ? =
- op0 Arg.largeReal
- (iso' real' (Iso.swap (R.isoLarge IEEEReal.TO_NEAREST))) ?
-
- local
- fun mk outer large =
- op0 outer (iso' word' (Iso.<--> (Iso.swap W.isoLarge, large)))
- in
- fun word8 ? = mk Arg.word8 Word8.isoLarge ?
- (* fun word16 ? = mk Arg.word16 Word16.isoLarge ?
- (* Word16 not provided by SML/NJ *) *)
- fun word32 ? = mk Arg.word32 Word32.isoLarge ?
- fun word64 ? = mk Arg.word64 Word64.isoLarge ?
- end
-
- (* Trivialities *)
-
- fun T ? = t Arg.T id ?
- fun R ? = r Arg.R (const id) ?
- fun tuple ? = op1 Arg.tuple id ?
- fun record ? = op1 Arg.record id ?
- fun C0 ? = c0 Arg.C0 (const unit') ?
- fun C1 ? = c1 Arg.C1 (const id) ?
- fun data ? = op1 Arg.data id ?
+ open Layered
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -66,18 +66,15 @@
val data = id
end
- structure Dummy : OPEN_GENERIC = OpenGeneric (Dummy)
+ structure Dummy : OPENED_GENERIC = OpenGeneric (Dummy)
in
structure Dummy :> DUMMY_GENERIC = struct
open Dummy
-
structure Dummy = Rep
exception Dummy of Exn.t
-
val dummy : ('a, 'x) Dummy.t -> 'a =
- fn (a, _) => a () handle e => raise Dummy e
-
- fun withDummy v (_, x) = (fn () => valOf v, x)
+ fn a => This.getT a () handle e => raise Dummy e
+ fun withDummy v = This.mapT (const (fn () => valOf v))
end
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -74,13 +74,13 @@
val data = id
end
- structure Eq : OPEN_GENERIC = OpenGeneric (Eq)
+ structure Eq : OPENED_GENERIC = OpenGeneric (Eq)
in
structure Eq :> EQ_GENERIC = struct
open Eq
structure Eq = Rep
- val eq : ('a, 'x) Eq.t -> 'a BinPr.t = Pair.fst
- fun notEq (eq, _) = negate eq
+ val eq : ('a, 'x) Eq.t -> 'a BinPr.t = This.getT
+ fun notEq ? = negate (eq ?)
end
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -36,136 +36,107 @@
fun lift toWord a _ r = r * 0w19 + toWord a
end
- structure Rep =
- JoinGenericReps
- (structure Outer = Arg.Rep
- structure Inner =
- OpenGenericRep (MkClosedGenericRep (type 'a t = 'a t)))
+ structure Closed = MkClosedGenericRep (type 'a t = 'a t)
+ structure Hash = LayerGenericRep (structure Outer = Arg.Rep and Rep = Closed)
+ open Hash.This
- structure Hash = Rep
+ fun hash t v = getT t v {maxWidth = 200, maxDepth = 10} 0wx2CA4B13
- fun hash t v =
- Pair.fst (Arg.Rep.getT t) v {maxWidth = 200, maxDepth = 10} 0wx2CA4B13
+ structure Layered = LayerGeneric
+ (structure Rep = Closed and Outer = Arg and Result = Hash
+ fun iso' bH (a2b, _) = bH o a2b
+ fun iso ? = iso' (getT ?)
+ fun isoProduct ? = iso' (getP ?)
+ fun isoSum ? = iso' (getS ?)
- fun iso' bH (a2b, _) = bH o a2b
+ fun op *` (aT, bT) (a & b) {maxWidth, maxDepth} = let
+ val aN = Arg.numElems aT
+ val bN = Arg.numElems bT
+ val aW = Int.quot (maxWidth * aN, aN + bN)
+ val bW = maxWidth - aW
+ in
+ getP bT b {maxWidth = bW, maxDepth = maxDepth} o
+ getP aT a {maxWidth = aW, maxDepth = maxDepth}
+ end
- fun iso ? = morph Arg.iso iso' ?
- fun isoProduct ? = morph Arg.isoProduct iso' ?
- fun isoSum ? = morph Arg.isoSum iso' ?
+ fun op +` ? =
+ Sum.sum (Pair.map (HC.withConst 0wx96BA232 o getS,
+ HC.withConst 0wxCF24651 o getS) ?)
- fun op *` xy2z (aT, bT) =
- op2 Arg.*`
- (fn (aH, bH) =>
- fn a & b => fn {maxWidth, maxDepth} => let
- val aN = Arg.numElems aT
- val bN = Arg.numElems bT
- val aW = Int.quot (maxWidth * aN, aN + bN)
- val bW = maxWidth - aW
- in
- bH b {maxWidth = bW, maxDepth = maxDepth} o
- aH a {maxWidth = aW, maxDepth = maxDepth}
- end)
- xy2z (aT, bT)
+ val Y = Tie.function
- fun op +` ? =
- op2 Arg.+`
- (Sum.sum o
- Pair.map (HC.withConst 0wx96BA232,
- HC.withConst 0wxCF2465)) ?
+ fun op --> _ = failing "Hash.--> unsupported"
- fun Y ? = y Arg.Y Tie.function ?
+ fun exn _ = failing "Hash.exn unsupported"
+ fun regExn _ _ = ()
- fun op --> ? = op2 Arg.--> (fn _ => failing "Hash.--> unsupported") ?
+ fun refc aT = HC.withConst 0wx178A2346 (HC.map ! (getT aT))
- fun exn ? = op0 Arg.exn (failing "Hash.exn unsupported") ?
- fun regExn ? = re Arg.regExn (const ignore) ?
+ fun list xT xs {maxWidth, maxDepth} h = let
+ val m = Int.quot (maxWidth, 2)
+ fun len n [] = n
+ | len n (_::xs) = if m <= n then n else len (n+1) xs
+ val n = len 0 xs
+ val p = {maxWidth = Int.quot (maxWidth, n),
+ maxDepth = maxDepth - 1}
+ fun lp h _ [] = h
+ | lp h n (x::xs) = if n = 0 then h else lp (getT xT x p h) (n-1) xs
+ in
+ lp h n xs
+ end
- fun refc ? = op1 Arg.refc (HC.withConst 0wx178A2346 o HC.map !) ?
-
- fun list ? =
- op1 Arg.list
- (fn hX => fn xs => fn {maxWidth, maxDepth} => fn h => let
- val m = Int.quot (maxWidth, 2)
- fun len n [] = n
- | len n (_::xs) = if m <= n then n else len (n+1) xs
- val n = len 0 xs
- val p = {maxWidth = Int.quot (maxWidth, n),
+ fun hashSeq length sub hashElem s {maxWidth, maxDepth} h = let
+ val n = length s
+ in
+ case Int.min (Int.quot (maxWidth+3, 4), Int.quot (n+1, 2)) of
+ 0 => h
+ | numSamples => let
+ val p = {maxWidth = Int.quot (maxWidth, numSamples),
maxDepth = maxDepth - 1}
- fun lp h _ [] = h
- | lp h n (x::xs) = if n = 0 then h else lp (hX x p h) (n-1) xs
+ fun lp h 0 = h
+ | lp h n = lp (hashElem (sub (s, n-1)) p h) (n-1)
in
- lp h n xs
- end) ?
+ lp h (Int.max (numSamples, Int.min (10, n)))
+ end
+ end
- fun hashSeq length sub hashElem s {maxWidth, maxDepth} h = let
- val n = length s
- in
- case Int.min (Int.quot (maxWidth+3, 4), Int.quot (n+1, 2)) of
- 0 => h
- | numSamples => let
- val p = {maxWidth = Int.quot (maxWidth, numSamples),
- maxDepth = maxDepth - 1}
- fun lp h 0 = h
- | lp h n = lp (hashElem (sub (s, n-1)) p h) (n-1)
- in
- lp h (Int.max (numSamples, Int.min (10, n)))
- end
- end
+ fun array aT = hashSeq Array.length Array.sub (getT aT)
+ fun vector aT = hashSeq Vector.length Vector.sub (getT aT)
- fun array ? = op1 Arg.array (hashSeq Array.length Array.sub) ?
- fun vector ? = op1 Arg.vector (hashSeq Vector.length Vector.sub) ?
+ val char = HC.lift (Word.fromInt o ord)
+ val string = hashSeq String.length String.sub char
+ val unit = HC.lift (Thunk.mk 0wx2F785)
- val char' = HC.lift (Word.fromInt o ord)
- fun char ? = op0 Arg.char char' ?
+ val largeInt =
+ HC.lift (W.fromLargeInt o LargeInt.rem /> W.toLargeInt W.maxValue)
+ val largeWord =
+ HC.lift (W.fromLarge o LargeWord.mod /> W.toLarge W.maxValue)
+ val word8 = HC.lift Word8.toWord
+ (* val word16 = HC.lift Word16.toWord (* Word16 not provided by SML/NJ *) *)
+ val word32 = HC.lift (Word.fromLarge o Word32.toLarge)
+ val word64 = HC.lift (Word.fromLarge o Word64.toLarge)
+ val bool = HC.lift (fn true => 0wx2DA745 | false => 0wx3C24A62)
+ val int = HC.lift Word.fromInt
+ val word = HC.lift id
- val string' = hashSeq String.length String.sub char'
- fun string ? = op0 Arg.string string' ?
+ (* XXX SML/NJ does not provide a function to convert a real to bits *)
+ val largeReal = HC.map LargeReal.toString string
+ val real = HC.map Real.toString string
- val unit' = HC.lift (Thunk.mk 0wx2F785)
- fun unit ? = op0 Arg.unit unit' ?
+ (* Trivialities *)
- local
- fun mk outer toWord ? = op0 outer (HC.lift toWord) ?
- in
- fun largeInt ? =
- mk Arg.largeInt
- (W.fromLargeInt o LargeInt.rem /> W.toLargeInt W.maxValue) ?
- fun largeWord ? =
- mk Arg.largeWord
- (W.fromLarge o LargeWord.mod /> W.toLarge W.maxValue) ?
- fun word8 ? = mk Arg.word8 Word8.toWord ?
- (* fun word16 ? = mk Arg.word16 Word16.toWord ?
- (* Word16 not provided by SML/NJ *) *)
- fun word32 ? = mk Arg.word32 (Word.fromLarge o Word32.toLarge) ?
- fun word64 ? = mk Arg.word64 (Word.fromLarge o Word64.toLarge) ?
- fun bool ? = mk Arg.bool (fn true => 0wx2DA745 | false => 0wx3C24A62) ?
- fun int ? = mk Arg.int Word.fromInt ?
- fun word ? = mk Arg.word id ?
- end
+ val T = getT
+ fun R _= getT
+ fun tuple aP a p = if #maxWidth p = 0 then id else (getP aP) a p
+ val record = tuple
- (* XXX SML/NJ does not provide a function to convert a real to bits *)
- fun largeReal ? = op0 Arg.largeReal (HC.map LargeReal.toString string') ?
- fun real ? = op0 Arg.real (HC.map Real.toString string') ?
+ fun C0 _ = unit
+ fun C1 _ = getT
- (* Trivialities *)
+ fun data aS a {maxDepth, maxWidth} =
+ if maxDepth = 0 then id
+ else getS aS a {maxDepth = maxDepth - 1,
+ maxWidth = Int.quot (maxWidth, 2)})
- fun T ? = t Arg.T id ?
- fun R ? = r Arg.R (const id) ?
-
- local
- fun width h : 'a t =
- fn a => fn p => if #maxWidth p = 0 then id else h a p
- in
- fun tuple ? = op1 Arg.tuple width ?
- fun record ? = op1 Arg.record width ?
- end
-
- fun C0 ? = c0 Arg.C0 (const unit') ?
- fun C1 ? = c1 Arg.C1 (const id) ?
- fun data ? =
- op1 Arg.data
- (fn h => fn a => fn {maxDepth, maxWidth} =>
- if maxDepth = 0 then id
- else h a {maxDepth = maxDepth - 1,
- maxWidth = Int.quot (maxWidth, 2)}) ?
+ open Layered
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -79,12 +79,12 @@
val data = id
end
- structure Ord : OPEN_GENERIC = OpenGeneric (Ord)
+ structure Ord : OPENED_GENERIC = OpenGeneric (Ord)
in
structure Ord :> ORD_GENERIC = struct
open Ord
structure Ord = Rep
- val compare : ('a, 'x) Ord.t -> 'a Cmp.t = Pair.fst
+ val compare : ('a, 'x) Ord.t -> 'a Cmp.t = This.getT
end
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -186,13 +186,13 @@
val word64 = mkWord Word64.toString
end
- structure Pretty : OPEN_GENERIC = OpenGeneric (Pretty)
+ structure Pretty : OPENED_GENERIC = OpenGeneric (Pretty)
in
structure Pretty :> PRETTY_GENERIC = struct
open Pretty
structure Pretty = Rep
val layout : ('a, 'x) Pretty.t -> 'a -> Prettier.t =
- fn (t, _) => Pair.snd o [] <\ t
+ fn t => Pair.snd o [] <\ This.getT t
fun pretty m t = Prettier.pretty m o layout t
end
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-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -151,25 +151,25 @@
INT {base = base, exn = exn, pure = true, recs = recs}
end
- structure TypeInfo : OPEN_GENERIC = OpenGeneric (TypeInfo)
+ structure TypeInfo : OPENED_GENERIC = OpenGeneric (TypeInfo)
in
structure TypeInfo :> TYPE_INFO_GENERIC = struct
open TypeInfo
structure TypeInfo = Rep
- fun out (INT r, _) = r
- fun hasExn ? = (#exn o out) ?
- fun hasRecData ? = (not o null o #recs o out) ?
- fun isRefOrArray ? = (not o #pure o out) ?
+ fun out (INT r) = r
+ fun hasExn ? = (#exn o out o This.getT) ?
+ fun hasRecData ? = (not o null o #recs o out o This.getT) ?
+ fun isRefOrArray ? = (not o #pure o out o This.getT) ?
fun canBeCyclic ? = (isRefOrArray andAlso (hasExn orElse hasRecData)) ?
- fun out (INS r, _) = r
- fun hasBaseCase ? = (#base o out) ?
- fun numAlts ? = (#alts o out) ?
+ fun out (INS r) = r
+ fun hasBaseCase ? = (#base o out o This.getS) ?
+ fun numAlts ? = (#alts o out o This.getS) ?
- fun out (INP r, _) = r
- fun numElems ? = (#elems o out) ?
+ fun out (INP r) = r
+ fun numElems ? = (#elems o out o This.getP) ?
end
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-17 09:22:55 UTC (rev 5637)
@@ -52,6 +52,9 @@
public/join-generics-fun.sig
detail/join-generics.fun
+ public/layer-generic-fun.sig
+ detail/layer-generic.fun
+
(* Values *)
public/value/type-info.sig
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-17 09:22:55 UTC (rev 5637)
@@ -62,11 +62,7 @@
CloseGeneric (Arg)
(** Closes an open 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 =
+functor OpenGeneric (Arg : CLOSED_GENERIC) : OPENED_GENERIC =
OpenGeneric (Arg)
(** Opens a closed generic. *)
@@ -87,6 +83,19 @@
* representation of the {Outer} generic.
*)
+signature LAYER_GENERIC_DOM = LAYER_GENERIC_DOM
+
+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 =
+ LayerGeneric (Arg)
+(**
+ * Joins an outer open generic function and a closed generic function that
+ * depends on the outer generic function.
+ *)
+
functor WithExtra (Arg : GENERIC) : GENERIC_EXTRA = WithExtra (Arg)
(**
* Implements a number of frequently used type representations for
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig 2007-06-17 09:22:55 UTC (rev 5637)
@@ -12,29 +12,4 @@
val failExn : Exn.t -> 'a
val failExnSq : Exn.t Sq.t -> 'a
-
- (** == For Defining Open Generic Functions == *)
-
- val op0 : ('a * 'b -> 'c) -> 'a -> 'b -> 'c
- val op1 : ((('a, 'b) Pair.t -> ('c, 'd) Pair.t) -> 'e)
- -> ('a -> 'c) -> ('b -> 'd) -> 'e
- val op2 : ((('a, 'b) Pair.t * ('c, 'd) Pair.t -> ('e, 'f) Pair.t) -> 'g)
- -> ('a * 'c -> 'e) -> ('b * 'd -> 'f) -> 'g
-
- val t : ((('a, 'b) Pair.t -> ('c, 'd) Pair.t) -> 'e)
- -> ('a -> 'c) -> ('b -> 'd) -> 'e
- val r : (('a -> ('b, 'c) Pair.t -> ('d, 'e) Pair.t) -> 'f)
- -> ('a -> 'b -> 'd) -> ('a -> 'c -> 'e) -> 'f
-
- val c0 : (('a -> ('b, 'c) Pair.t) -> 'd) -> ('a -> 'b) -> ('a -> 'c) -> 'd
- val c1 : (('a -> ('b, 'c) Pair.t -> ('d, 'e) Pair.t) -> 'f)
- -> ('a -> 'b -> 'd) -> ('a -> 'c -> 'e) -> 'f
-
- val y : (('a * 'b) Tie.t -> 'c) -> 'a Tie.t -> 'b Tie.t -> 'c
-
- val morph : (('a * 'b -> 'c -> 'd * 'e) -> 'f)
- -> ('a -> 'c -> 'd) -> ('b -> 'c -> 'e) -> 'f
-
- val re : (('a * 'b -> 'c -> Unit.t) -> 'd)
- -> ('a -> 'c -> Unit.t) -> ('b -> 'c -> Unit.t) -> 'd
end
Added: mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig 2007-06-16 19:56:39 UTC (rev 5636)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig 2007-06-17 09:22:55 UTC (rev 5637)
@@ -0,0 +1,51 @@
+(* 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 {LayerGeneric} functor.
+ *)
+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
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/layer-generic-fun.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list