Mercurial > urweb

comparison src/mono_reduce.sml @ 1423:bd6c90f5a428

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix some cookie-related bugs in MonoReduce
author Adam Chlipala <adam@chlipala.net>
date Thu, 10 Feb 2011 08:46:46 -0500
parents d328983dc5a6
children 6e6f1643c4e9
comparison
equal deleted inserted replaced
1422:07ef5771568d 1423:bd6c90f5a428
74 EWrite _ => true 74 EWrite _ => true
75 | EQuery _ => true 75 | EQuery _ => true
76 | EDml _ => true 76 | EDml _ => true
77 | ENextval _ => true 77 | ENextval _ => true
78 | ESetval _ => true 78 | ESetval _ => true
79 | EUnurlify _ => false 79 | EUnurlify (e, _, _) => impure e
80 | EAbs _ => false 80 | EAbs _ => false
81 81
82 | EPrim _ => false 82 | EPrim _ => false
83 | ERel _ => false 83 | ERel _ => false
84 | ENamed _ => false 84 | ENamed _ => false
393 | ENone _ => [] 393 | ENone _ => []
394 | ESome (_, e) => summarize d e 394 | ESome (_, e) => summarize d e
395 | EFfi _ => [] 395 | EFfi _ => []
396 | EFfiApp ("Basis", "get_cookie", [e]) => 396 | EFfiApp ("Basis", "get_cookie", [e]) =>
397 summarize d e @ [ReadCookie] 397 summarize d e @ [ReadCookie]
398 | EFfiApp ("Basis", "set_cookie", es) =>
399 List.concat (map (summarize d) es) @ [WriteCookie]
400 | EFfiApp ("Basis", "clear_cookie", es) =>
401 List.concat (map (summarize d) es) @ [WriteCookie]
398 | EFfiApp (m, x, es) => 402 | EFfiApp (m, x, es) =>
399 if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then 403 if Settings.isEffectful (m, x) orelse Settings.isBenignEffectful (m, x) then
400 List.concat (map (summarize d) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then 404 List.concat (map (summarize d) es) @ [if m = "Basis" andalso String.isSuffix "_w" x then
401 WritePage 405 WritePage
402 else 406 else
521 fun doSub () = 525 fun doSub () =
522 let 526 let
523 val r = subExpInExp (0, e') b 527 val r = subExpInExp (0, e') b
524 in 528 in
525 (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'), 529 (*Print.prefaces "doSub" [("e'", MonoPrint.p_exp env e'),
526 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), 530 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
527 ("r", MonoPrint.p_exp env r)];*) 531 ("r", MonoPrint.p_exp env r)];*)
528 #1 (reduceExp env r) 532 #1 (reduceExp env r)
529 end 533 end
530 534
531 fun trySub () = 535 fun trySub () =
532 ((*Print.prefaces "trySub" 536 ((*Print.prefaces "trySub"