# HG changeset patch
# User haftmann
# Date 1163428993 -3600
# Node ID 6b9d4a19a3a81ca13a54659e51978679b8f0b9fd
# Parent  caa210551c01021aad3d5af713c4ae18c5c22622
added higher-order combinators for structured results

diff -r caa210551c01 -r 6b9d4a19a3a8 src/Pure/library.ML
--- a/src/Pure/library.ML	Mon Nov 13 15:43:12 2006 +0100
+++ b/src/Pure/library.ML	Mon Nov 13 15:43:13 2006 +0100
@@ -7,7 +7,7 @@
 strings, lists as sets, balanced trees, orders, current directory, misc.
 *)
 
-infix 1 |> |-> ||> ||>> |>> |>>> #> #->;
+infix 1 |> |-> ||> ||>> |>> #> #-> ##> ##>> #>> |>>> ;
 infix 2 ?;
 infix 3 o oo ooo oooo;
 
@@ -27,9 +27,12 @@
   val ||> : ('c * 'a) * ('a -> 'b) -> 'c * 'b
   val ||>> : ('c * 'a) * ('a -> 'd * 'b) -> ('c * 'd) * 'b
   val |>> : ('a * 'c) * ('a -> 'b) -> 'b * 'c
-  val |>>> : ('a * 'c) * ('a -> 'b * 'd) -> 'b * ('c * 'd)
   val #> : ('a -> 'b) * ('b -> 'c) -> 'a -> 'c
   val #-> : ('a -> 'c * 'b) * ('c -> 'b -> 'd) -> 'a -> 'd
+  val ##> : ('a -> 'c * 'b) * ('b -> 'd) -> 'a -> 'c * 'd
+  val ##>> : ('a -> 'c * 'b) * ('b -> 'e * 'd) -> 'a -> ('c * 'e) * 'd
+  val #>> : ('a -> 'c * 'b) * ('c -> 'd) -> 'a -> 'd * 'b
+  val |>>> : ('a * 'c) * ('a -> 'b * 'd) -> 'b * ('c * 'd)
   val ? : ('a -> bool) * ('a -> 'a) -> 'a -> 'a
   val ` : ('b -> 'a) -> 'b -> 'a * 'b
   val tap: ('b -> 'a) -> 'b -> 'b
@@ -303,9 +306,12 @@
 fun (x, y) |>>> f = let val (x', z) = f x in (x', (y, z)) end;
 fun (x, y) ||>> f = let val (z, y') = f y in ((x, z), y') end;
 
-(*reverse composition*)
+(*reverse composition and structured results*)
 fun f #> g = g o f;
 fun f #-> g = uncurry g o f;
+fun (f ##> g) x = let val (y, z) = f x in (y, g z) end;
+fun (f ##>> g) x = let val (y, z) = f x; val (w, u) = g z in ((y, w), u) end;
+fun (f #>> g) x = let val (y, z) = f x in (g y, z) end;
 
 (*conditional application*)
 fun b ? f = fn x => if b x then f x else x;