[MLton-commit] r5641

Vesa Karvonen vesak at mlton.org
Sun Jun 17 06:04:17 PDT 2007


OpenGeneric is no longer needed.
----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/generic/unstable/detail/generic.sml
U   mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun
U   mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
D   mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun
U   mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
U   mltonlib/trunk/com/ssh/generic/unstable/public/export.sml

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/generic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/generic.sml	2007-06-17 12:54:36 UTC (rev 5640)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/generic.sml	2007-06-17 13:04:17 UTC (rev 5641)
@@ -4,7 +4,7 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-structure Generic : sig
+structure Generic :> sig
    include GENERIC_EXTRA
    include ARBITRARY sharing Open.Rep = Arbitrary
    include DUMMY     sharing Open.Rep = Dummy

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun	2007-06-17 12:54:36 UTC (rev 5640)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/join-generics.fun	2007-06-17 13:04:17 UTC (rev 5641)
@@ -9,7 +9,7 @@
    structure Inner : OPEN_GENERIC_REP
 end
 
-functor JoinGenericReps (Arg : JOIN_GENERIC_REPS_DOM) :
+functor JoinGenericReps (Arg : JOIN_GENERIC_REPS_DOM) :>
    OPEN_GENERIC_REP
       where type ('a, 'x) t =
                  ('a, ('a, 'x) Arg.Inner.t) Arg.Outer.t

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-17 12:54:36 UTC (rev 5640)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm	2007-06-17 13:04:17 UTC (rev 5641)
@@ -34,7 +34,6 @@
    ../../generics.sml
    ../../join-generics.fun
    ../../layer-generic.fun
-   ../../open-generic.fun
    ../../root-generic.sml
    ../../sml-syntax.sml
    ../../value/arbitrary.sml

Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun	2007-06-17 12:54:36 UTC (rev 5640)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/open-generic.fun	2007-06-17 13:04:17 UTC (rev 5641)
@@ -1,119 +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.
- *)
-
-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) :
-   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
-   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
-
-signature OPENED_GENERIC = sig
-   include OPEN_GENERIC
-   structure This : THIS_GENERIC_REP
-   sharing Rep = This.Rep
-end
-
-functor OpenGeneric (Arg : CLOSED_GENERIC) :>
-   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 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 ? = t Arg.T ?
-   fun R ? = r Arg.R ?
-   fun tuple ? = op1 Arg.tuple ?
-   fun record ? = op1 Arg.record ?
-   fun op +` ? = op2 Arg.+` ?
-   fun C0 ? = c0 Arg.C0 ?
-   fun C1 ? = c1 Arg.C1 ?
-   fun data ? = op1 Arg.data ?
-   fun unit ? = op0 Arg.unit ?
-   fun Y ? = y Arg.Y ?
-   fun op --> ? = op2 Arg.--> ?
-   fun exn ? = op0 Arg.exn ?
-   fun regExn ? = re Arg.regExn ?
-   fun array ? = op1 Arg.array ?
-   fun refc ? = op1 Arg.refc ?
-   fun vector ? = op1 Arg.vector ?
-   fun largeInt ? = op0 Arg.largeInt ?
-   fun largeReal ? = op0 Arg.largeReal ?
-   fun largeWord ? = op0 Arg.largeWord ?
-   fun word8 ? = op0 Arg.word8 ?
-(* fun word16 x = op0 Arg.word16 ? (* Word16 not provided by SML/NJ *) *)
-   fun word32 ? = op0 Arg.word32 ?
-   fun word64 ? = op0 Arg.word64 ?
-   fun list ? = op1 Arg.list ?
-   fun bool ? = op0 Arg.bool ?
-   fun char ? = op0 Arg.char ?
-   fun int ? = op0 Arg.int ?
-   fun real ? = op0 Arg.real ?
-   fun string ? = op0 Arg.string ?
-   fun word ? = op0 Arg.word ?
-end

Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb	2007-06-17 12:54:36 UTC (rev 5640)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb	2007-06-17 13:04:17 UTC (rev 5641)
@@ -47,7 +47,6 @@
          detail/root-generic.sml
 
          detail/close-generic.fun
-         detail/open-generic.fun
 
          public/join-generics-fun.sig
          detail/join-generics.fun

Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml	2007-06-17 12:54:36 UTC (rev 5640)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml	2007-06-17 13:04:17 UTC (rev 5641)
@@ -64,10 +64,6 @@
    CloseGeneric (Arg)
 (** Closes an open generic. *)
 
-functor OpenGeneric (Arg : CLOSED_GENERIC) : OPENED_GENERIC =
-   OpenGeneric (Arg)
-(** Opens a closed generic. *)
-
 signature JOIN_GENERICS_DOM = JOIN_GENERICS_DOM
 
 functor JoinGenerics (Arg : JOIN_GENERICS_DOM) :




More information about the MLton-commit mailing list