Mercurial > urweb
changeset 1265:e8d68fd8ed4b
Consider view declarations while shaking
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 27 May 2010 15:10:52 -0400 |
| parents | 79b2bcac6200 |
| children | 459a334345ae |
| files | demo/crud.ur src/mono_shake.sml src/shake.sml src/urweb.grm tests/fitem.ur tests/fitem.urp |
| diffstat | 6 files changed, 37 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/crud.ur Thu May 27 10:56:52 2010 -0400 +++ b/demo/crud.ur Thu May 27 15:10:52 2010 -0400 @@ -167,7 +167,7 @@ <form><submit action={delete} value="I was born sure!"/></form> </body></xml> - end + end and main () = ls <- list ();
--- a/src/mono_shake.sml Thu May 27 10:56:52 2010 -0400 +++ b/src/mono_shake.sml Thu May 27 15:10:52 2010 -0400 @@ -58,6 +58,7 @@ | ((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
--- a/src/shake.sml Thu May 27 10:56:52 2010 -0400 +++ b/src/shake.sml Thu May 27 15:10:52 2010 -0400 @@ -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 @@ 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
--- a/src/urweb.grm Thu May 27 10:56:52 2010 -0400 +++ b/src/urweb.grm Thu May 27 15:10:52 2010 -0400 @@ -184,6 +184,26 @@ 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 @@ 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/fitem.ur Thu May 27 15:10:52 2010 -0400 @@ -0,0 +1,6 @@ +table t : { A : int, B : string } +table u : { A : int, C : float } + +val q : sql_query [] [T = [A = int, B = string], U = [C = option float]] [] = + (SELECT t.A, t.B, u.C + FROM {{sql_left_join (FROM t) (FROM u) (WHERE TRUE)}})