[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