[MLton-commit] r5821
Vesa Karvonen
vesak at mlton.org
Sun Aug 5 03:10:23 PDT 2007
Allow users to provide ad-hoc cases for Eq.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
U mltonlib/trunk/com/ssh/generic/unstable/public/value/eq.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-08-05 09:25:07 UTC (rev 5820)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-08-05 10:10:22 UTC (rev 5821)
@@ -10,19 +10,33 @@
infix 0 &
(* SML/NJ workaround --> *)
+ fun seq length sub eq (l, r) = let
+ val lL = length l
+ val lR = length r
+ fun lp i = let
+ val i = i-1
+ in
+ i < 0 orelse eq (sub (l, i), sub (r, i))
+ andalso lp i
+ end
+ in
+ lL = lR andalso lp lL
+ end
+
+ fun viaCast cast = BinPr.map cast op =
+
structure Eq =
LayerGenericRep (structure Outer = Arg.Rep
structure Closed = MkClosedGenericRep (BinPr))
- open Eq.This
+ val eq = Eq.This.getT
+ fun notEq t = not o eq t
+ fun withEq eq = Eq.This.mapT (const eq)
- val eq = getT
- fun notEq ? = negate (getT ?)
-
structure Layered = LayerGeneric
(structure Outer = Arg and Result = Eq and Rep = Eq.Closed
- fun iso b (a2b, _) = b o Pair.map (Sq.mk a2b)
+ fun iso b (a2b, _) = BinPr.map a2b b
val isoProduct = iso
val isoSum = iso
@@ -42,49 +56,34 @@
fun op --> _ = failing "Eq.--> unsupported"
- val exn : Exn.t Rep.t Ref.t = ref GenericsUtil.failExnSq
+ val exnHandler : Exn.t Rep.t Ref.t = ref GenericsUtil.failExnSq
fun regExn t (_, e2to) =
- Ref.modify (fn exn =>
+ Ref.modify (fn exnHandler =>
fn (l, r) =>
case e2to l & e2to r of
- NONE & NONE => exn (l, r)
+ NONE & NONE => exnHandler (l, r)
| SOME l & SOME r => t (l, r)
- | _ => false) exn
- val exn = fn ? => !exn ?
+ | _ => false) exnHandler
+ fun exn ? = !exnHandler ?
val list = ListPair.allEq
- fun seq length sub eq (l, r) = let
- val lL = length l
- val lR = length r
- fun lp i = let
- val i = i-1
- in
- i < 0 orelse eq (sub (l, i), sub (r, i))
- andalso lp i
- end
- in
- lL = lR andalso lp lL
- end
-
fun vector ? = seq Vector.length Vector.sub ?
+
fun array _ = op =
+ fun refc _ = op =
- fun refc _ = op =
-
val largeInt = op =
+ val largeReal = viaCast CastLargeReal.castToWord
val largeWord = op =
val bool = op =
val char = op =
val int = op =
+ val real = viaCast CastReal.castToWord
val string = op =
val word = op =
- fun mk cast = BinPr.map cast op =
- val largeReal = mk CastLargeReal.castToWord
- val real = mk CastReal.castToWord
-
val word8 = op =
val word32 = op =
val word64 = op =)
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/eq.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/eq.sig 2007-08-05 09:25:07 UTC (rev 5820)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/eq.sig 2007-08-05 10:10:22 UTC (rev 5821)
@@ -5,27 +5,27 @@
*)
(**
- * Signature for a generic equality relation.
+ * Signature for a generic equality predicate.
*
- * For equality types the semantics is the same as SML's equality. For
- * mutable types (refs and arrays) this means that two objects are
- * considered equal iff they have the same identity. This means that the
- * result of comparing two particular mutable objects is invariant. If
- * you truly need a structural equality relation for mutable types that
- * ignores identity, see {ORD}.
+ * By default, for equality types the semantics is the same as SML's
+ * equality. For mutable types (refs and arrays) this means that two
+ * objects are considered equal iff they have the same identity. This
+ * means that the result of comparing two particular mutable objects is
+ * invariant. If you truly need a structural equality relation for
+ * mutable types that ignores identity, see {ORD}.
*
- * The comparison of reals is done bitwise. While this matches the notion
- * of equality provided for other types, this differs from the notions of
- * equality provided for reals by the Basis Library. In particular,
- * {~0.0} and {0.0} are considered unequal and {nan} is considered equal
- * to {nan}. This treatment is important for a number of non-numerical
- * applications such as serialization.
+ * By default, the comparison of reals is done bitwise. While this
+ * matches the notion of equality provided for other types, this differs
+ * from the notions of equality provided for reals by the Basis Library.
+ * In particular, {~0.0} and {0.0} are considered unequal and {nan} is
+ * considered equal to {nan}. This treatment is important for a number of
+ * non-numerical applications such as serialization.
*
- * User defined datatypes and exceptions are given a structural semantics
- * of equality. Specifically, two datatype or exception values are
- * considered equal iff they have the same constructor and the arguments
- * of the constructors are considered equal. Of course, all of this is
- * modulo user specified morphisms!
+ * By default, user defined datatypes and exceptions are given a
+ * structural semantics of equality. Specifically, two datatype or
+ * exception values are considered equal iff they have the same
+ * constructor and the arguments of the constructors are considered equal.
+ * Of course, all of this is modulo user specified morphisms!
*
* Comparison of exceptions only works when at least one of the exception
* constructors involved in a comparison has been registered with
@@ -41,6 +41,9 @@
val notEq : ('a, 'x) Eq.t -> 'a BinPr.t
(** {notEq t = not o eq t} *)
+
+ val withEq : 'a BinPr.t -> ('a, 'x) Eq.t UnOp.t
+ (** Functionally updates the equality predicate. *)
end
signature EQ_GENERIC = sig
More information about the MLton-commit
mailing list