[MLton-commit] r6121
Vesa Karvonen
vesak at mlton.org
Sat Nov 3 03:39:47 PST 2007
Reorganized sources for conceptual clarity and ease of browsing them.
----------------------------------------------------------------------
D mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun
D mltonlib/trunk/com/ssh/generic/unstable/detail/close-pretty-with-extra.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/extra/
A mltonlib/trunk/com/ssh/generic/unstable/detail/extra/close-pretty-with-extra.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/extra/reg-basis-exns.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/extra/with-extra.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/framework/
A mltonlib/trunk/com/ssh/generic/unstable/detail/framework/close-generic.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/framework/generics.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/framework/layer-generic.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/framework/mk-closed-rep.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/framework/root-generic.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/framework/ty.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
D mltonlib/trunk/com/ssh/generic/unstable/detail/mk-closed-rep.fun
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/sigs.cm
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
D mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/opt-int.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun
D mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/ty.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/util/
A mltonlib/trunk/com/ssh/generic/unstable/detail/util/generics-util.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/util/hash-map.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/util/hash-univ.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/util/ops.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/util/opt-int.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/util/sml-syntax.sml
D mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
D mltonlib/trunk/com/ssh/generic/unstable/public/cases.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/closed-rep.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/extra/
A mltonlib/trunk/com/ssh/generic/unstable/public/extra/generic-extra.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/cases.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/closed-cases.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/closed-rep.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/generic.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/generics.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-cases-fun.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-dep-cases-fun.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-rep-fun.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/layered-rep.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/open-cases.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/open-rep.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/framework/ty.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/layer-cases-fun.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/layer-rep-fun.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/layered-rep.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/open-cases.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/open-rep.sig
D mltonlib/trunk/com/ssh/generic/unstable/public/ty.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/util/
A mltonlib/trunk/com/ssh/generic/unstable/public/util/generics-util.sig
----------------------------------------------------------------------
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,70 +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 CloseRep (include OPEN_REP) :>
- CLOSED_REP
- where type 'a t = ('a, Unit.t) t
- where type 'a s = ('a, Unit.t) s
- where type ('a, 'k) p = ('a, 'k, Unit.t) p =
-struct
- type 'a t = ('a, Unit.t) t
- type 'a s = ('a, Unit.t) s
- type ('a, 'k) p = ('a, 'k, Unit.t) p
-end
-
-functor CloseCases (Arg : CASES) :>
- GENERIC
- where type ('a, 'x) Open.Rep.t = ('a, 'x) Arg.Open.Rep.t
- where type ('a, 'x) Open.Rep.s = ('a, 'x) Arg.Open.Rep.s
- where type ('a, 'k, 'x) Open.Rep.p = ('a, 'k, 'x) Arg.Open.Rep.p =
-struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- open Arg
- structure Rep = CloseRep (Open.Rep)
-
- fun morph m = m (const ignore)
-
- fun iso ? = morph Open.iso ?
- fun isoProduct ? = morph Open.isoProduct ?
- fun isoSum ? = morph Open.isoSum ?
- fun op *` ? = Open.*` ignore ?
- fun T ? = Open.T ignore ?
- fun R ? = Open.R (const ignore) ?
- fun tuple ? = Open.tuple ignore ?
- fun record ? = Open.record ignore ?
- fun op +` ? = Open.+` ignore ?
- fun C0 ? = Open.C0 (const ()) ?
- fun C1 ? = Open.C1 (const ignore) ?
- fun data ? = Open.data ignore ?
- val unit = Open.unit ()
- fun Y ? = Open.Y (Tie.id ()) ?
- fun op --> ? = Open.--> ignore ?
- val exn = Open.exn ()
- fun regExn0 ? = Open.regExn0 (const ignore) ?
- fun regExn1 ? = Open.regExn1 (const (const ignore)) ?
- fun array ? = Open.array ignore ?
- fun refc ? = Open.refc ignore ?
- fun vector ? = Open.vector ignore ?
- val fixedInt = Open.fixedInt ()
- val largeInt = Open.largeInt ()
- val largeReal = Open.largeReal ()
- val largeWord = Open.largeWord ()
- val word8 = Open.word8 ()
- val word32 = Open.word32 ()
-(*
- val word64 = Open.word64 ()
-*)
- fun list ? = Open.list ignore ?
- val bool = Open.bool ()
- val char = Open.char ()
- val int = Open.int ()
- val real = Open.real ()
- val string = Open.string ()
- val word = Open.word ()
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/close-pretty-with-extra.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/close-pretty-with-extra.fun 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/close-pretty-with-extra.fun 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,22 +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 ClosePrettyWithExtra (Arg : PRETTY_CASES) : GENERIC_EXTRA = struct
- structure Rep = CloseCases (Arg)
- structure Rep = WithExtra (open Arg Rep)
- open Arg Rep
- local
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
- val et = C "&"
- in
- fun op &` ab =
- iso (data (Pretty.infixL 0 et ab
- (C1 et (tuple2 ab))))
- (fn op & ? => ?, op &)
- end
-end
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/extra/close-pretty-with-extra.fun (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/close-pretty-with-extra.fun)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/extra/reg-basis-exns.fun (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/extra/with-extra.fun (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/close-generic.fun (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/generics.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/layer-generic.fun (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/mk-closed-rep.fun (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/mk-closed-rep.fun)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/root-generic.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/framework/ty.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/ty.sml)
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,16 +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.
- *)
-
-structure GenericsUtil :> GENERICS_UTIL = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- val ` = Exn.name
- fun failCat ss = fail (concat ss)
- fun failExn e = failCat ["unregistered exn ", `e]
- fun failExnSq (l, r) = failCat ["unregistered exns ", `l, " and ", `r]
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,28 +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.
- *)
-
-structure Generics :> GENERICS = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- structure Label = struct
- type t = String.t
- val toString = id
- end
-
- structure Con = Label
-
- structure Record = Unit
- structure Tuple = Unit
-
- local
- fun mk p v = if p v then v else fail "syntax error"
- in
- val L = mk SmlSyntax.isLabel
- val C = mk SmlSyntax.isLongId
- end
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,201 +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.
- *)
-
-structure Node :> sig
- type 'a t
- type 'a p = 'a t Option.t Ref.t
-
- val new : 'a -> 'a t
- val ptr : 'a p Thunk.t
-
- val next : 'a t -> 'a p
- val value : 'a t -> 'a
-
- val isEmpty : 'a p UnPr.t
-
- val length : 'a p -> Int.t
-
- val hd : 'a p -> 'a
- val tl : 'a p UnOp.t
-
- val push : 'a p -> 'a Effect.t
- val pop : 'a p -> 'a Option.t
-
- val peek : 'a p -> 'a Option.t
-
- val drop : 'a p Effect.t
-
- val find : 'a UnPr.t -> 'a p -> ('a p, 'a p) Sum.t
- val fold : ('a * 's -> 's) -> 's -> 'a p -> 's
-
- val toList : 'a p -> 'a List.t
-
- val filter : 'a UnPr.t -> 'a p UnOp.t
-
- val appClear : 'a Effect.t -> 'a p UnOp.t
-
- val insert : 'a BinPr.t -> 'a p -> 'a Effect.t
-end = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- infix 4 <\
- infixr 4 />
- (* SML/NJ workaround --> *)
-
- datatype 'a t = T of 'a * 'a p
- withtype 'a p = 'a t Option.t Ref.t
-
- fun ptr () = ref NONE
- fun new v = T (v, ptr ())
-
- fun next (T (_, p)) = p
- fun value (T (v, _)) = v
-
- fun isEmpty p = isNone (!p)
-
- fun nonEmpty f p = case !p of NONE => raise Empty | SOME n => f n
- fun hd p = nonEmpty value p
- fun tl p = nonEmpty next p
-
- fun drop p = p := !(tl p)
-
- fun push p v = let
- val n = new v
- in
- next n := !p ; p := SOME n
- end
-
- fun pop p =
- case !p of
- NONE => NONE
- | SOME (T (v, p')) => (p := !p' ; SOME v)
-
- fun peek p =
- case !p of
- NONE => NONE
- | SOME (T (v, _)) => SOME v
-
- fun find c p =
- case !p of
- NONE => INL p
- | SOME (T (v, p')) => if c v then INR p else find c p'
-
- fun fold f s p =
- case !p of
- NONE => s
- | SOME (T (v, p)) => fold f (f (v, s)) p
-
- fun toList p = rev (fold op :: [] p)
-
- fun length p = fold (1 <\ op + o #2) 0 p
-
- fun filter c p =
- case !p of
- NONE => p
- | SOME (T (v, n)) =>
- if c v then filter c n else (p := !n ; filter c p)
-
- fun appClear ef p =
- case !p of
- NONE => p
- | SOME (T (v, n)) => (ef v : unit ; p := !n ; appClear ef p)
-
- fun insert lt p v =
- case !p of
- NONE => push p v
- | SOME (T (x, p')) =>
- if lt (x, v) then insert lt p' v else push p v
-end
-
-structure HashMap :> sig
- type ('a, 'b) t
- val new : {eq : 'a BinPr.t, hash : 'a -> Word.t} -> ('a, 'b) t
- val size : ('a, 'b) t -> Int.t
- val insert : ('a, 'b) t -> ('a * 'b) Effect.t
- val find : ('a, 'b) t -> 'a -> 'b Option.t
-end = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- datatype ('a, 'b) t =
- IN of {table : {hash : Word.t,
- key : 'a,
- value : 'b Ref.t} Node.p Vector.t Ref.t,
- size : Int.t Ref.t,
- eq : 'a BinPr.t,
- hash : 'a -> Word.t}
-
- fun table (IN r) = !(#table r)
- fun size (IN r) = !(#size r)
- fun eq (IN r) = #eq r
- fun hash (IN r) = #hash r
-
- val caps = Vector.fromList
- [3, 7, 13, 31, 61, 127, 251, 509, 1021, 2039, 4093, 8191,
- 16381, 32749, 65521, 131071, 262139, 524287, 1048573,
- 2097143, 4194301, 8388593, 16777213, 33554393, 67108859,
- 134217689, 268435399, 536870909, 1073741789]
- val minCap = Vector.sub (caps, 0)
- val maxCap = Vector.sub (caps, Vector.length caps - 1)
-
- fun hashToIdx t hash =
- Word.toIntX (hash mod Word.fromInt (Vector.length (table t)))
-
- fun newTable cap = Vector.tabulate (cap, Node.ptr o ignore)
-
- fun locate t key' = let
- val hash' = hash t key'
- val idx = hashToIdx t hash'
- in
- (hash', Node.find (fn {hash, key, ...} =>
- hash = hash' andalso eq t (key, key'))
- (Vector.sub (table t, idx)))
- end
-
- fun maybeGrow (t as IN {size, table, ...}) = let
- val cap = Vector.length (!table)
- in
- if cap <= !size andalso cap < maxCap
- then let
- val newCap =
- recur 0 (fn lp =>
- fn i => if Vector.sub (caps, i) = cap
- then Vector.sub (caps, i+1)
- else lp (i+1))
- val oldTable = !table
- in
- table := newTable newCap
- ; Vector.app (ignore o
- Node.appClear
- (fn c =>
- Node.push
- (Vector.sub (!table, hashToIdx t (#hash c)))
- c))
- oldTable
- end
- else ()
- end
-
- fun new {eq, hash} =
- IN {table = ref (newTable minCap),
- size = ref 0,
- eq = eq,
- hash = hash}
-
- fun find t key' =
- case locate t key'
- of (_, INR p) => SOME (! (#value (Node.hd p)))
- | (_, INL _) => NONE
-
- fun insert (t as IN {size, ...}) (key, value) =
- case locate t key
- of (_, INR p) => #value (Node.hd p) := value
- | (hash, INL p) =>
- (Node.push p {hash = hash, key = key, value = ref value}
- ; size := !size+1
- ; maybeGrow t)
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,33 +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 HASH_UNIV = sig
- type t
- val new : {eq : 'a BinPr.t, hash : 'a -> Word.t} -> ('a, t) Iso.t
- val eq : t BinPr.t
- val hash : t -> Word.t
-end
-
-structure HashUniv :> HASH_UNIV = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- datatype t = T of {value : Univ.t, hash : Word.t Lazy.t,
- methods : {eq : Univ.t BinPr.t} Ref.t}
- fun new {eq, hash} = let
- val (to, from) = Univ.Iso.new ()
- val methods = ref {eq = BinPr.map from eq}
- in
- (fn value => T {value = to value,
- hash = delay (fn () => hash value),
- methods = methods},
- fn T r => from (#value r))
- end
- fun eq (T l, T r) = #methods l = #methods r
- andalso #eq (! (#methods l)) (#value l, #value r)
- fun hash (T r) = force (#hash r)
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/layer-generic.fun 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,155 +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 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, '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 Inner = struct
- type ('a, 'x) t = 'a Rep.t * 'x
- type ('a, 'x) s = 'a Rep.s * 'x
- type ('a, 'k, 'x) p = ('a, 'k) Rep.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
- 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
- open Rep
- 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 ?)
- val mkT = Fn.id
- val mkS = Fn.id
- val mkP = Fn.id
- val mkY = Tie.tuple2
- end
-end
-
-functor LayerDepCases (Arg : LAYER_DEP_CASES_DOM) :>
- OPEN_CASES
- where type ('a, 'x) Rep.t = ('a, 'x) Arg.t
- where type ('a, 'x) Rep.s = ('a, 'x) Arg.s
- where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.p =
-struct
- open Arg
- structure Rep = Arg
-
- 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 (This.mkT (this, x))
- fun op1t ? = op1 This.mkT Inner.getT ?
- fun t ? = op1 This.mkP Inner.getT ?
- fun r outer this lx2y l a =
- outer (fn l => fn x => This.mkP (this l a, lx2y l (Inner.getT x))) l a
- fun p ? = op1 This.mkT Inner.getP ?
- fun s ? = op1 This.mkT Inner.getS ?
- fun c0 outer l2s l2x = outer (This.mkS o Pair.map (l2s, l2x) o Sq.mk)
- fun c1 outer this cx2y c a =
- outer (fn c => fn x => This.mkS (this c a, cx2y c (Inner.getT x))) c a
- fun y outer x y = outer (This.mkY (x, y))
- fun re0 outer this ex =
- outer (fn c => fn e => (this c e : Unit.t ; ex c e : Unit.t))
- fun re1 outer this ex c a =
- outer (fn c => fn x => fn e =>
- (this c a e : Unit.t ; ex c (Inner.getT x) e : Unit.t)) c a
-
- fun iso ? = m This.mkT Inner.getT Open.iso Arg.iso ?
- fun isoProduct ? = m This.mkP Inner.getP Open.isoProduct Arg.isoProduct ?
- fun isoSum ? = m This.mkS Inner.getS Open.isoSum Arg.isoSum ?
- fun op *` ? = op2 This.mkP Inner.getP Inner.getP Open.*` Arg.*` ?
- fun T ? = t Open.T Arg.T ?
- fun R ? = r Open.R Arg.R ?
- fun tuple ? = p Open.tuple Arg.tuple ?
- fun record ? = p Open.record Arg.record ?
- fun op +` ? = op2 This.mkS Inner.getS Inner.getS Open.+` Arg.+` ?
- fun C0 ? = c0 Open.C0 Arg.C0 ?
- fun C1 ? = c1 Open.C1 Arg.C1 ?
- fun data ? = s Open.data Arg.data ?
- fun unit ? = op0t Open.unit Arg.unit ?
- fun Y ? = y Open.Y Arg.Y ?
- fun op --> ? = op2 This.mkT Inner.getT Inner.getT Open.--> Arg.--> ?
- fun exn ? = op0t Open.exn Arg.exn ?
- fun regExn0 ? = re0 Open.regExn0 Arg.regExn0 ?
- fun regExn1 ? = re1 Open.regExn1 Arg.regExn1 ?
- fun array ? = op1t Open.array Arg.array ?
- fun refc ? = op1t Open.refc Arg.refc ?
- fun vector ? = op1t Open.vector Arg.vector ?
- fun fixedInt ? = op0t Open.fixedInt Arg.fixedInt ?
- fun largeInt ? = op0t Open.largeInt Arg.largeInt ?
- fun largeReal ? = op0t Open.largeReal Arg.largeReal ?
- fun largeWord ? = op0t Open.largeWord Arg.largeWord ?
- fun word8 ? = op0t Open.word8 Arg.word8 ?
- fun word32 ? = op0t Open.word32 Arg.word32 ?
-(*
- fun word64 ? = op0t Open.word64 Arg.word64 ?
-*)
- fun list ? = op1t Open.list Arg.list ?
- fun bool ? = op0t Open.bool Arg.bool ?
- fun char ? = op0t Open.char Arg.char ?
- fun int ? = op0t Open.int Arg.int ?
- fun real ? = op0t Open.real Arg.real ?
- fun string ? = op0t Open.string Arg.string ?
- fun word ? = op0t Open.word Arg.word ?
-
- fun hole ? = Open.hole (This.mkT (Arg.hole (), ?))
-end
-
-functor LayerCases (Arg : LAYER_CASES_DOM) :>
- OPEN_CASES
- where type ('a, 'x) Rep.t = ('a, 'x) Arg.t
- where type ('a, 'x) Rep.s = ('a, 'x) Arg.s
- where type ('a, 'k, 'x) Rep.p = ('a, 'k, 'x) Arg.p =
- LayerDepCases
- (open Arg
- local
- open Arg.This
- in
- 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 regExn1 c = Arg.regExn1 c o getT
- end)
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/mk-closed-rep.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/mk-closed-rep.fun 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/mk-closed-rep.fun 2007-11-03 11:39:42 UTC (rev 6121)
@@ -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/sigs.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/sigs.cm 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/sigs.cm 2007-11-03 11:39:42 UTC (rev 6121)
@@ -8,20 +8,20 @@
../../../../../extended-basis/unstable/basis.cm
../../../../../prettier/unstable/lib.cm
../../../../../random/unstable/lib.cm
- ../../../public/cases.sig
- ../../../public/closed-cases.sig
- ../../../public/closed-rep.sig
- ../../../public/generic-extra.sig
- ../../../public/generic.sig
- ../../../public/generics-util.sig
- ../../../public/generics.sig
- ../../../public/layer-cases-fun.sig
- ../../../public/layer-dep-cases-fun.sig
- ../../../public/layer-rep-fun.sig
- ../../../public/layered-rep.sig
- ../../../public/open-cases.sig
- ../../../public/open-rep.sig
- ../../../public/ty.sig
+ ../../../public/extra/generic-extra.sig
+ ../../../public/framework/cases.sig
+ ../../../public/framework/closed-cases.sig
+ ../../../public/framework/closed-rep.sig
+ ../../../public/framework/generic.sig
+ ../../../public/framework/generics.sig
+ ../../../public/framework/layer-cases-fun.sig
+ ../../../public/framework/layer-dep-cases-fun.sig
+ ../../../public/framework/layer-rep-fun.sig
+ ../../../public/framework/layered-rep.sig
+ ../../../public/framework/open-cases.sig
+ ../../../public/framework/open-rep.sig
+ ../../../public/framework/ty.sig
+ ../../../public/util/generics-util.sig
../../../public/value/arbitrary.sig
../../../public/value/data-rec-info.sig
../../../public/value/dynamic.sig
@@ -40,6 +40,6 @@
../../../public/value/type-exp.sig
../../../public/value/type-hash.sig
../../../public/value/type-info.sig
- ../../generics.sml
- ../../sml-syntax.sml
- ../../ty.sml
+ ../../framework/generics.sml
+ ../../framework/ty.sml
+ ../../util/sml-syntax.sml
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-11-03 11:39:42 UTC (rev 6121)
@@ -11,17 +11,18 @@
../../../../../extended-basis/unstable/basis.cm
../../../../../prettier/unstable/lib.cm
../../../../../random/unstable/lib.cm
- ../../close-generic.fun
- ../../close-pretty-with-extra.fun
- ../../generics-util.sml
- ../../hash-map.sml
- ../../hash-univ.sml
- ../../layer-generic.fun
- ../../mk-closed-rep.fun
- ../../ops.sml
- ../../opt-int.sml
- ../../reg-basis-exns.fun
- ../../root-generic.sml
+ ../../extra/close-pretty-with-extra.fun
+ ../../extra/reg-basis-exns.fun
+ ../../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-map.sml
+ ../../util/hash-univ.sml
+ ../../util/ops.sml
+ ../../util/opt-int.sml
../../value/arbitrary.sml
../../value/data-rec-info.sml
../../value/debug.sml
@@ -41,6 +42,5 @@
../../value/type-exp.sml
../../value/type-hash.sml
../../value/type-info.sml
- ../../with-extra.fun
extensions.cm
sigs.cm
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,104 +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.
- *)
-
-structure Ops = struct
- datatype 'a wops =
- W of {<< : 'a ShiftOp.t,
- >> : 'a ShiftOp.t,
- isoWord8 : ('a, Word8.t) Iso.t,
- isoWord8X : ('a, Word8.t) Iso.t,
- orb : 'a BinOp.t,
- wordSize : Int.t,
- ~>> : 'a ShiftOp.t}
-
- datatype 'a iops =
- I of {*` : 'a BinOp.t,
- +` : 'a BinOp.t,
- div : 'a BinOp.t,
- fromInt : Int.t -> 'a,
- maxInt : 'a Option.t,
- mod : 'a BinOp.t,
- precision : Int.t Option.t}
-
- datatype 'a rops =
- R of {bytesPerElem : Int.t,
- subArr : Word8Array.t * Int.t -> 'a,
- toBytes : 'a -> Word8Vector.t}
-
- datatype ('elem, 'list, 'result, 'seq, 'slice) sops =
- S of {foldl : ('elem * 'result -> 'result) -> 'result -> 'seq -> 'result,
- fromList : 'list -> 'seq,
- getItem : 'slice -> ('elem * 'slice) Option.t,
- length : 'seq -> Int.t,
- sub : 'seq * Int.t -> 'elem,
- toSlice : 'seq -> 'slice}
-end
-
-functor MkWordOps (include WORD) = struct
- val ops = Ops.W {wordSize = wordSize, orb = op orb, << = op <<, ~>> = op ~>>,
- >> = op >>, isoWord8 = isoWord8, isoWord8X = isoWord8X}
-end
-
-structure LargeRealWordOps = MkWordOps (CastLargeReal.Bits)
-structure LargeWordOps = MkWordOps (LargeWord)
-structure RealWordOps = MkWordOps (CastReal.Bits)
-structure WordOps = MkWordOps (Word)
-structure Word32Ops = MkWordOps (Word32)
-(*
-structure Word64Ops = MkWordOps (Word64)
-*)
-structure Word8Ops = MkWordOps (Word8)
-
-functor MkIntOps (include INTEGER) = struct
- val ops = Ops.I {precision = precision, maxInt = maxInt, fromInt = fromInt,
- *` = op *, +` = op +, div = op div, mod = op mod}
-end
-
-structure FixedIntOps = MkIntOps (FixedInt)
-structure IntOps = MkIntOps (Int)
-structure LargeIntOps = MkIntOps (LargeInt)
-
-functor MkRealOps (include PACK_REAL) = struct
- val ops = Ops.R {bytesPerElem = bytesPerElem, subArr = subArr,
- toBytes = toBytes}
-end
-
-structure PackRealLittleOps = MkRealOps (PackRealLittle)
-structure PackLargeRealLittleOps = MkRealOps (PackLargeRealLittle)
-
-functor MkSeqOps (structure Seq : sig
- type 'a t
- val length : 'a t -> Int.t
- val foldl : ('a * 'b -> 'b) -> 'b -> 'a t -> 'b
- val fromList : 'a List.t -> 'a t
- val sub : 'a t * Int.t -> 'a
- end
- structure Slice : sig
- type 'a t
- val full : 'a Seq.t -> 'a t
- val getItem : 'a t -> ('a * 'a t) Option.t
- end) = struct
- val ops = Ops.S {length = Seq.length, foldl = Seq.foldl,
- toSlice = Slice.full, getItem = Slice.getItem,
- fromList = Seq.fromList, sub = Seq.sub}
-end
-
-structure ArrayOps = MkSeqOps (structure Seq = Array and Slice = ArraySlice)
-structure VectorOps = MkSeqOps (structure Seq = Vector and Slice = VectorSlice)
-structure ListOps = MkSeqOps
- (structure Seq = struct
- open List
- val fromList = TopLevel.id
- end
- structure Slice = struct
- open List
- val full = TopLevel.id
- end)
-structure StringOps = struct
- val ops = Ops.S {length = String.length, foldl = String.foldl,
- toSlice = Substring.full, getItem = Substring.getc,
- fromList = String.fromList, sub = String.sub}
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/opt-int.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/opt-int.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/opt-int.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,18 +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.
- *)
-
-structure OptInt = struct
- type t = Int.t Option.t
- local
- fun mk bop =
- fn (SOME l, SOME r) => SOME (bop (l, r))
- | _ => NONE
- in
- val op + = mk op +
- val op - = mk op -
- val op div = mk op div
- end
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/reg-basis-exns.fun 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,46 +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 RegBasisExns (include CLOSED_CASES) = struct
- val () = let
- open Generics (*IEEEReal*) OS OS.IO OS.Path Time
-
- local
- fun lift f a = SOME (f a) handle Match => NONE
- in
- fun regExn0' n e p = regExn0 (C n) (e, lift p)
- fun regExn1' n t e p = regExn1 (C n) t (e, lift p)
- end
- in
- (* Handlers for most standard exceptions: *)
- regExn0' "Bind" Bind (fn Bind => ())
- ; regExn0' "Chr" Chr (fn Chr => ())
- ; regExn0' "Date.Date" Date.Date (fn Date.Date => ())
- ; regExn0' "Div" Div (fn Div => ())
- ; regExn0' "Domain" Domain (fn Domain => ())
- ; regExn0' "Empty" Empty (fn Empty => ())
- ; regExn0' "OS.Path.InvalidArc" InvalidArc (fn InvalidArc => ())
- ; regExn0' "Match" Match (fn Match => ())
- ; regExn0' "Option" Option (fn Option => ())
- ; regExn0' "Overflow" Overflow (fn Overflow => ())
- ; regExn0' "OS.Path.Path" Path (fn Path => ())
-(*
- ; regExn0' "OS.IO.Poll" Poll (fn Poll => ())
-*)
- ; regExn0' "Size" Size (fn Size => ())
- ; regExn0' "Span" Span (fn Span => ())
- ; regExn0' "Subscript" Subscript (fn Subscript => ())
- ; regExn0' "Time.Time" Time (fn Time => ())
-(*
- ; regExn0' "IEEEReal.Unordered" Unordered (fn Unordered => ())
-*)
- ; regExn1' "Fail" string Fail (fn Fail ? => ?)
- (* Handlers for some extended-basis exceptions: *)
- ; regExn0' "IOSMonad.EOS" IOSMonad.EOS (fn IOSMonad.EOS => ())
- ; regExn0' "Sum.Sum" Sum.Sum (fn Sum.Sum => ())
- ; regExn0' "Fix.Fix" Fix.Fix (fn Fix.Fix => ())
- end
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/root-generic.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,67 +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.
- *)
-
-structure RootGeneric :> CASES = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- structure Open = struct
- structure Rep = struct
- type ('a, 'x) t = 'x
- type ('a, 'x) s = 'x
- type ('a, 'k, 'x) p = 'x
-
- val getT = id
- val getS = id
- val getP = id
-
- val mapT = id
- val mapS = id
- val mapP = id
- end
-
- val iso = id
- val isoProduct = id
- val isoSum = id
- val op *` = id
- val T = id
- val R = id
- val tuple = id
- val record = id
- val op +` = id
- val C0 = id
- val C1 = id
- val data = id
- val unit = id
- val Y = id
- val op --> = id
- val exn = id
- val regExn0 = id
- val regExn1 = id
- val array = id
- val refc = id
- val vector = id
- val fixedInt = id
- val largeInt = id
- val largeReal = id
- val largeWord = id
- val word8 = id
- val word32 = id
-(*
- val word64 = id
-*)
- val list = id
- val bool = id
- val char = id
- val int = id
- val real = id
- val string = id
- val word = id
-
- val hole = id
- end
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,42 +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.
- *)
-
-(**
- * Utilities for dealing with the syntax of Standard ML.
- *)
-structure SmlSyntax :> sig
- (** == PREDICATES FOR IDENTIFIERS == *)
-
- val isAlphaNumId : String.t UnPr.t
- val isId : String.t UnPr.t
- val isLabel : String.t UnPr.t
- val isLongId : String.t UnPr.t
- val isNumLabel : String.t UnPr.t
-end = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- infix 4 <\
- infixr 4 />
- infix 2 andAlso
- infix 1 orElse
- (* SML/NJ workaround --> *)
-
- structure C = Char and L = List and S = String
- val isSym = C.contains "!%&$#+-/:<=>?@\\~`^|*"
- val isntEmpty = 0 <\ op < o size
- val isSymId = isntEmpty andAlso S.all isSym
- val isAlphaNumId = isntEmpty
- andAlso C.isAlpha o S.sub /> 0
- andAlso S.all (C.isAlphaNum
- orElse #"'" <\ op =
- orElse #"_" <\ op =)
- val isNumLabel = isntEmpty
- andAlso #"0" <\ op <> o S.sub /> 0
- andAlso S.all C.isDigit
- val isId = isAlphaNumId orElse isSymId
- val isLongId = L.all isId o S.fields (#"." <\ op =)
- val isLabel = isId orElse isNumLabel
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/ty.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ty.sml 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ty.sml 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,105 +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.
- *)
-
-structure Ty :> TY = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- (* SML/NJ workaround --> *)
-
- structure Product = struct
- datatype 'elem t = TIMES of 'elem t Sq.t
- | ELEM of 'elem
- | ISO_PRODUCT of 'elem t
- end
-
- structure Sum = struct
- datatype 'ty t = PLUS of 'ty t Sq.t
- | C0 of Generics.Con.t
- | C1 of Generics.Con.t * 'ty
- | ISO_SUM of 'ty t
- end
-
- structure Con0 = struct
- datatype t = BOOL | CHAR | EXN | FIXED_INT | INT | LARGE_INT
- | LARGE_REAL | LARGE_WORD | REAL | STRING | UNIT | WORD
- | WORD32 | WORD64 | WORD8
- end
-
- structure Con1 = struct
- datatype t = ARRAY | LIST | REF | VECTOR
- end
-
- structure Con2 = struct
- datatype t = ARROW
- end
-
- open Product Sum Con0 Con1 Con2
-
- datatype 'var t = DATA of 'var t Sum.t
- | CON0 of Con0.t
- | CON1 of Con1.t * 'var t
- | CON2 of Con2.t * 'var t Sq.t
- | FIX of 'var * 'var t
- | ISO of 'var t
- | RECORD of (Generics.Label.t * 'var t) Product.t
- | TUPLE of 'var t Product.t
- | VAR of 'var
-
- local
- fun product el =
- fn TIMES (l, r) => product el l orelse product el r
- | ELEM t => el t
- | ISO_PRODUCT p => product el p
- fun sum ty =
- fn PLUS (l, r) => sum ty l orelse sum ty r
- | C0 _ => false
- | C1 (_, t) => ty t
- | ISO_SUM t => sum ty t
- val rec ty =
- fn DATA s => sum ty s
- | CON0 c => c = EXN
- | CON1 (_, t) => ty t
- | CON2 (ARROW, _) => false
- | FIX (_, t) => ty t
- | ISO t => ty t
- | RECORD r => product (ty o #2) r
- | TUPLE t => product ty t
- | VAR _ => false
- in
- val mayContainExn = ty
- end
-
- local
- fun product el =
- fn TIMES (l, r) => product el l @ product el r
- | ELEM t => el t
- | ISO_PRODUCT p => product el p
- fun sum ty =
- fn PLUS (l, r) => sum ty l @ sum ty r
- | C0 _ => []
- | C1 (_, t) => ty t
- | ISO_SUM t => sum ty t
- val rec ty =
- fn DATA s => sum ty s
- | CON0 _ => []
- | CON1 (_, t) => ty t
- | CON2 (ARROW, _) => []
- | FIX (v, t) => List.filter (eq v) (ty t)
- | ISO t => ty t
- | RECORD r => product (ty o #2) r
- | TUPLE t => product ty t
- | VAR v => [v]
- in
- fun mayBeRecData t = not (null (ty t))
- end
-
- val isMutableType =
- fn CON1 (c, _) => ARRAY = c orelse REF = c
- | _ => false
-
- fun mayBeCyclic t =
- isMutableType t andalso (mayContainExn t orelse mayBeRecData t)
-end
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/util/generics-util.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/util/hash-map.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/hash-map.sml)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/util/hash-univ.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/hash-univ.sml)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/util/ops.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/ops.sml)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/util/opt-int.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/opt-int.sml)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/util/sml-syntax.sml (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml)
Deleted: mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/with-extra.fun 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,88 +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 WithExtra (Arg : GENERIC) : GENERIC_EXTRA = struct
- (* <-- SML/NJ workaround *)
- open TopLevel
- infix 7 *`
- infix 6 +` |`
- infix 0 & &`
- infixr 0 -->
- (* SML/NJ workaround --> *)
-
- open Generics Arg
-
- fun C0' n = C0 (C n)
- fun C1' n = C1 (C n)
- fun R' n = R (L n)
-
- local
- fun lift f a = SOME (f a) handle Match => NONE
- in
- fun regExn0' n e p = regExn0 (C n) (e, lift p)
- fun regExn1' n t e p = regExn1 (C n) t (e, lift p)
- end
-
- local
- fun mk t = iso (tuple t)
- in
- fun tuple2 (a, b) = mk (T a *` T b) Product.isoTuple2
- fun tuple3 (a, b, c) = mk (T a *` T b *` T c) Product.isoTuple3
- fun tuple4 (a, b, c, d) = mk (T a *` T b *` T c *` T d) Product.isoTuple4
- end
-
- local
- val fits = fn (SOME n, SOME m) => n <= m
- | _ => false
- fun mk precision int' fixed' large' =
- if fits (precision, Int.precision) then iso int int'
- else if fits (precision, FixedInt.precision) then iso fixedInt fixed'
- else iso largeInt large'
- in
- val int32 = let open Int32 in mk precision isoInt isoFixedInt isoLarge end
-(*
- val int64 = let open Int64 in mk precision isoInt isoFixedInt isoLarge end
-*)
- val position =
- let open Position in mk precision isoInt isoFixedInt isoLarge end
- end
-
- local
- val none = C "NONE"
- val some = C "SOME"
- in
- fun option a =
- iso (data (C0 none +` C1 some a))
- (fn NONE => INL () | SOME a => INR a,
- fn INL () => NONE | INR a => SOME a)
- end
-
- val order =
- iso (data (C0' "LESS" +` C0' "EQUAL" +` C0' "GREATER"))
- (fn LESS => INL (INL ())
- | EQUAL => INL (INR ())
- | GREATER => INR (),
- fn INL (INL ()) => LESS
- | INL (INR ()) => EQUAL
- | INR () => GREATER)
-
- local
- val et = C "&"
- in
- fun a &` b = data (C1 et (tuple (T a *` T b)))
- end
-
- local
- val inl = C "INL"
- val inr = C "INR"
- in
- fun a |` b = data (C1 inl a +` C1 inr b)
- end
-
- fun sq a = tuple2 (Sq.mk a)
- fun unOp a = a --> a
- fun binOp a = sq a --> a
-end
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-11-03 11:39:42 UTC (rev 6121)
@@ -9,7 +9,7 @@
$(MLTON_LIB)/com/ssh/prettier/unstable/lib.mlb
$(MLTON_LIB)/com/ssh/random/unstable/lib.mlb
- detail/hash-map.sml
+ detail/util/hash-map.sml
in
ann
"forceUsed"
@@ -22,59 +22,44 @@
(* Support *)
- public/generics.sig
+ public/framework/generics.sig
local
- detail/sml-syntax.sml
+ detail/util/sml-syntax.sml
in
- detail/generics.sml
+ detail/framework/generics.sml
end
- public/ty.sig
- detail/ty.sml
+ public/framework/ty.sig
+ detail/framework/ty.sml
(* Concepts *)
- public/closed-rep.sig
- public/closed-cases.sig
+ public/framework/closed-rep.sig
+ public/framework/closed-cases.sig
+ public/framework/open-rep.sig
+ public/framework/open-cases.sig
+ public/framework/cases.sig
+ public/framework/generic.sig
- public/open-rep.sig
- public/open-cases.sig
-
- public/cases.sig
-
- public/generic.sig
- public/generic-extra.sig
-
(* Utilities *)
- public/generics-util.sig
- detail/generics-util.sml
+ public/util/generics-util.sig
+ detail/util/generics-util.sml
+ detail/util/ops.sml
+ detail/util/opt-int.sml (* XXX Should really go to Extended Basis? *)
+ detail/util/hash-univ.sml
- detail/ops.sml
-
- detail/mk-closed-rep.fun
-
- detail/opt-int.sml (* XXX Should really go to Extended Basis? *)
-
- detail/hash-univ.sml
-
(* Framework *)
- detail/with-extra.fun
- ann "nonexhaustiveExnMatch ignore" in
- detail/reg-basis-exns.fun
- end
+ detail/framework/mk-closed-rep.fun
+ detail/framework/root-generic.sml
+ detail/framework/close-generic.fun
+ public/framework/layered-rep.sig
+ public/framework/layer-dep-cases-fun.sig
+ public/framework/layer-cases-fun.sig
+ public/framework/layer-rep-fun.sig
+ detail/framework/layer-generic.fun
- detail/root-generic.sml
-
- detail/close-generic.fun
-
- public/layered-rep.sig
- public/layer-dep-cases-fun.sig
- public/layer-cases-fun.sig
- public/layer-rep-fun.sig
- detail/layer-generic.fun
-
(* Values *)
public/value/type-info.sig
@@ -133,9 +118,16 @@
public/value/type-exp.sig
detail/value/type-exp.sml
- (* Convenience *)
+ (* Extra *)
- detail/close-pretty-with-extra.fun
+ public/extra/generic-extra.sig
+ detail/extra/with-extra.fun
+
+ detail/extra/close-pretty-with-extra.fun
+
+ ann "nonexhaustiveExnMatch ignore" in
+ detail/extra/reg-basis-exns.fun
+ end
in
public/export.sml
end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/cases.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/cases.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/cases.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,12 +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.
- *)
-
-(**
- * A base signature for the "cases" of generics.
- *)
-signature CASES = sig
- structure Open : OPEN_CASES
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,133 +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 for closed structural cases.
- *)
-signature CLOSED_CASES = sig
- structure Rep : CLOSED_REP
-
- (** == Support for User-Defined Types == *)
-
- val iso : 'b Rep.t -> ('a, 'b) Iso.t -> 'a Rep.t
- (**
- * Given a representation {'b Rep.t} and an isomorphism between {'a}
- * and {'b}, returns a representation {'a Rep.t}. The purpose of {iso}
- * is to support user-defined types.
- *)
-
- val isoProduct : ('b, 'k) Rep.p -> ('a, 'b) Iso.t -> ('a, 'k) Rep.p
- (**
- * Given a representation {('b, 'k) Rep.p} and an isomorphism between
- * {'a} and {'b}, returns a representation {('a, 'k) Rep.p}.
- *)
-
- val isoSum : 'b Rep.s -> ('a, 'b) Iso.t -> 'a Rep.s
- (**
- * Given a representation {'b Rep.s} and an isomorphism between {'a}
- * and {'b}, returns a representation {'a Rep.s}.
- *)
-
- (** == Support for Tuples and Records == *)
-
- val *` : ('a, 'k) Rep.p * ('b, 'k) Rep.p -> (('a, 'b) Product.t, 'k) Rep.p
- (**
- * Given representations for fields of type {'a} and {'b} of the same
- * kind {'k} (tuple or record), returns a representation for the
- * product {('a, 'b) Product.t}.
- *)
-
- val T : 'a Rep.t -> ('a, Generics.Tuple.t) Rep.p
- (** Specifies a field of a tuple. *)
-
- val R : Generics.Label.t -> 'a Rep.t -> ('a, Generics.Record.t) Rep.p
- (** Specifies a field of a record. *)
-
- val tuple : ('a, Generics.Tuple.t) Rep.p -> 'a Rep.t
- (** Specifies a tuple. *)
-
- val record : ('a, Generics.Record.t) Rep.p -> 'a Rep.t
- (** Specifies a record. *)
-
- (** == Support for Datatypes == *)
-
- val +` : 'a Rep.s * 'b Rep.s -> ('a, 'b) Sum.t Rep.s
- (**
- * Given representations for variants of type {'a} and {'b}, returns a
- * representation for the sum {('a, 'b) Sum.t}.
- *)
-
- val C0 : Generics.Con.t -> Unit.t Rep.s
- (** Specifies a nullary constructor. *)
-
- val C1 : Generics.Con.t -> 'a Rep.t -> 'a Rep.s
- (** Specifies a unary constructor. *)
-
- val data : 'a Rep.s -> 'a Rep.t
- (** Specifies a complete datatype. *)
-
- val unit : Unit.t Rep.t
- (**
- * Representation for the {unit} type. Using {unit} and {+} one can
- * actually encode {bool}, {word}, and much more.
- *)
-
- val Y : 'a Rep.t Tie.t
- (** Fixed-point tier to support recursive datatypes. *)
-
- (** == Support for Functions == *)
-
- val --> : 'a Rep.t * 'b Rep.t -> ('a -> 'b) Rep.t
-
- (** == Support for Exceptions == *)
-
- val exn : Exn.t Rep.t
- (** Universal representation for exceptions. *)
-
- val regExn0 : Generics.Con.t -> (Exn.t * (Exn.t -> Unit.t Option.t)) Effect.t
- (** Registers a nullary exception constructor. *)
-
- val regExn1 : Generics.Con.t -> 'a Rep.t -> ('a, Exn.t) Emb.t Effect.t
- (** Registers an unary exception constructor. *)
-
- (** == Support for Types With Identity == *)
-
- val array : 'a Rep.t -> 'a Array.t Rep.t
- val refc : 'a Rep.t -> 'a Ref.t Rep.t
-
- (** == Support for Functional Aggregate Types == *)
-
- val vector : 'a Rep.t -> 'a Vector.t Rep.t
-
- (** == Support for Arbitrary Integers, Words, And Reals == *)
-
- val fixedInt : FixedInt.t Rep.t
- val largeInt : LargeInt.t Rep.t
-
- val largeReal : LargeReal.t Rep.t
- val largeWord : LargeWord.t Rep.t
-
- (** == Support for Binary Data == *)
-
- val word8 : Word8.t Rep.t
- val word32 : Word32.t Rep.t
-(*
- val word64 : Word64.t Rep.t
-*)
-
- (** == Support for Some Built-In Type Constructors == *)
-
- val list : 'a Rep.t -> 'a List.t Rep.t
-
- (** == Support for Some Built-In Base Types == *)
-
- 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
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/closed-rep.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/closed-rep.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/closed-rep.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,14 +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 for the closed representation types of generics.
- *)
-signature CLOSED_REP = sig
- type 'a t (** Type of complete representations. *)
- type 'a s (** Type of incomplete sum representations. *)
- type ('a, 'k) p (** Type of incomplete product representations. *)
-end
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/extra/generic-extra.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/cases.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/cases.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/closed-cases.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/closed-cases.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/closed-rep.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/closed-rep.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/generic.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/generics.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-cases-fun.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/layer-cases-fun.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-dep-cases-fun.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/layer-rep-fun.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/layer-rep-fun.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/layered-rep.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/layered-rep.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/open-cases.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/open-cases.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/open-rep.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/open-rep.sig)
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/framework/ty.sig (from rev 6120, mltonlib/trunk/com/ssh/generic/unstable/public/ty.sig)
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic-extra.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,86 +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 for frequently used derived type representations.
- *)
-signature GENERIC_EXTRA = sig
- include GENERICS
- where type Label.t = Generics.Label.t
- where type Con.t = Generics.Con.t
- where type Record.t = Generics.Record.t
- where type Tuple.t = Generics.Tuple.t
- include GENERIC
-
- (** == Shorthands for Types with Labels or Constructors ==
- *
- * These should only be used for defining monomorphic representations.
- *)
-
- val C0' : String.t -> Unit.t Rep.s
- val C1' : String.t -> ('a, 'x) Open.Rep.t -> 'a Rep.s
-
- val R' : String.t -> ('a, 'x) Open.Rep.t -> ('a, Record.t) Rep.p
-
- val regExn0' : String.t -> Exn.t -> (Exn.t -> Unit.t) Effect.t
- val regExn1' : String.t -> ('a, 'x) Open.Rep.t
- -> ('a -> Exn.t) -> (Exn.t -> 'a) Effect.t
-
- (** == Tuples ==
- *
- * Note that these are provided for convenience --- generics are not
- * limited to these tuple arities. To encode an arbitrary n-tuple, use
- * the following pattern:
- *
- *> fun tupleN (t1, ..., tN) =
- *> iso (tuple (T t1 *` ... *` T tN))
- *> (fn (v1, ..., vN) => v1 & ... & vN,
- *> fn v1 & ... & vN => (v1, ..., vN))
- *)
-
- val tuple2 : ('a, 's) Open.Rep.t *
- ('b, 't) Open.Rep.t -> ('a * 'b) Rep.t
- val tuple3 : ('a, 's) Open.Rep.t *
- ('b, 't) Open.Rep.t *
- ('c, 'u) Open.Rep.t -> ('a * 'b * 'c) Rep.t
- val tuple4 : ('a, 's) Open.Rep.t *
- ('b, 't) Open.Rep.t *
- ('c, 'u) Open.Rep.t *
- ('d, 'v) Open.Rep.t -> ('a * 'b * 'c * 'd) Rep.t
-
- (** == Integer Types == *)
-
- val int32 : Int32.t Rep.t
-(*
- val int64 : Int64.t Rep.t
-*)
-
- val position : Position.t Rep.t
-
- (** == Some Standard Datatypes == *)
-
- val option : ('a, 'x) Open.Rep.t -> 'a Option.t Rep.t
- val order : Order.t Rep.t
-
- (** == Binary Sums and Products ==
- *
- * Note that the following are not the same as the {*`} and {+`}
- * combinators for encoding n-ary products and sums. Rather, the
- * following encode the particular general purpose binary product
- * and sum types provided by the Extended Basis library.
- *)
-
- val &` : ('a, 'x) Open.Rep.t *
- ('b, 'y) Open.Rep.t -> ('a, 'b) Product.t Rep.t
- val |` : ('a, 'x) Open.Rep.t *
- ('b, 'y) Open.Rep.t -> ('a, 'b) Sum.t Rep.t
-
- (** == Abbreviations for Common Types == *)
-
- val sq : ('a, 'x) Open.Rep.t -> 'a Sq.t Rep.t
- val unOp : ('a, 'x) Open.Rep.t -> 'a UnOp.t Rep.t
- val binOp : ('a, 'x) Open.Rep.t -> 'a BinOp.t Rep.t
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,53 +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.
- *)
-
-(**
- * Base signature for a module of directly usable generics.
- *)
-signature GENERIC = sig
- include CASES
- structure Rep : CLOSED_REP
- where type 'a t = ('a, Unit.t) Open.Rep.t
- where type 'a s = ('a, Unit.t) Open.Rep.s
- where type ('a, 'k) p = ('a, 'k, Unit.t) Open.Rep.p
- val iso : ('b, 'y) Open.Rep.t -> ('a, 'b) Iso.t -> 'a Rep.t
- val isoProduct : ('b, 'k, 'y) Open.Rep.p -> ('a, 'b) Iso.t -> ('a, 'k) Rep.p
- val isoSum : ('b, 'y) Open.Rep.s -> ('a, 'b) Iso.t -> 'a Rep.s
- val *` : ('a, 'k, 'x) Open.Rep.p * ('b, 'k, 'y) Open.Rep.p -> (('a, 'b) Product.t, 'k) Rep.p
- val T : ('a, 'x) Open.Rep.t -> ('a, Generics.Tuple.t) Rep.p
- val R : Generics.Label.t -> ('a, 'x) Open.Rep.t -> ('a, Generics.Record.t) Rep.p
- val tuple : ('a, Generics.Tuple.t, 'x) Open.Rep.p -> 'a Rep.t
- val record : ('a, Generics.Record.t, 'x) Open.Rep.p -> 'a Rep.t
- val +` : ('a, 'x) Open.Rep.s * ('b, 'y) Open.Rep.s -> ('a, 'b) Sum.t Rep.s
- val C0 : Generics.Con.t -> Unit.t Rep.s
- val C1 : Generics.Con.t -> ('a, 'x) Open.Rep.t -> 'a Rep.s
- val data : ('a, 'x) Open.Rep.s -> 'a Rep.t
- val unit : Unit.t Rep.t
- val Y : 'a Rep.t Tie.t
- val --> : ('a, 'x) Open.Rep.t * ('b, 'y) Open.Rep.t -> ('a -> 'b) Rep.t
- val exn : Exn.t Rep.t
- val regExn0 : Generics.Con.t -> (Exn.t * (Exn.t -> Unit.t Option.t)) Effect.t
- val regExn1 : Generics.Con.t -> ('a, 'x) Open.Rep.t -> ('a, Exn.t) Emb.t Effect.t
- val array : ('a, 'x) Open.Rep.t -> 'a Array.t Rep.t
- val refc : ('a, 'x) Open.Rep.t -> 'a Ref.t Rep.t
- val vector : ('a, 'x) Open.Rep.t -> 'a Vector.t Rep.t
- val fixedInt : FixedInt.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 word32 : Word32.t Rep.t
-(*
- val word64 : Word64.t Rep.t
-*)
- val list : ('a, 'x) Open.Rep.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
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generics-util.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,15 +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 for utilities for defining generics.
- *)
-signature GENERICS_UTIL = sig
- (** == For Defining Closed Generic Functions == *)
-
- val failExn : Exn.t -> 'a
- val failExnSq : Exn.t Sq.t -> 'a
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,26 +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 for supporting primitives required by generics.
- *)
-signature GENERICS = sig
- structure Label : sig
- eqtype t
- val toString : t -> String.t
- end
-
- structure Con : sig
- eqtype t
- val toString : t -> String.t
- end
-
- structure Record : T
- structure Tuple : T
-
- val L : String.t -> Label.t
- val C : String.t -> Con.t
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/layer-cases-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layer-cases-fun.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layer-cases-fun.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,15 +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 for the domain of the {LayerCases} functor.
- *)
-signature LAYER_CASES_DOM = sig
- include CASES LAYERED_REP CLOSED_CASES
- sharing Open.Rep = Outer
- sharing Rep = This
- val hole : 'a Rep.t Thunk.t
-end
Deleted: mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig 2007-11-02 18:02:49 UTC (rev 6120)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/layer-dep-cases-fun.sig 2007-11-03 11:39:42 UTC (rev 6121)
@@ -1,51 +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 for the domain of the {LayerDepCases} functor.
- *)
-signature LAYER_DEP_CASES_DOM = sig
- include CASES LAYERED_REP
- sharing Open.Rep = Outer
- val iso : ('b, 'y) t -> ('a, 'b) Iso.t -> 'a This.t
- val isoProduct : ('b, 'k, 'y) p -> ('a, 'b) Iso.t -> ('a, 'k) This.p
- val isoSum : ('b, 'y) s -> ('a, 'b) Iso.t -> 'a This.s
- val *` : ('a, 'k, 'x) p * ('b, 'k, 'y) p -> (('a, 'b) Product.t, 'k) This.p
- val T : ('a, 'x) t -> ('a, Generics.Tuple.t) This.p
- val R : Generics.Label.t -> ('a, 'x) t -> ('a, Generics.Record.t) This.p
- val tuple : ('a, Generics.Tuple.t, 'x) p -> 'a This.t
- val record : ('a, Generics.Record.t, 'x) p -> 'a This.t
- val +` : ('a, 'x) s * ('b, 'y) s -> ('a, 'b) Sum.t This.s
- val C0 : Generics.Con.t -> Unit.t This.s
- val C1 : Generics.Con.t -> ('a, 'x) t -> 'a This.s
- val data : ('a, 'x) s -> 'a This.t
- val unit : Unit.t Thi
More information about the MLton-commit
mailing list