[MLton-commit] r5829
Vesa Karvonen
vesak at mlton.org
Tue Aug 7 01:00:51 PDT 2007
Added experimental generic for creating transforms.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
A mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
U mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
U mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
A mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-08-07 06:35:15 UTC (rev 5828)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ml/smlnj/unsealed.cm 2007-08-07 08:00:50 UTC (rev 5829)
@@ -31,6 +31,7 @@
../../../public/value/pretty.sig
../../../public/value/reduce.sig
../../../public/value/some.sig
+ ../../../public/value/transform.sig
../../../public/value/type-info.sig
../../close-generic.fun
../../generics-util.sml
@@ -49,6 +50,7 @@
../../value/pretty.sml
../../value/reduce.sml
../../value/some.sml
+ ../../value/transform.sml
../../value/type-info.sml
../../with-extra.fun
extensions.cm
Added: mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2007-08-07 06:35:15 UTC (rev 5828)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml 2007-08-07 08:00:50 UTC (rev 5829)
@@ -0,0 +1,71 @@
+(* 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 WithTransform (Arg : OPEN_GENERIC) : TRANSFORM_GENERIC = struct
+ (* <-- SML/NJ workaround *)
+ open TopLevel
+ (* SML/NJ workaround --> *)
+
+ structure Transform = LayerGenericRep
+ (structure Outer = Arg.Rep
+ structure Closed = MkClosedRep (UnOp))
+
+ fun makeTransform a2a tA tA2tB = let
+ val tA = Transform.This.mapT (const a2a) tA
+ val tB = tA2tB tA
+ in
+ Transform.This.getT tB
+ end
+
+ structure Layered = LayerGeneric
+ (structure Outer = Arg and Result = Transform and Rep = Transform.Closed
+
+ fun iso rB aIb = Fn.map aIb rB
+ val isoProduct = iso
+ val isoSum = iso
+
+ val op *` = Product.map
+ val T = id
+ fun R _ = id
+ val tuple = id
+ val record = id
+
+ val op +` = Sum.map
+ val unit = id
+ fun C0 _ = unit
+ fun C1 _ = id
+ val data = id
+
+ val Y = Tie.function
+
+ fun op --> _ = failing "Transform.--> not yet implemented"
+
+ fun regExn _ _ = ()
+ fun exn _ = fail "Transform.exn not yet implemented"
+
+ val list = List.map
+ val vector = Vector.map
+
+ fun array tA x = (Array.modify tA x ; x)
+ fun refc tA x = (Ref.modify tA x ; x)
+
+ val largeInt = id
+ val largeReal = id
+ val largeWord = id
+
+ val bool = id
+ val char = id
+ val int = id
+ val real = id
+ val string = id
+ val word = id
+
+ val word8 = id
+ val word32 = id
+ val word64 = id)
+
+ open Layered
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/detail/value/transform.sml
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: mltonlib/trunk/com/ssh/generic/unstable/lib.mlb
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-08-07 06:35:15 UTC (rev 5828)
+++ mltonlib/trunk/com/ssh/generic/unstable/lib.mlb 2007-08-07 08:00:50 UTC (rev 5829)
@@ -94,6 +94,9 @@
public/value/reduce.sig
detail/value/reduce.sml
+
+ public/value/transform.sig
+ detail/value/transform.sml
in
public/export.sml
end
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-08-07 06:35:15 UTC (rev 5828)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml 2007-08-07 08:00:50 UTC (rev 5829)
@@ -53,6 +53,9 @@
signature SOME = SOME
signature SOME_GENERIC = SOME_GENERIC
+signature TRANSFORM = TRANSFORM
+signature TRANSFORM_GENERIC = TRANSFORM_GENERIC
+
signature TYPE_INFO = TYPE_INFO
signature TYPE_INFO_GENERIC = TYPE_INFO_GENERIC
@@ -165,5 +168,8 @@
signature WITH_SOME_DOM = WITH_SOME_DOM
functor WithSome (Arg : WITH_SOME_DOM) : SOME_GENERIC = WithSome (Arg)
+functor WithTransform (Arg : OPEN_GENERIC) : TRANSFORM_GENERIC =
+ WithTransform (Arg)
+
functor WithTypeInfo (Arg : OPEN_GENERIC) : TYPE_INFO_GENERIC =
WithTypeInfo (Arg)
Added: mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig 2007-08-07 06:35:15 UTC (rev 5828)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig 2007-08-07 08:00:50 UTC (rev 5829)
@@ -0,0 +1,37 @@
+(* 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 generic for making transform operations.
+ *
+ * By default, mutable values, references and arrays, are modified
+ * in-place.
+ *
+ * Examples:
+ *
+ *> - makeTransform (fn x => x + 1) int list [1, 2, 3] ;
+ *> val it = [2, 3, 4] : Int.t List.t
+ *
+ *> - makeTransform op ~ int (fn t => tuple (T int *` T t)) (1 & 3) ;
+ *> val it = (1 & ~3) : (Int.t, Int.t) Product.t
+ *
+ * This design is experimental.
+ *)
+signature TRANSFORM = sig
+ structure Transform : OPEN_GENERIC_REP
+
+ val makeTransform :
+ 'a UnOp.t
+ -> ('a, 'x) Transform.t
+ -> (('a, 'x) Transform.t -> ('b, 'y) Transform.t)
+ -> 'b UnOp.t
+ (** Creates a transform operation. *)
+end
+
+signature TRANSFORM_GENERIC = sig
+ include OPEN_GENERIC TRANSFORM
+ sharing Rep = Transform
+end
Property changes on: mltonlib/trunk/com/ssh/generic/unstable/public/value/transform.sig
___________________________________________________________________
Name: svn:eol-style
+ native
More information about the MLton-commit
mailing list