[MLton-commit] r6349
Vesa Karvonen
vesak at mlton.org
Mon Jan 21 14:20:20 PST 2008
Added StaticSum : STATIC_SUM.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
A mltonlib/trunk/com/ssh/extended-basis/unstable/detail/typing/static-sum.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
U mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
A mltonlib/trunk/com/ssh/extended-basis/unstable/public/typing/static-sum.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm 2008-01-21 22:08:04 UTC (rev 6348)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/sigs.cm 2008-01-21 22:20:18 UTC (rev 6349)
@@ -89,5 +89,6 @@
../../../public/text/text.sig
../../../public/time/time.sig
../../../public/typing/phantom.sig
+ ../../../public/typing/static-sum.sig
../../fold/fold.sml
bootstrap.cm
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm 2008-01-21 22:08:04 UTC (rev 6348)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/ml/smlnj/unsealed.cm 2008-01-21 22:20:18 UTC (rev 6349)
@@ -82,6 +82,7 @@
../../../detail/text/mk-text-ext.fun
../../../detail/time/time.sml
../../../detail/typing/phantom.sml
+ ../../../detail/typing/static-sum.sml
../../../public/lazy/lazy.sig
ext.sml
sigs.cm
Added: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/typing/static-sum.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/typing/static-sum.sml 2008-01-21 22:08:04 UTC (rev 6348)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/typing/static-sum.sml 2008-01-21 22:20:18 UTC (rev 6349)
@@ -0,0 +1,15 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+structure StaticSum :> STATIC_SUM = struct
+ type ('a, 'b, 'c, 'd, 'e) t = ('a -> 'b) * ('c -> 'd) -> 'e
+ fun inL a (a2b, _) = a2b a
+ fun inR c (_, c2d) = c2d c
+ fun match x = x
+ fun split x = x (fn x => (inL x, inL x),
+ fn x => (inR x, inR x))
+ fun out x = x (match, match)
+end
Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/typing/static-sum.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2008-01-21 22:08:04 UTC (rev 6348)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.mlb 2008-01-21 22:20:18 UTC (rev 6349)
@@ -49,6 +49,8 @@
(* Typing *)
public/typing/phantom.sig
detail/typing/phantom.sml
+ public/typing/static-sum.sig
+ detail/typing/static-sum.sml
(* Concept signatures *)
public/concept/bitwise.sig
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use 2008-01-21 22:08:04 UTC (rev 6348)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/extensions.use 2008-01-21 22:20:18 UTC (rev 6349)
@@ -11,6 +11,8 @@
"detail/ml/${SML_COMPILER}/extensions.use",
"public/typing/phantom.sig",
"detail/typing/phantom.sml",
+ "public/typing/static-sum.sig",
+ "detail/typing/static-sum.sml",
"public/concept/bitwise.sig",
"public/concept/bounded.sig",
"public/concept/cased.sig",
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml 2008-01-21 22:08:04 UTC (rev 6348)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/export/common.sml 2008-01-21 22:20:18 UTC (rev 6349)
@@ -99,6 +99,7 @@
signature RESIZABLE_ARRAY = RESIZABLE_ARRAY
signature SHIFT_OP = SHIFT_OP
signature SQ = SQ
+signature STATIC_SUM = STATIC_SUM
signature STREAM = STREAM
signature STRING = STRING
signature SUBSTRING = SUBSTRING
@@ -183,6 +184,7 @@
structure Ref : REF where type 'a t = 'a ref = Ref
structure ResizableArray : RESIZABLE_ARRAY = ResizableArray
structure ShiftOp : SHIFT_OP = ShiftOp
+structure StaticSum : STATIC_SUM = StaticSum
structure Stream : STREAM = Stream
structure String : STRING = String
structure Substring : SUBSTRING = Substring
Added: mltonlib/trunk/com/ssh/extended-basis/unstable/public/typing/static-sum.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/typing/static-sum.sig 2008-01-21 22:08:04 UTC (rev 6348)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/typing/static-sum.sig 2008-01-21 22:20:18 UTC (rev 6349)
@@ -0,0 +1,73 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+(**
+ * A static sum allows one to make choices at the type level.
+ *
+ * As an example, consider the following function:
+ *
+ *> fun succ x =
+ *> match x (fn i => i + 1,
+ *> fn r => r + 1.0)
+ *
+ * Now,
+ *
+ *> succ (inL 2) = 3
+ *> succ (inR 1.5) = 2.5
+ *
+ * In other words, {succ} is a function that is given a static sum that
+ * holds either an int or a real. {succ} then returns the value plus 1.
+ *
+ * The design is mostly copied from Stephen Weeks.
+ *)
+signature STATIC_SUM = sig
+ type ('l_dom, 'l_cod, 'r_dom, 'r_cod, 'result) t
+ (** The type of static sums. *)
+
+ val inL : 'a -> ('a, 'b, 'c, 'd, 'b) t
+ (** Injects the given value to a static sum as the left element. *)
+
+ val inR : 'c -> ('a, 'b, 'c, 'd, 'd) t
+ (** Injects the given value to a static sum as the right element. *)
+
+ val match : ('a, 'b, 'c, 'd, 'e) t -> ('a -> 'b) * ('c -> 'd) -> 'e
+ (**
+ * Performs case analysis on the given static sum. {match} satisfies
+ * the following laws:
+ *
+ *> match (inL x) (f, g) = f x
+ *> match (inR x) (f, g) = g x
+ *)
+
+ val split : ('a,
+ ('a, 'b, 'c, 'd, 'b) t * ('a, 'e, 'f, 'g, 'e) t, 'h,
+ ('i, 'j, 'h, 'k, 'k) t * ('l, 'm, 'h, 'n, 'n) t, 'o) t -> 'o
+ (**
+ * Splits a given static sum into two "branches" that can be assigned
+ * types independently. {split} satisfies the following laws:
+ *
+ *> split (inL x) = (inL x, inL x)
+ *> split (inR x) = (inR x, inR x)
+ *
+ * {split} is not primitive, it can be implemented as:
+ *
+ *> fun split x = match x (fn x => (inL x, inL x),
+ *> fn x => (inR x, inR x))
+ *)
+
+ val out : ('a, 'a, 'b, 'b, 'c) t -> 'c
+ (**
+ * Extracts the value from the given static sum. {out} satisfies the
+ * following laws:
+ *
+ *> out (inL x) = x
+ *> out (inR x) = x
+ *
+ * {out} is not primitive, it can be implemented as:
+ *
+ *> fun out s = match s (id, id)
+ *)
+end
Property changes on: mltonlib/trunk/com/ssh/extended-basis/unstable/public/typing/static-sum.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list