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