Mercurial > urweb
comparison src/mono_reduce.sml @ 1394:d328983dc5a6
Allow subqueries to reference aggregate-only columns of free tables; treat non-COUNT aggregate functions as possibly returning NULL
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 15 Jan 2011 14:53:13 -0500 |
parents | 802c179dac1f |
children | bd6c90f5a428 |
comparison
equal
deleted
inserted
replaced
1393:802c179dac1f | 1394:d328983dc5a6 |
---|---|
55 | EFfiApp (m, x, _) => Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) | 55 | EFfiApp (m, x, _) => Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) |
56 | EServerCall _ => true | 56 | EServerCall _ => true |
57 | ERecv _ => true | 57 | ERecv _ => true |
58 | ESleep _ => true | 58 | ESleep _ => true |
59 | ENamed n => IS.member (syms, n) | 59 | ENamed n => IS.member (syms, n) |
60 | EError _ => true | |
61 | ERel n => | 60 | ERel n => |
62 let | 61 let |
63 val (_, t, _) = E.lookupERel env n | 62 val (_, t, _) = E.lookupERel env n |
64 in | 63 in |
65 simpleTypeImpure tsyms t | 64 simpleTypeImpure tsyms t |
396 | EFfi _ => [] | 395 | EFfi _ => [] |
397 | EFfiApp ("Basis", "get_cookie", [e]) => | 396 | EFfiApp ("Basis", "get_cookie", [e]) => |
398 summarize d e @ [ReadCookie] | 397 summarize d e @ [ReadCookie] |
399 | EFfiApp (m, x, es) => | 398 | EFfiApp (m, x, es) => |
400 if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then | 399 if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then |
401 List.concat (map (summarize d) es) @ [Unsure] | 400 List.concat (map (summarize d) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then |
401 WritePage | |
402 else | |
403 Unsure] | |
402 else | 404 else |
403 List.concat (map (summarize d) es) | 405 List.concat (map (summarize d) es) |
404 | EApp ((EFfi _, _), e) => summarize d e | 406 | EApp ((EFfi _, _), e) => summarize d e |
405 | EApp _ => | 407 | EApp _ => |
406 let | 408 let |
427 else | 429 else |
428 [Unsure]) | 430 [Unsure]) |
429 | EApp (f, x) => | 431 | EApp (f, x) => |
430 unravel (#1 f, passed + 1, List.revAppend (summarize d x, | 432 unravel (#1 f, passed + 1, List.revAppend (summarize d x, |
431 ls)) | 433 ls)) |
434 | EError _ => [Abort] | |
432 | _ => [Unsure] | 435 | _ => [Unsure] |
433 in | 436 in |
434 unravel (e, 0, []) | 437 unravel (e, 0, []) |
435 end | 438 end |
436 | 439 |
443 | EField (e, _) => summarize d e | 446 | EField (e, _) => summarize d e |
444 | 447 |
445 | ECase (e, pes, _) => | 448 | ECase (e, pes, _) => |
446 let | 449 let |
447 val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes | 450 val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes |
451 | |
452 fun splitRel ls acc = | |
453 case ls of | |
454 [] => (acc, false, ls) | |
455 | UseRel :: ls => (acc, true, ls) | |
456 | v :: ls => splitRel ls (v :: acc) | |
457 | |
458 val (pre, used, post) = foldl (fn (ls, (pre, used, post)) => | |
459 let | |
460 val (pre', used', post') = splitRel ls [] | |
461 in | |
462 (pre' @ pre, used' orelse used, post' @ post) | |
463 end) | |
464 ([], false, []) lss | |
448 in | 465 in |
449 case lss of | 466 summarize d e |
450 [] => summarize d e | 467 @ pre |
451 | ls :: lss => | 468 @ (if used then [UseRel] else []) |
452 summarize d e | 469 @ post |
453 @ (if List.all (fn ls' => ls' = ls) lss then | |
454 ls | |
455 else if length (List.filter (not o List.null) (ls :: lss)) <= 1 then | |
456 valOf (List.find (not o List.null) (ls :: lss)) | |
457 else | |
458 [Unsure]) | |
459 end | 470 end |
460 | EStrcat (e1, e2) => summarize d e1 @ summarize d e2 | 471 | EStrcat (e1, e2) => summarize d e1 @ summarize d e2 |
461 | 472 |
462 | EError (e, _) => summarize d e @ [Abort] | 473 | EError (e, _) => summarize d e @ [Abort] |
463 | EReturnBlob {blob = e1, mimeType = e2, ...} => summarize d e1 @ summarize d e2 @ [Abort] | 474 | EReturnBlob {blob = e1, mimeType = e2, ...} => summarize d e1 @ summarize d e2 @ [Abort] |
532 let | 543 let |
533 val effs_e' = summarize 0 e' | 544 val effs_e' = summarize 0 e' |
534 val effs_e' = List.filter (fn x => x <> UseRel) effs_e' | 545 val effs_e' = List.filter (fn x => x <> UseRel) effs_e' |
535 val effs_b = summarize 0 b | 546 val effs_b = summarize 0 b |
536 | 547 |
537 (*val () = Print.prefaces "Try" | 548 (*val () = Print.fprefaces outf "Try" |
538 [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)), | 549 [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*) |
539 ("e'", MonoPrint.p_exp env e'), | 550 ("e'", MonoPrint.p_exp env e'), |
540 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), | 551 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), |
541 ("e'_eff", p_events effs_e'), | 552 ("e'_eff", p_events effs_e'), |
542 ("b_eff", p_events effs_b)]*) | 553 ("b_eff", p_events effs_b)]*) |
543 | 554 |