changeset 2040:8ea382a57ce2

Fix index-matching bug in MonoReduce effect calculation
author Adam Chlipala <adam@chlipala.net>
date Mon, 21 Jul 2014 08:11:03 -0400
parents 3d10ae22abd6
children ec7a1fa5e88f
files src/mono_reduce.sml
diffstat 1 files changed, 4 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/src/mono_reduce.sml	Wed Jul 16 04:06:11 2014 -0400
+++ b/src/mono_reduce.sml	Mon Jul 21 08:11:03 2014 -0400
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, 2013, Adam Chlipala
+(* Copyright (c) 2008, 2013-2014, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -471,7 +471,7 @@
 
                       | ECase (e, pes, _) =>
                         let
-                            val lss = map (fn (p, e) => summarize (d + patBinds p) e) pes
+                            val lss = map (fn (p, e) => summarize (if d = ~1 then ~1 else d + patBinds p) e) pes
 
                             fun splitRel ls acc =
                                 case ls of
@@ -510,7 +510,7 @@
                         List.concat [summarize d query,
                                      summarize d initial,
                                      [ReadDb],
-                                     summarize (d + 2) body]
+                                     summarize (if d = ~1 then ~1 else d + 2) body]
 
                       | EDml (e, _) => summarize d e @ [WriteDb]
                       | ENextval e => summarize d e @ [WriteDb]
@@ -585,7 +585,7 @@
                                 val effs_e' = List.filter (fn x => x <> UseRel) effs_e'
                                 val effs_b = summarize 0 b
 
-                                (*val () = Print.fprefaces outf "Try"
+                                (*val () = Print.prefaces "Try"
                                                         [(*("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)),*)
                                                          ("e'", MonoPrint.p_exp env e'),
                                                          ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),