diff options
| -rw-r--r-- | demo/crud.ur | 2 | ||||
| -rw-r--r-- | src/mono_shake.sml | 1 | ||||
| -rw-r--r-- | src/shake.sml | 8 | ||||
| -rw-r--r-- | src/urweb.grm | 22 | ||||
| -rw-r--r-- | tests/fitem.ur | 6 | ||||
| -rw-r--r-- | tests/fitem.urp | 1 |
6 files changed, 37 insertions, 3 deletions
diff --git a/demo/crud.ur b/demo/crud.ur index 7850e656..82739772 100644 --- a/demo/crud.ur +++ b/demo/crud.ur @@ -167,7 +167,7 @@ functor Make(M : sig <form><submit action={delete} value="I was born sure!"/></form> </body></xml> - end + end and main () = ls <- list (); 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) diff --git a/tests/fitem.ur b/tests/fitem.ur new file mode 100644 index 00000000..282146c4 --- /dev/null +++ b/tests/fitem.ur @@ -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)}}) diff --git a/tests/fitem.urp b/tests/fitem.urp new file mode 100644 index 00000000..61d7a37b --- /dev/null +++ b/tests/fitem.urp @@ -0,0 +1 @@ +fitem |