diff options
author | Adam Chlipala <adamc@hcoop.net> | 2010-05-27 15:10:52 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2010-05-27 15:10:52 -0400 |
commit | be9263be5864a7cc94cab5b971af9ff02c26cc70 (patch) | |
tree | c31b9042cedaabf6f1c471ed2595caefbed49543 /src | |
parent | c3607e368bf1d79c5ebaae2e8f9d3dba599953a5 (diff) |
Consider view declarations while shaking
Diffstat (limited to 'src')
-rw-r--r-- | src/mono_shake.sml | 1 | ||||
-rw-r--r-- | src/shake.sml | 8 | ||||
-rw-r--r-- | src/urweb.grm | 22 |
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) |