comparison src/ur/feed.ur @ 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 7eea7ff1904c
comparison
equal deleted inserted replaced
10:edc2b467f818 11:43c3fbd8527a
175 fun childrenO [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}] 175 fun childrenO [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}]
176 (parent : pattern parentI parent) (children : $(map (fn (i, d) => pattern i d) children)) (fl : folder children) 176 (parent : pattern parentI parent) (children : $(map (fn (i, d) => pattern i d) children)) (fl : folder children)
177 : pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children)) = 177 : pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children)) =
178 @childrenG Some parent children fl 178 @childrenG Some parent children fl
179 179
180 datatype required t = Required of t | Optional of t
181
182 fun childrenO' [parentI ::: Type] [parent ::: Type] [children ::: {(Type * Type)}]
183 (parent : pattern parentI parent) (children : $(map (fn (i, d) => required (pattern i d)) children)) (fl : folder children)
184 : pattern (childrenInternal parentI (map fst children)) (parent * $(map (fn (i, d) => option d) children)) =
185 let
186 val os = @mp [fn (i, d) => required (pattern i d)] [fn (i, d) => bool]
187 (fn [u] pat => case pat of
188 Required _ => False
189 | Optional _ => True) fl children
190 val vs = @mp [fn (i, d) => required (pattern i d)] [fn (i, d) => pattern i d]
191 (fn [u] pat => case pat of
192 Required pat' => pat'
193 | Optional pat' => pat') fl children
194 in
195 @childrenG (@foldR2 [fn _ => bool] [fn (i, d) => option d] [fn r => option $(map (fn (i, d) => option d) r)]
196 (fn [nm ::_] [p ::_] [r ::_] [[nm] ~ r] (isO : bool) (cstate : option p.2) acc =>
197 case acc of
198 None => None
199 | Some acc =>
200 if isO then
201 Some ({nm = cstate} ++ acc)
202 else
203 case cstate of
204 None => None
205 | Some _ => Some ({nm = cstate} ++ acc))
206 (Some {}) fl os) parent vs fl
207 end
208
180 con treeInternal (parent :: Type) (child :: Type) = option (parent * int * option child) 209 con treeInternal (parent :: Type) (child :: Type) = option (parent * int * option child)
181 210
182 fun tree [parentI ::: Type] [parent ::: Type] [childI ::: Type] [child ::: Type] 211 fun tree [parentI ::: Type] [parent ::: Type] [childI ::: Type] [child ::: Type]
183 (parent : pattern parentI parent) (child : pattern childI child) 212 (parent : pattern parentI parent) (child : pattern childI child)
184 : pattern (treeInternal parentI childI) (parent * child) = 213 : pattern (treeInternal parentI childI) (parent * child) =