# HG changeset patch
# User Karn Kallio <kkallio@eka>
# Date 1311643509 16200
# Node ID f641cfcd515317cb64371467a81412e5b6a7ffea
# Parent  7eea7ff1904ce776c4c44a6baea357499e7eb906
Add gather pattern.

diff -r 7eea7ff1904c -r f641cfcd5153 src/ur/feed.ur
--- a/src/ur/feed.ur	Sun Jul 24 03:36:07 2011 -0430
+++ b/src/ur/feed.ur	Mon Jul 25 20:55:09 2011 -0430
@@ -242,6 +242,55 @@
                                    None => None
                                  | Some (cdata, _) => Some ((pdata, cdata), True)}
 
+con gatherInternal (parent :: Type) (child :: Type) (data :: Type) = option (parent * bool * int * option child * list data)
+
+fun gather [parentI ::: Type] [parent ::: Type] [childI ::: Type] [child ::: Type]
+    (parent : pattern parentI parent) (child : pattern childI child)
+    : pattern (gatherInternal parentI childI child) (parent * list child) =
+    {Initial = None,
+     EnterTag = fn tinfo state =>
+                   case state of
+                       None =>
+                       (case parent.EnterTag tinfo parent.Initial of
+                            None => None
+                          | Some pstate => Some (Some (pstate, False, 1, None, Nil)))
+                     | Some (pstate, return, depth, cstate, clist) =>
+                       let
+                           val cstate' = child.EnterTag tinfo (Option.get child.Initial cstate)
+                       in
+                           case child.Finished (Option.get child.Initial cstate') of
+                               None =>
+                               Some (Some (pstate, return, depth+1, cstate', clist))
+                             | Some (cdata, _) =>
+                               Some (Some (pstate, return, depth+1, None, cdata :: clist))
+                       end,
+     ExitTag = fn state =>
+                  case state of
+                      None => None
+                    | Some (pstate, _, 1, cstate, clist) =>
+                      Some (Some (pstate, True, 1, cstate, clist))
+                    | Some (pstate, return, depth, cstate, clist) =>
+                      let
+                          val cstate' = child.ExitTag (Option.get child.Initial cstate)
+                      in
+                          case child.Finished (Option.get child.Initial cstate') of
+                              None =>
+                              Some (Some (pstate, return, depth-1, cstate', clist))
+                            | Some (cdata, _) =>
+                              Some (Some (pstate, return, depth-1, None, cdata :: clist))
+                      end,
+     Finished = fn state =>
+                   case state of
+                       None => None
+                     | Some (pstate, return, _, _, clist) =>
+                       case parent.Finished pstate of
+                           None => None
+                         | Some (pdata, _) =>
+                           if return then
+                               Some ((pdata, List.rev clist), False)
+                           else
+                               None}
+
 type document = string
 val show_document = _
 
diff -r 7eea7ff1904c -r f641cfcd5153 src/ur/feed.urs
--- a/src/ur/feed.urs	Sun Jul 24 03:36:07 2011 -0430
+++ b/src/ur/feed.urs	Mon Jul 25 20:55:09 2011 -0430
@@ -71,6 +71,14 @@
  * be matched at any depth within the parent's subtree.  Unlike [children],
  * [tree] finds as many subtree matches per parent node as possible. *)
 
+con gatherInternal :: Type -> Type -> Type -> Type
+
+val gather : parentI ::: Type -> parent ::: Type -> childI ::: Type -> child ::: Type
+             -> pattern parentI parent -> pattern childI child
+             -> pattern (gatherInternal parentI childI child) (parent * list child)
+(* A combinator like tree that collects matching subtree patterns into a list rather
+ * than handling them one at a time. *)
+
 type document
 val show_document : show document
 (* Type of uninterpreted XML documents *)