Mercurial > urweb
comparison src/elaborate.sml @ 471:20fab0e96217
Tree demo working (and other assorted regressions fixed)
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 06 Nov 2008 19:43:48 -0500 |
parents | b393c2fc80f8 |
children | 6ee1c761818f |
comparison
equal
deleted
inserted
replaced
470:7cb418e9714f | 471:20fab0e96217 |
---|---|
2280 case p (env, h) of | 2280 case p (env, h) of |
2281 NONE => | 2281 NONE => |
2282 let | 2282 let |
2283 val env = case #1 h of | 2283 val env = case #1 h of |
2284 L'.SgiCon (x, n, k, c) => | 2284 L'.SgiCon (x, n, k, c) => |
2285 E.pushCNamedAs env x n k (SOME c) | 2285 if E.checkENamed env n then |
2286 env | |
2287 else | |
2288 E.pushCNamedAs env x n k (SOME c) | |
2286 | L'.SgiConAbs (x, n, k) => | 2289 | L'.SgiConAbs (x, n, k) => |
2287 E.pushCNamedAs env x n k NONE | 2290 if E.checkENamed env n then |
2291 env | |
2292 else | |
2293 E.pushCNamedAs env x n k NONE | |
2288 | _ => env | 2294 | _ => env |
2289 in | 2295 in |
2290 seek (E.sgiBinds env h, sgiBindsD (env, denv) h) t | 2296 seek (E.sgiBinds env h, sgiBindsD (env, denv) h) t |
2291 end | 2297 end |
2292 | SOME envs => envs | 2298 | SOME envs => envs |
2389 val k = (L'.KType, loc) | 2395 val k = (L'.KType, loc) |
2390 val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs1 | 2396 val k' = foldl (fn (_, k') => (L'.KArrow (k, k'), loc)) k xs1 |
2391 | 2397 |
2392 fun good () = | 2398 fun good () = |
2393 let | 2399 let |
2394 val env = E.sgiBinds env sgi2All | 2400 val env = E.sgiBinds env sgi1All |
2395 val env = if n1 = n2 then | 2401 val env = if n1 = n2 then |
2396 env | 2402 env |
2397 else | 2403 else |
2398 E.pushCNamedAs env x n1 k' | 2404 E.pushCNamedAs env x n2 k' |
2399 (SOME (L'.CNamed n2, loc)) | 2405 (SOME (L'.CNamed n1, loc)) |
2400 in | 2406 in |
2401 SOME (env, denv) | 2407 SOME (env, denv) |
2402 end | 2408 end |
2403 | 2409 |
2404 val env = E.pushCNamedAs env x n1 k' NONE | 2410 val env = E.pushCNamedAs env x n1 k' NONE |