Mercurial > urweb

comparison src/mono_reduce.sml @ 2040:8ea382a57ce2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix index-matching bug in MonoReduce effect calculation
author Adam Chlipala <adam@chlipala.net>
date Mon, 21 Jul 2014 08:11:03 -0400
parents b15a4c2cb542
children ec7a1fa5e88f
comparison
equal deleted inserted replaced
2039:3d10ae22abd6 2040:8ea382a57ce2
1 (* Copyright (c) 2008, 2013, Adam Chlipala 1 (* Copyright (c) 2008, 2013-2014, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
469 | ERecord xets => List.concat (map (summarize d o #2) xets) 469 | ERecord xets => List.concat (map (summarize d o #2) xets)
470 | EField (e, _) => summarize d e 470 | EField (e, _) => summarize d e
471 471
472 | ECase (e, pes, _) => 472 | ECase (e, pes, _) =>
473 let 473 let
474 val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes 474 val lss = map (fn (p, e) => summarize (if d = ~1 then ~1 else d + patBinds p) e) pes
475 475
476 fun splitRel ls acc = 476 fun splitRel ls acc =
477 case ls of 477 case ls of
478 [] => (acc, false, ls) 478 [] => (acc, false, ls)
479 | UseRel :: ls => (acc, true, ls) 479 | UseRel :: ls => (acc, true, ls)
508 508
509 | EQuery {query, body, initial, ...} => 509 | EQuery {query, body, initial, ...} =>
510 List.concat [summarize d query, 510 List.concat [summarize d query,
511 summarize d initial, 511 summarize d initial,
512 [ReadDb], 512 [ReadDb],
513 summarize (d + 2) body] 513 summarize (if d = ~1 then ~1 else d + 2) body]
514 514
515 | EDml (e, _) => summarize d e @ [WriteDb] 515 | EDml (e, _) => summarize d e @ [WriteDb]
516 | ENextval e => summarize d e @ [WriteDb] 516 | ENextval e => summarize d e @ [WriteDb]
517 | ESetval (e1, e2) => summarize d e1 @ summarize d e2 @ [WriteDb] 517 | ESetval (e1, e2) => summarize d e1 @ summarize d e2 @ [WriteDb]
518 | EUnurlify (e, _, _) => summarize d e 518 | EUnurlify (e, _, _) => summarize d e
583 let 583 let
584 val effs_e' = summarize 0 e' 584 val effs_e' = summarize 0 e'
585 val effs_e' = List.filter (fn x => x <> UseRel) effs_e' 585 val effs_e' = List.filter (fn x => x <> UseRel) effs_e'
586 val effs_b = summarize 0 b 586 val effs_b = summarize 0 b
587 587
588 (*val () = Print.fprefaces outf "Try" 588 (*val () = Print.prefaces "Try"
589 [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*) 589 [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*)
590 ("e'", MonoPrint.p_exp env e'), 590 ("e'", MonoPrint.p_exp env e'),
591 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), 591 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
592 ("e'_eff", p_events effs_e'), 592 ("e'_eff", p_events effs_e'),
593 ("b_eff", p_events effs_b)]*) 593 ("b_eff", p_events effs_b)]*)