[MLton-commit] r5972
Vesa Karvonen
vesak at mlton.org
Tue Aug 28 04:04:22 PDT 2007
Only structural cases in the argument to Layer[Dep]Cases.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-08-28 10:59:03 UTC (rev 5971)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml 2007-08-28 11:04:21 UTC (rev 5972)
@@ -23,6 +23,15 @@
lL = lR andalso lp lL
end
+ val exnHandler : Exn.t BinPr.t Ref.t = ref GenericsUtil.failExnSq
+ fun regExn t (_, e2to) =
+ Ref.modify (fn exnHandler =>
+ fn (l, r) =>
+ case e2to l & e2to r
+ of NONE & NONE => exnHandler (l, r)
+ | SOME l & SOME r => t (l, r)
+ | _ => false) exnHandler
+
structure Eq = LayerRep
(structure Outer = Arg.Rep
structure Closed = MkClosedRep (BinPr))
@@ -56,17 +65,9 @@
fun op --> _ = failing "Eq.--> unsupported"
- val exnHandler : Exn.t Rep.t Ref.t = ref GenericsUtil.failExnSq
- fun regExn t (_, e2to) =
- Ref.modify (fn exnHandler =>
- fn (l, r) =>
- case e2to l & e2to r
- of NONE & NONE => exnHandler (l, r)
- | SOME l & SOME r => t (l, r)
- | _ => false) exnHandler
+ fun exn ? = !exnHandler ?
fun regExn0 _ = regExn unit
fun regExn1 _ = regExn
- fun exn ? = !exnHandler ?
val list = ListPair.allEq
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-08-28 10:59:03 UTC (rev 5971)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml 2007-08-28 11:04:21 UTC (rev 5972)
@@ -41,6 +41,16 @@
else t (to (l, r)::e, (l, r))
end
+ val exns : (e * Exn.t Sq.t -> (e * Order.t) Option.t) Buffer.t = Buffer.new ()
+ fun regExn aO (_, e2a) =
+ (Buffer.push exns)
+ (fn (e, (l, r)) =>
+ case e2a l & e2a r
+ of SOME l & SOME r => SOME (aO (e, (l, r)))
+ | SOME _ & NONE => SOME (e, GREATER)
+ | NONE & SOME _ => SOME (e, LESS)
+ | NONE & NONE => NONE)
+
structure Ord = LayerRep
(structure Outer = Arg.Rep
structure Closed = MkClosedRep (type 'a t = 'a t))
@@ -81,19 +91,10 @@
fun op --> _ = failing "Ord.--> unsupported"
- val exns : (e * Exn.t Sq.t -> (e * Order.t) Option.t) Buffer.t = Buffer.new ()
fun exn (e, lr) =
case Buffer.findSome (pass (e, lr)) exns
of NONE => GenericsUtil.failExnSq lr
| SOME r => r
- fun regExn aO (_, e2a) =
- (Buffer.push exns)
- (fn (e, (l, r)) =>
- case e2a l & e2a r
- of SOME l & SOME r => SOME (aO (e, (l, r)))
- | SOME _ & NONE => SOME (e, GREATER)
- | NONE & SOME _ => SOME (e, LESS)
- | NONE & NONE => NONE)
fun regExn0 _ = regExn unit
fun regExn1 _ = regExn
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-08-28 10:59:03 UTC (rev 5971)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2007-08-28 11:04:21 UTC (rev 5972)
@@ -494,6 +494,17 @@
end,
sz = NONE : OptInt.t}
+ val exns : {rd : String.t -> Exn.t I.monad Option.t,
+ wr : Exn.t -> Unit.t O.monad Option.t} Buffer.t = Buffer.new ()
+ fun regExn c {rd, wr, sz=_} (a2e, e2a) = let
+ val c = Generics.Con.toString c
+ val rd = I.map a2e rd
+ in
+ (Buffer.push exns)
+ {rd = fn c' => if c' = c then SOME rd else NONE,
+ wr = Option.map (fn a => O.>> (#wr string c, wr a)) o e2a}
+ end
+
structure Pickle = LayerRep
(structure Outer = Arg.Rep
structure Closed = struct
@@ -663,9 +674,6 @@
getItem = VectorSlice.getItem,
fromList = Vector.fromList} (getT t))
- val exns : {rd : String.t -> Exn.t I.monad Option.t,
- wr : Exn.t -> Unit.t O.monad Option.t} Buffer.t =
- Buffer.new ()
val exn : Exn.t t =
{rd = let
open I
@@ -679,14 +687,6 @@
of NONE => GenericsUtil.failExn e
| SOME r => r,
sz = NONE}
- fun regExn c {rd, wr, sz=_} (a2e, e2a) = let
- val c = Generics.Con.toString c
- val rd = I.map a2e rd
- in
- (Buffer.push exns)
- {rd = fn c' => if c' = c then SOME rd else NONE,
- wr = Option.map (fn a => O.>> (#wr string c, wr a)) o e2a}
- end
fun regExn0 c (e, p) = regExn c unit (const e, p)
fun regExn1 c t = regExn c (getT t)
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2007-08-28 10:59:03 UTC (rev 5971)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/seq.sml 2007-08-28 11:04:21 UTC (rev 5972)
@@ -47,6 +47,16 @@
fn (e, (l, r)) => lp (e, e, (l, r))
end
+ val exns : (e * Exn.t Sq.t -> (e * Bool.t) Option.t) Buffer.t = Buffer.new ()
+ fun regExn aE (_, e2a) =
+ (Buffer.push exns)
+ (fn (e, (l, r)) =>
+ case e2a l & e2a r
+ of SOME l & SOME r => SOME (aE (e, (l, r)))
+ | SOME _ & NONE => SOME (e, false)
+ | NONE & SOME _ => SOME (e, false)
+ | NONE & NONE => NONE)
+
structure Seq = LayerRep
(structure Outer = Arg.Rep
structure Closed = MkClosedRep (type 'a t = 'a t))
@@ -88,19 +98,10 @@
fun op --> _ = failing "Seq.--> unsupported"
- val exns : (e * Exn.t Sq.t -> (e * Bool.t) Option.t) Buffer.t = Buffer.new ()
fun exn (e, lr) =
case Buffer.findSome (pass (e, lr)) exns
of NONE => GenericsUtil.failExnSq lr
| SOME r => r
- fun regExn aE (_, e2a) =
- (Buffer.push exns)
- (fn (e, (l, r)) =>
- case e2a l & e2a r
- of SOME l & SOME r => SOME (aE (e, (l, r)))
- | SOME _ & NONE => SOME (e, false)
- | NONE & SOME _ => SOME (e, false)
- | NONE & NONE => NONE)
fun regExn0 _ (e, p) = regExn unit (const e, p)
fun regExn1 _ = regExn
More information about the MLton-commit
mailing list