[MLton-commit] r6464
Vesa Karvonen
vesak at mlton.org
Sat Mar 8 21:55:32 PST 2008
Tweaked (the argument signature of) the representation layering functor
for shorter code.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/framework/layer-generic.fun
D mltonlib/trunk/com/ssh/generic/unstable/detail/framework/mk-closed-rep.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/enum.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.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/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
U mltonlib/trunk/com/ssh/generic/unstable/lib.use
U mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
U mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-rep-fun.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/layer-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/framework/layer-generic.fun 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/framework/layer-generic.fun 2008-03-09 05:55:28 UTC (rev 6464)
@@ -6,16 +6,16 @@
functor LayerRep (Arg : LAYER_REP_DOM) :>
LAYER_REP_COD
- where type 'a This.t = 'a Arg.Rep.t
- where type 'a This.s = 'a Arg.Rep.s
- where type ('a, 'k) This.p = ('a, 'k) Arg.Rep.p
+ where type 'a This.t = 'a Arg.t
+ where type 'a This.s = 'a Arg.s
+ where type ('a, 'k) This.p = ('a, 'k) Arg.p
where type ('a, 'x) Outer.t = ('a, 'x) Arg.Open.Rep.t
where type ('a, 'x) Outer.s = ('a, 'x) Arg.Open.Rep.s
where type ('a, 'k, 'x) Outer.p = ('a, 'k, 'x) Arg.Open.Rep.p =
struct
structure Outer = Arg.Open.Rep
- structure Rep = Arg.Rep
+ structure Rep = Arg
structure Inner = struct
type ('a, 'x) t = 'a Rep.t * 'x
type ('a, 'x) s = 'a Rep.s * 'x
@@ -51,6 +51,9 @@
end
end
+functor LayerRep' (Arg : LAYER_REP_DOM') =
+ LayerRep (open Arg type 'a s = 'a t type ('a, 'k) p = 'a t)
+
functor LayerDepCases (Arg : LAYER_DEP_CASES_DOM) :>
OPEN_CASES
where type ('a, 'x) Rep.t = ('a, 'x) Arg.t
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/mk-closed-rep.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/framework/mk-closed-rep.fun 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/framework/mk-closed-rep.fun 2008-03-09 05:55:28 UTC (rev 6464)
@@ -1,11 +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 MkClosedRep (type 'a t) : CLOSED_REP = struct
- type 'a t = 'a t
- type 'a s = 'a t
- type ('a, 'k) p = 'a t
-end
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2008-03-09 05:55:28 UTC (rev 6464)
@@ -18,7 +18,6 @@
../../extra/with-extra.fun
../../framework/close-generic.fun
../../framework/layer-generic.fun
- ../../framework/mk-closed-rep.fun
../../framework/root-generic.sml
../../util/generics-util.sml
../../util/hash-univ.sml
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/arbitrary.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -62,9 +62,7 @@
IN {gen = xsGen, cog = xsCog}
end
- structure ArbitraryRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure ArbitraryRep = LayerRep' (open Arg type 'a t = 'a t)
open ArbitraryRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/data-rec-info.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -41,11 +41,7 @@
structure DataRecInfoRep = LayerRep
(open Arg
- structure Rep = struct
- type 'a t = t
- type 'a s = s
- type ('a, 'k) p = p
- end)
+ type 'a t = t and 'a s = s and ('a, 'k) p = p)
open DataRecInfoRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/debug.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -32,11 +32,9 @@
structure DebugRep = LayerRep
(open Arg
- structure Rep = struct
- type 'a t = Unit.t
- type 'a s = String.t List.t
- type ('a, 'k) p = String.t List.t
- end)
+ type 'a t = Unit.t
+ type 'a s = String.t List.t
+ type ('a, 'k) p = String.t List.t)
structure Layered = LayerCases
(val iso = const
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/dynamic.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -44,9 +44,7 @@
fun isoUnsupported text = (failing text, failing text)
- structure DynamicRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = ('a, t) Iso.t))
+ structure DynamicRep = LayerRep' (open Arg type 'a t = ('a, t) Iso.t)
open DynamicRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/enum.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/enum.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/enum.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -91,7 +91,7 @@
interleave (iterateUnless (fn r => nextAfter (r, posInf)) zero,
iterateUnless (fn r => nextAfter (r, ~posInf)) (~zero))
- structure EnumRep = LayerRep (open Arg structure Rep = MkClosedRep (Enum))
+ structure EnumRep = LayerRep' (open Arg Enum)
open EnumRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -38,7 +38,7 @@
| SOME l & SOME r => t (l, r)
| _ => false) exnHandler
- structure EqRep = LayerRep (open Arg structure Rep = MkClosedRep (BinPr))
+ structure EqRep = LayerRep' (open Arg BinPr)
open EqRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/fmap.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -50,9 +50,7 @@
val op <--> = Iso.<-->
- structure FmapRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a FmapAux.i))
+ structure FmapRep = LayerRep' (open Arg type 'a t = 'a FmapAux.i)
structure Fmap = struct
open FmapAux
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/hash.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -49,9 +49,7 @@
val exns : (Exn.t * p -> Word.t Option.t) Buffer.t = Buffer.new ()
- structure HashRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure HashRep = LayerRep' (open Arg type 'a t = 'a t)
open HashRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -64,9 +64,7 @@
| NONE & SOME _ => SOME LESS
| NONE & NONE => NONE)
- structure OrdRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure OrdRep = LayerRep' (open Arg type 'a t = 'a t)
open OrdRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -462,9 +462,7 @@
structure PickleRep = LayerRep
(open Arg
- structure Rep = struct
- type 'a t = 'a t and 'a s = 'a s and ('a, 'k) p = 'a t
- end)
+ type 'a t = 'a t and 'a s = 'a s and ('a, 'k) p = 'a t)
open PickleRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pretty.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -240,9 +240,7 @@
structure PrettyRep = LayerRep
(open Arg
- structure Rep = struct
- type 'a t = 'a t and 'a s = 'a t and ('a, 'k) p = 'a p
- end)
+ type 'a t = 'a t and 'a s = 'a t and ('a, 'k) p = 'a p)
open PrettyRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -113,13 +113,11 @@
structure ReadRep = LayerRep
(open Arg
- structure Rep = struct
- type 'a t = 'a t
- type 'a s = String.t -> 'a t Option.t
- type ('a, 'k) p =
- Int.t -> {fromLabel : 'k -> (Int.t * Univ.t t) Option.t,
- fromArray : Univ.t Option.t Array.t -> 'a}
- end)
+ type 'a t = 'a t
+ type 'a s = String.t -> 'a t Option.t
+ type ('a, 'k) p =
+ Int.t -> {fromLabel : 'k -> (Int.t * Univ.t t) Option.t,
+ fromArray : Univ.t Option.t Array.t -> 'a})
open ReadRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -26,9 +26,7 @@
val default = IN (fn (z, _, _) => z)
- structure ReduceRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure ReduceRep = LayerRep' (open Arg type 'a t = 'a t)
open ReduceRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -59,9 +59,7 @@
fn Ops.R {isoBits = SOME isoBits, ...} => iso' (lift op =) isoBits
| Ops.R {toBytes, ...} => iso' (lift op =) (toBytes, undefined)
- structure SeqRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure SeqRep = LayerRep' (open Arg type 'a t = 'a t)
open SeqRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/shrink.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -73,9 +73,7 @@
lp (0w0, [])
end}
- structure ShrinkRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure ShrinkRep = LayerRep' (open Arg type 'a t = 'a t)
open ShrinkRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/size.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -55,9 +55,7 @@
fn STATIC s => const (STATIC s)
| DYNAMIC bS => fn (a2b, _) => DYNAMIC (bS o Pair.map (id, a2b))
- structure SizeRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure SizeRep = LayerRep' (open Arg type 'a t = 'a t)
open SizeRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/some.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -12,9 +12,7 @@
fun iso' b (_, b2a) = b2a o b
- structure SomeRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (Thunk))
+ structure SomeRep = LayerRep' (open Arg Thunk)
open SomeRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -35,9 +35,7 @@
fun iso' bX (a2b, b2a) = un (Fn.map (Pair.map (a2b, id), b2a)) bX
- structure TransformRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure TransformRep = LayerRep' (open Arg type 'a t = 'a t)
open TransformRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -24,11 +24,9 @@
structure TypeExpRep = LayerRep
(open Arg
- structure Rep = struct
- type 'a t = TypeVar.t Ty.t
- and 'a s = TypeVar.t Ty.t Sum.t
- and ('a, 'k) p = (Label.t Option.t * TypeVar.t Ty.t) Product.t
- end)
+ type 'a t = TypeVar.t Ty.t
+ type 'a s = TypeVar.t Ty.t Sum.t
+ type ('a, 'k) p = (Label.t Option.t * TypeVar.t Ty.t) Product.t)
val ty = TypeExpRep.This.getT
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-hash.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -10,9 +10,7 @@
fun unary c h : W.t = h * 0w19 + c
fun binary c (l, r) : W.t = l * 0w13 + r * 0w17 + c
- structure TypeHashRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = W.t))
+ structure TypeHashRep = LayerRep' (open Arg type 'a t = W.t)
val typeHash = TypeHashRep.This.getT
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -18,11 +18,7 @@
structure TypeInfoRep = LayerRep
(open Arg
- structure Rep = struct
- type 'a t = t
- type 'a s = s
- type ('a, 'k) p = p
- end)
+ type 'a t = t and 'a s = s and ('a, 'k) p = p)
open TypeInfoRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -64,9 +64,7 @@
fn (r, c, a) => ki (r, c, a2b a),
fn (r, c, a) => Pair.map (b2a, id) (ko (r, c, a2b a)))
- structure UniplateRep = LayerRep
- (open Arg
- structure Rep = MkClosedRep (type 'a t = 'a t))
+ structure UniplateRep = LayerRep' (open Arg type 'a t = 'a t)
open UniplateRep.This
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2008-03-09 05:55:28 UTC (rev 6464)
@@ -48,7 +48,6 @@
(* Framework *)
- detail/framework/mk-closed-rep.fun
detail/framework/root-generic.sml
detail/framework/close-generic.fun
public/framework/layered-rep.sig
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.use
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.use 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.use 2008-03-09 05:55:28 UTC (rev 6464)
@@ -28,7 +28,6 @@
"detail/util/ops.sml",
"detail/util/opt-int.sml",
"detail/util/hash-univ.sml",
- "detail/framework/mk-closed-rep.fun",
"detail/framework/root-generic.sml",
"detail/framework/close-generic.fun",
"public/framework/layered-rep.sig",
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2008-03-09 05:55:28 UTC (rev 6464)
@@ -34,15 +34,14 @@
(** == Framework Functors == *)
-functor MkClosedRep (type 'a t) : CLOSED_REP = MkClosedRep (type 'a t = 'a t)
-(** Makes a closed representation by replicating the given type. *)
+signature LAYER_REP_COD = LAYER_REP_COD
-signature LAYER_REP_DOM = LAYER_REP_DOM and LAYER_REP_COD = LAYER_REP_COD
+signature LAYER_REP_DOM = LAYER_REP_DOM
functor LayerRep (Arg : LAYER_REP_DOM) :>
LAYER_REP_COD
- where type 'a This.t = 'a Arg.Rep.t
- where type 'a This.s = 'a Arg.Rep.s
- where type ('a, 'k) This.p = ('a, 'k) Arg.Rep.p
+ where type 'a This.t = 'a Arg.t
+ where type 'a This.s = 'a Arg.s
+ where type ('a, 'k) This.p = ('a, 'k) Arg.p
where type ('a, 'x) Outer.t = ('a, 'x) Arg.Open.Rep.t
where type ('a, 'x) Outer.s = ('a, 'x) Arg.Open.Rep.s
@@ -52,6 +51,21 @@
* Creates a layered representation for {LayerCases} and {LayerDepCases}.
*)
+signature LAYER_REP_DOM' = LAYER_REP_DOM'
+functor LayerRep' (Arg : LAYER_REP_DOM') :>
+ LAYER_REP_COD
+ where type 'a This.t = 'a Arg.t
+ where type 'a This.s = 'a Arg.t
+ where type ('a, 'k) This.p = 'a Arg.t
+
+ where type ('a, 'x) Outer.t = ('a, 'x) Arg.Open.Rep.t
+ where type ('a, 'x) Outer.s = ('a, 'x) Arg.Open.Rep.s
+ where type ('a, 'k, 'x) Outer.p = ('a, 'k, 'x) Arg.Open.Rep.p =
+ LayerRep' (Arg)
+(**
+ * Creates a layered representation for {LayerCases} and {LayerDepCases}.
+ *)
+
signature LAYER_CASES_DOM = LAYER_CASES_DOM
functor LayerCases (Arg : LAYER_CASES_DOM) :>
OPEN_CASES
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-rep-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-rep-fun.sig 2008-03-06 03:44:30 UTC (rev 6463)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-rep-fun.sig 2008-03-09 05:55:28 UTC (rev 6464)
@@ -11,10 +11,20 @@
structure Open : sig
structure Rep : OPEN_REP
end
- structure Rep : CLOSED_REP
+ include CLOSED_REP
end
(**
+ * Signature for the domain of the {LayerRep'} functor.
+ *)
+signature LAYER_REP_DOM' = sig
+ structure Open : sig
+ structure Rep : OPEN_REP
+ end
+ type 'a t (** Type of representations. *)
+end
+
+(**
* Signature for the codomain of the {LayerRep} functor.
*)
signature LAYER_REP_COD = sig
More information about the MLton-commit
mailing list