Mercurial > feed
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