[MLton-commit] r5586
Vesa Karvonen
vesak at mlton.org
Tue Jun 5 10:47:09 PDT 2007
Working on making generics into a separate library.
----------------------------------------------------------------------
A mltonlib/trunk/com/ssh/generic/
A mltonlib/trunk/com/ssh/generic/unstable/
A mltonlib/trunk/com/ssh/generic/unstable/LICENSE
A mltonlib/trunk/com/ssh/generic/unstable/detail/
A mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/lifting.sml
A mltonlib/trunk/com/ssh/generic/unstable/detail/pair-generics.fun
A mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml
A mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
A mltonlib/trunk/com/ssh/generic/unstable/public/
A mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
A mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/generic-lifting.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig
A mltonlib/trunk/com/ssh/generic/unstable/public/lifting.sig
----------------------------------------------------------------------
Copied: mltonlib/trunk/com/ssh/generic/unstable/LICENSE (from rev 5583, mltonlib/trunk/com/ssh/misc-util/unstable/LICENSE)
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml (from rev 5583, mltonlib/trunk/com/ssh/misc-util/unstable/type-support.sml)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/type-support.sml 2007-06-04 16:57:26 UTC (rev 5583)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/generics.sml 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,24 @@
+(* 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
+ 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
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/lifting.sml (from rev 5583, mltonlib/trunk/com/ssh/misc-util/unstable/lift.sml)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/lift.sml 2007-06-04 16:57:26 UTC (rev 5583)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/lifting.sml 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,21 @@
+(* 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 Lifting :> LIFTING = struct
+ datatype ('t, 'u) t = IN of {get : 'u -> 't, update : 't UnOp.t -> 'u UnOp.t}
+ fun out (IN t) = t
+
+ val id = IN {get = id, update = id}
+
+ fun get lifting = op o /> #get (out (lifting ()))
+ fun update lifting = #update (out (lifting ()))
+
+ val F = IN {get = Pair.fst, update = Pair.mapFst}
+ val S = IN {get = Pair.snd, update = Pair.mapSnd}
+
+ fun (IN {get = gF, update = uF}) ^ (IN {get = gS, update = uS}) =
+ IN {get = gS o gF, update = uF o uS}
+end
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/pair-generics.fun (from rev 5583, mltonlib/trunk/com/ssh/misc-util/unstable/type-pair.fun)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/type-pair.fun 2007-06-04 16:57:26 UTC (rev 5583)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/pair-generics.fun 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,69 @@
+(* 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 PairGenerics (structure F : GENERIC
+ structure S : GENERIC) : GENERIC = struct
+ structure Index = struct
+ type 'a t = 'a F.Index.t * 'a S.Index.t
+ type 'a s = 'a F.Index.s * 'a S.Index.s
+ type ('a, 'b) p = ('a, 'b) F.Index.p * ('a, 'b) S.Index.p
+ end
+
+ local
+ fun mk aIso bIso (a, b) i = (aIso a i, bIso b i)
+ in
+ fun iso ? = mk F.iso S.iso ?
+ fun isoProduct ? = mk F.isoProduct S.isoProduct ?
+ fun isoSum ? = mk F.isoSum S.isoSum ?
+ end
+
+ local
+ fun mk t = Pair.map t o Pair.swizzle
+ in
+ fun op *` ? = mk (F.*`, S.*`) ?
+ fun op +` ? = mk (F.+`, S.+`) ?
+ fun op --> ? = mk (F.-->, S.-->) ?
+ end
+
+ fun T ? = Pair.map (F.T, S.T) ?
+ fun R ? = Pair.map (F.R ?, S.R ?)
+
+ fun C0 ? = (F.C0 ?, S.C0 ?)
+ fun C1 ? = Pair.map (F.C1 ?, S.C1 ?)
+
+ fun Y ? = Tie.tuple2 (F.Y, S.Y) ?
+
+ val exn = (F.exn, S.exn)
+ fun regExn (a, b) emb = (F.regExn a emb ; S.regExn b emb)
+
+ fun tuple ? = Pair.map (F.tuple, S.tuple) ?
+ fun record ? = Pair.map (F.record, S.record) ?
+ fun data ? = Pair.map (F.data, S.data) ?
+
+ fun array ? = Pair.map (F.array, S.array) ?
+ fun refc ? = Pair.map (F.refc, S.refc) ?
+
+ fun vector ? = Pair.map (F.vector, S.vector) ?
+
+ fun list ? = Pair.map (F.list, S.list) ?
+
+ val bool = (F.bool, S.bool)
+ val char = (F.char, S.char)
+ val int = (F.int, S.int)
+ val real = (F.real, S.real)
+ val string = (F.string, S.string)
+ val unit = (F.unit, S.unit)
+ val word = (F.word, S.word)
+
+ val largeInt = (F.largeInt, S.largeInt)
+ val largeReal = (F.largeReal, S.largeReal)
+ val largeWord = (F.largeWord, S.largeWord)
+
+ val word8 = (F.word8, S.word8)
+ val word16 = (F.word16, S.word16)
+ val word32 = (F.word32, S.word32)
+ val word64 = (F.word64, S.word64)
+end
Copied: mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml (from rev 5583, mltonlib/trunk/com/ssh/misc-util/unstable/sml-syntax.sml)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/sml-syntax.sml 2007-06-04 16:57:26 UTC (rev 5583)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/sml-syntax.sml 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,34 @@
+(* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * 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
+ 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
Added: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-04 18:24:21 UTC (rev 5585)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,36 @@
+(* 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.
+ *)
+
+local
+ $(MLTON_LIB)/com/ssh/extended-basis/unstable/basis.mlb
+in
+ ann
+ "forceUsed"
+ "sequenceNonUnit warn"
+ "warnUnused true"
+ in
+ local
+ public/generics.sig
+ local
+ detail/sml-syntax.sml
+ in
+ detail/generics.sml
+ end
+
+ public/generic-index.sig
+ public/generic.sig
+
+ public/lifting.sig
+ detail/lifting.sml
+
+ public/generic-lifting.sig
+
+ detail/pair-generics.fun
+ in
+ public/export.sml
+ end
+ end
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-04 18:24:21 UTC (rev 5585)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,25 @@
+(* 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.
+ *)
+
+(** == Exported Signatures == *)
+
+signature GENERIC = GENERIC
+signature GENERICS = GENERICS
+signature GENERIC_INDEX = GENERIC_INDEX
+signature GENERIC_LIFTING = GENERIC_LIFTING
+signature LIFTING = LIFTING
+
+(** == Exported Structures == *)
+
+structure Generics : GENERICS = Generics
+structure Lifting : LIFTING = Lifting
+
+(** == Exported Functors == *)
+
+functor PairGenerics (Arg : sig
+ structure F : GENERIC
+ structure S : GENERIC
+ end) : GENERIC = PairGenerics (Arg)
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig 2007-06-04 18:24:21 UTC (rev 5585)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,19 @@
+(* 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 types of type-indices of generic functions.
+ *)
+signature GENERIC_INDEX = sig
+ type 'a t
+ (** Type of complete type-indices. *)
+
+ type 'a s
+ (** Type of incomplete sum type-indices. *)
+
+ type ('a, 'k) p
+ (** Type of incomplete product type-indices. *)
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/generic-index.sig
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/com/ssh/generic/unstable/public/generic-lifting.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generic-lifting.sig 2007-06-04 18:24:21 UTC (rev 5585)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic-lifting.sig 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,22 @@
+(* 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 liftings of generic functions.
+ *)
+signature GENERIC_LIFTING = sig
+ structure Element : GENERIC_INDEX
+ (** The element of the combined type-index. *)
+
+ structure Of : GENERIC_INDEX
+ (** The combined type-index. *)
+
+ val lifting : ('a Element.t, 'a Of.t) Lifting.t Thunk.t
+ (**
+ * The lifting index for lifting operations on values of the element
+ * type to operations on the elements of the combined type.
+ *)
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/generic-lifting.sig
___________________________________________________________________
Name: svn:eol-style
+ native
Copied: mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig (from rev 5583, mltonlib/trunk/com/ssh/misc-util/unstable/type.sig)
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/type.sig 2007-06-04 16:57:26 UTC (rev 5583)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generic.sig 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,129 @@
+(* 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 signature for type-indexed values based on a generic representation
+ * of datatypes.
+ *)
+signature GENERIC = sig
+ structure Index : GENERIC_INDEX
+
+ (** == SUPPORT FOR USER-DEFINED TYPES == *)
+
+ val iso : 'b Index.t -> ('a, 'b) Iso.t -> 'a Index.t
+ (**
+ * Given a type-index {'b Index.t} and an isomorphism between {'a} and
+ * {'b}, returns a type-index {'a Index.t}. The purpose of {iso} is to
+ * support user-defined types.
+ *)
+
+ val isoProduct : ('b, 'k) Index.p -> ('a, 'b) Iso.t -> ('a, 'k) Index.p
+ (**
+ * Given a type-index {('b, 'k) Index.p} and an isomorphism between
+ * {'a} and {'b}, returns a type-index {('a, 'k) Index.p}.
+ *)
+
+ val isoSum : 'b Index.s -> ('a, 'b) Iso.t -> 'a Index.s
+ (**
+ * Given a type-index {'b Index.s} and an isomorphism between {'a} and
+ * {'b}, returns a type-index {'a Index.s}.
+ *)
+
+ (** == SUPPORT FOR TUPLES AND RECORDS == *)
+
+ val *` :
+ ('a, 'k) Index.p * ('b, 'k) Index.p -> (('a, 'b) Product.t, 'k) Index.p
+ (**
+ * Given type-indices for fields of type {'a} and {'b} of the same kind
+ * {'k} (tuple or record), returns a type-index for the product {('a,
+ * 'b) Product.t}.
+ *)
+
+ val T : 'a Index.t -> ('a, Generics.Tuple.t) Index.p
+ (** Specifies a field of a tuple. *)
+
+ val R : Generics.Label.t -> 'a Index.t -> ('a, Generics.Record.t) Index.p
+ (** Specifies a field of a record. *)
+
+ val tuple : ('a, Generics.Tuple.t) Index.p -> 'a Index.t
+ (** Specifies a tuple. *)
+
+ val record : ('a, Generics.Record.t) Index.p -> 'a Index.t
+ (** Specifies a record. *)
+
+ (** == SUPPORT FOR DATATYPES == *)
+
+ val +` : 'a Index.s * 'b Index.s -> (('a, 'b) Sum.t) Index.s
+ (**
+ * Given type-indices for variants of type {'a} and {'b}, returns a
+ * type-index for the sum {('a, 'b) Sum.t}.
+ *)
+
+ val C0 : Generics.Con.t -> Unit.t Index.s
+ (** Specifies a nullary constructor. *)
+
+ val C1 : Generics.Con.t -> 'a Index.t -> 'a Index.s
+ (** Specifies a unary constructor. *)
+
+ val data : 'a Index.s -> 'a Index.t
+ (** Specifies a complete datatype. *)
+
+ val unit : Unit.t Index.t
+ (**
+ * Type-index for the {unit} type. Using {unit} and {+} one can
+ * actually encode {bool}, {word}, and much more.
+ *)
+
+ val Y : 'a Index.t Tie.t
+ (** Fixpoint tier to support recursive datatypes. *)
+
+ (** == SUPPORT FOR FUNCTIONS == *)
+
+ val --> : 'a Index.t * 'b Index.t -> ('a -> 'b) Index.t
+
+ (** == SUPPORT FOR EXCEPTIONS == *)
+
+ val exn : Exn.t Index.t
+ (** Universal type-index for exceptions. *)
+
+ val regExn : 'a Index.s -> ('a, Exn.t) Emb.t Effect.t
+ (** Registers a handler for exceptions. *)
+
+ (** == SUPPORT FOR TYPES WITH IDENTITY == *)
+
+ val array : 'a Index.t -> 'a Array.t Index.t
+ val refc : 'a Index.t -> 'a Ref.t Index.t
+
+ (** == SUPPORT FOR FUNCTIONAL AGGREGATE TYPES == *)
+
+ val vector : 'a Index.t -> 'a Vector.t Index.t
+
+ (** == SUPPORT FOR ARBITRARY INTEGERS, WORDS, AND REALS == *)
+
+ val largeInt : LargeInt.t Index.t
+ val largeReal : LargeReal.t Index.t
+ val largeWord : LargeWord.t Index.t
+
+ (** == SUPPORT FOR BINARY DATA == *)
+
+ val word8 : Word8.t Index.t
+ val word16 : Word16.t Index.t
+ val word32 : Word32.t Index.t
+ val word64 : Word64.t Index.t
+
+ (** == SUPPORT FOR SOME BUILT-IN TYPE CONSTRUCTORS == *)
+
+ val list : 'a Index.t -> 'a List.t Index.t
+
+ (** == SUPPORT FOR SOME BUILT-IN BASE TYPES == *)
+
+ val bool : Bool.t Index.t
+ val char : Char.t Index.t
+ val int : Int.t Index.t
+ val real : Real.t Index.t
+ val string : String.t Index.t
+ val word : Word.t Index.t
+end
Added: mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig 2007-06-04 18:24:21 UTC (rev 5585)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,31 @@
+(* 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 : sig
+ type t
+ end
+
+ structure Tuple : sig
+ type t
+ end
+
+ val L : String.t -> Label.t
+ val C : String.t -> Con.t
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/generics.sig
___________________________________________________________________
Name: svn:eol-style
+ native
Added: mltonlib/trunk/com/ssh/generic/unstable/public/lifting.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/lifting.sig 2007-06-04 18:24:21 UTC (rev 5585)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/lifting.sig 2007-06-05 17:47:07 UTC (rev 5586)
@@ -0,0 +1,38 @@
+(* 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 combinators for lifting functions on values to functions
+ * on the leaf elements of nested structures of pairs. The user specifies
+ * the path to a leaf element of a nested structure of pairs to get a
+ * lifting index.
+ *)
+signature LIFTING = sig
+ type ('element, 'of) t
+ (** The type of lifting indices. *)
+
+ (** == Lifting Operations == *)
+
+ val get : ('a, 'b) t Thunk.t -> ('a -> 'c) -> 'b -> 'c
+ (** Lift a get operation. *)
+
+ val update : ('a, 'b) t Thunk.t -> 'a UnOp.t -> 'b UnOp.t
+ (** Lift an update operation. *)
+
+ (** == Creating Liftings == *)
+
+ val id : ('a, 'a) t
+ (** The identity lifting. *)
+
+ val F : ('a, 'a * 'b) t
+ (** Choose the first element of a pair. *)
+
+ val S : ('b, 'a * 'b) t
+ (** Choose the second element of a pair. *)
+
+ val ^ : ('m, 'u) t * ('t, 'm) t -> ('t, 'u) t
+ (** Concatenation of paths. *)
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/lifting.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list