Mercurial > urweb

comparison src/disjoint.sml @ 621:8998114760c1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
"Hello world" compiles, after replacing type-level fold with map
author Adam Chlipala <adamc@hcoop.net>
date Sat, 21 Feb 2009 15:33:20 -0500
parents 6ee1c761818f
children 12b73f3c108e
comparison
equal deleted inserted replaced
620:d828b143e147 621:8998114760c1
211 in 211 in
212 (*Print.prefaces "decomposeRow'" [("c", ElabPrint.p_con env c), 212 (*Print.prefaces "decomposeRow'" [("c", ElabPrint.p_con env c),
213 ("c'", ElabPrint.p_con env (#1 (hnormCon (env, denv) c)))];*) 213 ("c'", ElabPrint.p_con env (#1 (hnormCon (env, denv) c)))];*)
214 case #1 (#1 (hnormCon (env, denv) c)) of 214 case #1 (#1 (hnormCon (env, denv) c)) of
215 CApp ( 215 CApp (
216 (CApp ( 216 (CApp ((CMap _, _), _), _),
217 (CApp ((CFold (dom, ran), _), f), _), 217 r) => decomposeRow' (r, (acc, gs))
218 i), _),
219 r) =>
220 let
221 val (env', nm) = E.pushCNamed env "nm" (KName, loc) NONE
222 val (env', v) = E.pushCNamed env' "v" dom NONE
223 val (env', st) = E.pushCNamed env' "st" ran NONE
224
225 val (denv', gs') = assert env' denv ((CRecord (dom, [((CNamed nm, loc),
226 (CUnit, loc))]), loc),
227 (CNamed st, loc))
228
229 val c' = (CApp (f, (CNamed nm, loc)), loc)
230 val c' = (CApp (c', (CNamed v, loc)), loc)
231 val c' = (CApp (c', (CNamed st, loc)), loc)
232 val (ps, gs'') = decomposeRow (env', denv') c'
233
234 fun covered p =
235 case p of
236 Unknown _ => false
237 | Piece p =>
238 case p of
239 (NameN n, []) => n = nm
240 | (RowN n, []) => n = st
241 | _ => false
242
243 val ps = List.filter (not o covered) ps
244 in
245 decomposeRow' (i, decomposeRow' (r, (ps @ acc, gs'' @ gs' @ gs)))
246 end
247 | _ => default () 218 | _ => default ()
248 end 219 end
249 in 220 in
250 decomposeRow' (c, ([], [])) 221 decomposeRow' (c, ([], []))
251 end 222 end