[MLton-commit] r6043
Vesa Karvonen
vesak at mlton.org
Thu Sep 20 07:08:07 PDT 2007
Suffixed type representation substructures with Rep.
----------------------------------------------------------------------
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/transform.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml
U mltonlib/trunk/com/ssh/generic/unstable/public/value/reduce.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/seq.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig
U mltonlib/trunk/com/ssh/generic/unstable/public/value/type-exp.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/reduce.sml 2007-09-20 14:08:06 UTC (rev 6043)
@@ -23,23 +23,25 @@
fun default (z, _, _) = z
- structure Reduce = LayerRep
+ structure ReduceRep = LayerRep
(structure Outer = Arg.Rep
structure Closed = MkClosedRep
(type 'a t = Univ.t * Univ.t BinOp.t * 'a -> Univ.t))
+ open ReduceRep.This
+
fun makeReduce z p a2r aT aT2bT = let
val (to, from) = Univ.Iso.new ()
val z = to z
val p = BinOp.map (from, to) p
- val aT = Reduce.This.mapT (const (to o a2r o #3)) aT
- val bR = Reduce.This.getT (aT2bT aT)
+ val aT = mapT (const (to o a2r o #3)) aT
+ val bR = getT (aT2bT aT)
in
fn x => from (bR (z, p, x))
end
structure Layered = LayerCases
- (structure Outer = Arg and Result = Reduce and Rep = Reduce.Closed
+ (structure Outer = Arg and Result = ReduceRep and Rep = ReduceRep.Closed
fun iso bR (a2b, _) (z, p, a) = bR (z, p, a2b a)
val isoProduct = iso
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2007-09-20 14:08:06 UTC (rev 6043)
@@ -55,21 +55,21 @@
case getX bX
of bE => fn (a2b, _) => fn (e, bp) => bE (e, Sq.map a2b bp)
- structure Seq = LayerRep
+ structure SeqRep = LayerRep
(structure Outer = Arg.Rep
structure Closed = MkClosedRep (type 'a t = 'a t))
- open Seq.This
+ open SeqRep.This
fun seq t =
case getT t
- of eq => fn xy => eq (HashMap.new {eq = HashUniv.eq,
- hash = HashUniv.hash}, xy)
+ of eq => fn xy =>
+ eq (HashMap.new {eq = HashUniv.eq, hash = HashUniv.hash}, xy)
fun notSeq t = negate (seq t)
fun withSeq eq = mapT (const (lift eq))
structure Layered = LayerDepCases
- (structure Outer = Arg and Result = Seq
+ (structure Outer = Arg and Result = SeqRep
fun iso ? = iso' getT ?
fun isoProduct ? = iso' getP ?
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2007-09-20 14:08:06 UTC (rev 6043)
@@ -35,11 +35,11 @@
fun iso' getX bX (a2b, b2a) = un (Fn.map (Pair.map (a2b, id), b2a)) (getX bX)
- structure Transform = LayerRep
+ structure TransformRep = LayerRep
(structure Outer = Arg.Rep
structure Closed = MkClosedRep (type 'a t = 'a t))
- open Transform.This
+ open TransformRep.This
fun makeTransform a2a t t2u =
case getT (t2u (mapT (const (CUSTOM, lift a2a)) t))
@@ -47,7 +47,7 @@
fn x => f (x, HashMap.new {eq = HashUniv.eq, hash = HashUniv.hash})
structure Layered = LayerDepCases
- (structure Outer = Arg and Result = Transform
+ (structure Outer = Arg and Result = TransformRep
fun iso ? = iso' getT ?
fun isoProduct ? = iso' getP ?
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-exp.sml 2007-09-20 14:08:06 UTC (rev 6043)
@@ -17,11 +17,11 @@
end
fun mapElem f =
- fn TIMES (a, b) => TIMES (mapElem f a, mapElem f b)
- | ISO_PRODUCT b => ISO_PRODUCT (mapElem f b)
- | ELEM e => ELEM (f e)
+ fn TIMES (a, b) => TIMES (mapElem f a, mapElem f b)
+ | ISO_PRODUCT b => ISO_PRODUCT (mapElem f b)
+ | ELEM e => ELEM (f e)
- structure TypeExp = LayerRep
+ structure TypeExpRep = LayerRep
(structure Outer = Arg.Rep
structure Closed = struct
type 'a t = TypeVar.t Ty.t
@@ -29,10 +29,10 @@
type ('a, 'k) p = (Label.t Option.t * TypeVar.t Ty.t) Product.t
end)
- val ty = TypeExp.This.getT
+ val ty = TypeExpRep.This.getT
structure Layered = LayerCases
- (structure Outer = Arg and Result = TypeExp and Rep = TypeExp.Closed
+ (structure Outer = Arg and Result = TypeExpRep and Rep = TypeExpRep.Closed
fun iso bT _ = ISO bT
fun isoProduct bP _ = ISO_PRODUCT bP
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/reduce.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/reduce.sig 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/reduce.sig 2007-09-20 14:08:06 UTC (rev 6043)
@@ -26,19 +26,19 @@
* This design is experimental.
*)
signature REDUCE = sig
- structure Reduce : OPEN_REP
+ structure ReduceRep : OPEN_REP
val makeReduce :
'r
-> 'r BinOp.t
-> ('a -> 'r)
- -> ('a, 'x) Reduce.t
- -> (('a, 'x) Reduce.t -> ('b, 'y) Reduce.t)
+ -> ('a, 'x) ReduceRep.t
+ -> (('a, 'x) ReduceRep.t -> ('b, 'y) ReduceRep.t)
-> 'b -> 'r
(** Creates a reduce operation. *)
end
signature REDUCE_CASES = sig
include OPEN_CASES REDUCE
- sharing Rep = Reduce
+ sharing Rep = ReduceRep
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/seq.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/seq.sig 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/seq.sig 2007-09-20 14:08:06 UTC (rev 6043)
@@ -18,21 +18,21 @@
* other similar generics.
*)
signature SEQ = sig
- structure Seq : OPEN_REP
+ structure SeqRep : OPEN_REP
- val seq : ('a, 'x) Seq.t -> 'a BinPr.t
+ val seq : ('a, 'x) SeqRep.t -> 'a BinPr.t
(** Extracts the equality predicate. *)
- val notSeq : ('a, 'x) Seq.t -> 'a BinPr.t
+ val notSeq : ('a, 'x) SeqRep.t -> 'a BinPr.t
(** {notSeq t = not o seq t} *)
- val withSeq : 'a BinPr.t -> ('a, 'x) Seq.t UnOp.t
+ val withSeq : 'a BinPr.t -> ('a, 'x) SeqRep.t UnOp.t
(** Functionally updates the equality predicate. *)
end
signature SEQ_CASES = sig
include OPEN_CASES SEQ
- sharing Rep = Seq
+ sharing Rep = SeqRep
end
signature WITH_SEQ_DOM = HASH_CASES
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig 2007-09-20 14:08:06 UTC (rev 6043)
@@ -21,19 +21,19 @@
* This design is experimental.
*)
signature TRANSFORM = sig
- structure Transform : OPEN_REP
+ structure TransformRep : OPEN_REP
val makeTransform :
'a UnOp.t
- -> ('a, 'x) Transform.t
- -> (('a, 'x) Transform.t -> ('b, 'y) Transform.t)
+ -> ('a, 'x) TransformRep.t
+ -> (('a, 'x) TransformRep.t -> ('b, 'y) TransformRep.t)
-> 'b UnOp.t
(** Creates a transform operation. *)
end
signature TRANSFORM_CASES = sig
include OPEN_CASES TRANSFORM
- sharing Rep = Transform
+ sharing Rep = TransformRep
end
signature WITH_TRANSFORM_DOM = HASH_CASES
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/type-exp.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/type-exp.sig 2007-09-20 07:20:22 UTC (rev 6042)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/type-exp.sig 2007-09-20 14:08:06 UTC (rev 6043)
@@ -8,18 +8,18 @@
* Signature for generic type representation expression.
*)
signature TYPE_EXP = sig
- structure TypeExp : OPEN_REP
+ structure TypeExpRep : OPEN_REP
(** A minimalistic type variable representation providing only equality. *)
structure TypeVar : sig
eqtype t
end
- val ty : ('a, 'x) TypeExp.t -> TypeVar.t Ty.t
+ val ty : ('a, 'x) TypeExpRep.t -> TypeVar.t Ty.t
(** Returns the type expression given a type representation. *)
end
signature TYPE_EXP_CASES = sig
include OPEN_CASES TYPE_EXP
- sharing Rep = TypeExp
+ sharing Rep = TypeExpRep
end
More information about the MLton-commit
mailing list