summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2010-05-27 15:10:52 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2010-05-27 15:10:52 -0400
commit0091af30d2d24940404e49b30a6d0e2a0e4ba4e7 (patch)
treec31b9042cedaabf6f1c471ed2595caefbed49543 /src
parentf2bb854da19b535ab4590eaccfb1696bcffb42e8 (diff)
Consider view declarations while shaking
Diffstat (limited to 'src')
-rw-r--r--src/mono_shake.sml1
-rw-r--r--src/shake.sml8
-rw-r--r--src/urweb.grm22
3 files changed, 29 insertions, 2 deletions
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)