changeset 11:43c3fbd8527a

Add variant of children allowing specification of optional matches.
author Karn Kallio <kkallio@eka>
date Thu, 23 Jun 2011 23:40:29 -0430
parents edc2b467f818
children a40cf9c8d615
files src/ur/feed.ur src/ur/feed.urs
diffstat 2 files changed, 38 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/src/ur/feed.ur	Thu Jun 09 12:59:27 2011 -0430
+++ b/src/ur/feed.ur	Thu Jun 23 23:40:29 2011 -0430
@@ -177,6 +177,35 @@
     : pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children)) =
       @childrenG Some parent children fl
 
+datatype required t = Required of t | Optional of t
+
+fun childrenO' [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}]
+              (parent : pattern parentI parent) (children : $(map (fn (i, d) => required (pattern i d)) children)) (fl : folder children)
+    : pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children)) =
+      let
+        val os = @mp [fn (i, d) => required (pattern i d)] [fn (i, d) => bool] 
+                  (fn [u] pat => case pat of
+                                     Required _ => False
+                                   | Optional _ => True) fl children
+        val vs = @mp [fn (i, d) => required (pattern i d)] [fn (i, d) => pattern i d]
+                  (fn [u] pat => case pat of
+                                     Required pat' => pat'
+                                   | Optional pat' => pat') fl children
+      in
+          @childrenG (@foldR2 [fn _ => bool] [fn (i, d) => option d] [fn r => option $(map (fn (i, d) => option d) r)]
+                       (fn [nm ::_] [p ::_] [r ::_] [[nm] ~ r] (isO : bool) (cstate : option p.2) acc =>
+                           case acc of
+                               None => None
+                             | Some acc =>
+                               if isO then
+                                   Some ({nm = cstate} ++ acc)
+                               else
+                                   case cstate of
+                                       None => None
+                                     | Some _ => Some ({nm = cstate} ++ acc))
+                       (Some {}) fl os) parent vs fl
+      end
+          
 con treeInternal (parent :: Type) (child :: Type) = option (parent * int * option child)
 
 fun tree [parentI ::: Type] [parent ::: Type] [childI ::: Type] [child ::: Type]
--- a/src/ur/feed.urs	Thu Jun 09 12:59:27 2011 -0430
+++ b/src/ur/feed.urs	Thu Jun 23 23:40:29 2011 -0430
@@ -53,6 +53,15 @@
                 -> pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children))
 (* A version of [children] where each child pattern need not be matched *)
 
+datatype required t = Required of t | Optional of t
+(* Used for marking items as required or optional. *)
+
+val childrenO' : parentI ::: Type -> parent ::: Type -> children ::: {(Type * Type)}
+                 -> pattern parentI parent -> $(map (fn (i, d) => required (pattern i d)) children) -> folder children
+                 -> pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children))
+(* A version of [children] where the caller marks each child pattern
+ * as either required or optional. *)
+
 con treeInternal :: Type -> Type -> Type
 
 val tree : parentI ::: Type -> parent ::: Type -> childI ::: Type -> child ::: Type