From 0091af30d2d24940404e49b30a6d0e2a0e4ba4e7 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Thu, 27 May 2010 15:10:52 -0400
Subject: Consider view declarations while shaking

---
 src/mono_shake.sml |  1 +
 src/shake.sml      |  8 +++++++-
 src/urweb.grm      | 22 +++++++++++++++++++++-
 3 files changed, 29 insertions(+), 2 deletions(-)

(limited to 'src')

diff --git a/src/mono_shake.sml b/src/mono_shake.sml
index b42c9535..50c4b387 100644
--- a/src/mono_shake.sml
+++ b/src/mono_shake.sml
@@ -58,6 +58,7 @@ fun shake file =
                   | ((DDatabase {expunge = n1, initialize = n2, ...}, _), (page_cs, page_es)) =>
                     (page_cs, IS.addList (page_es, [n1, n2]))
                   | ((DTask (e1, e2), _), st) => usedVars (usedVars st e2) e1
+                  | ((DView (_, _, e), _), st) => usedVars st e
                   | ((DPolicy pol, _), st) =>
                     let
                         val e1 = case pol of
diff --git a/src/shake.sml b/src/shake.sml
index f679c6e8..bc81def9 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008-2010, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -85,6 +85,12 @@ fun shake file =
                     in
                         (usedE, usedC)
                     end
+                  | ((DView (_, _, _, e, c), _), (usedE, usedC)) =>
+                    let
+                        val usedC = usedVarsC usedC c
+                    in
+                        usedVars (usedE, usedC) e
+                    end
                   | ((DTask (e1, e2), _), st) =>
                     if !sliceDb then
                         st
diff --git a/src/urweb.grm b/src/urweb.grm
index 3df9554f..dfc22112 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -184,6 +184,26 @@ fun patType loc (p : pat) =
         PAnnot (_, t) => t
       | _ => (CWild (KType, loc), loc)
 
+fun tnamesOf (e, _) =
+    case e of
+        EApp (e1, e2) => tnamesOf e1 @ tnamesOf e2
+      | ECApp (e, c as (CName _, _)) =>
+        let
+            fun isFt (e, _) =
+                case e of
+                    EVar (["Basis"], "sql_from_table", _) => true
+                  | EVar ([], "sql_from_table", _) => true
+                  | ECApp (e, _) => isFt e
+                  | EApp (e, _) => isFt e
+                  | EDisjointApp e => isFt e
+                  | _ => false
+        in
+            (if isFt e then [c] else []) @ tnamesOf e
+        end
+      | ECApp (e, _) => tnamesOf e
+      | EDisjointApp e => tnamesOf e
+      | _ => []
+
 %%
 %header (functor UrwebLrValsFn(structure Token : TOKEN))
 
@@ -1540,7 +1560,7 @@ tables : fitem                          (fitem)
                                          end)
 
 fitem  : table'                         ([#1 table'], #2 table')
-       | LBRACE LBRACE eexp RBRACE RBRACE ([], eexp)
+       | LBRACE LBRACE eexp RBRACE RBRACE (tnamesOf eexp, eexp)
        | fitem JOIN fitem ON sqlexp     (let
                                              val loc = s (fitem1left, sqlexpright)
                                                        
-- 
cgit v1.2.3