Mercurial > urweb
diff demo/more/orm.ur @ 1093:8d3aa6c7cee0
Make summary unification more conservative; infer implicit arguments after applications
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 26 Dec 2009 11:56:40 -0500 |
| parents | bb3fc575cfe7 |
| children | f0afe61a6f8b |
line wrap: on
line diff
--- a/demo/more/orm.ur Fri Dec 25 10:48:02 2009 -0500 +++ b/demo/more/orm.ur Sat Dec 26 11:56:40 2009 -0500 @@ -32,9 +32,9 @@ Inj = inj} fun ensql [avail] (r : row') : $(map (sql_exp avail [] []) fs') = - map2 [meta] [fst] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1] - (fn [ts] meta v => @sql_inject meta.Inj v) - [_] M.folder M.cols r + @map2 [meta] [fst] [fn ts :: (Type * Type) => sql_exp avail [] [] ts.1] + (fn [ts] meta v => @sql_inject meta.Inj v) + M.folder M.cols r fun create (r : row') = id <- nextval s; @@ -43,7 +43,7 @@ fun delete r = dml (DELETE FROM t WHERE t.Id = {[r.Id]}) - fun save r = dml (update [fs'] ! (ensql (r -- #Id)) t (WHERE T.Id = {[r.Id]})) + fun save r = dml (update [fs'] (ensql (r -- #Id)) t (WHERE T.Id = {[r.Id]})) fun lookup id = ro <- oneOrNoRows (SELECT * FROM t WHERE t.Id = {[id]}); @@ -59,20 +59,20 @@ {Col : {Exp : sql_exp [T = fs] [] [] col, Inj : sql_injectable col}, Parent : $fs -> transaction (option parent)} - val cols = foldR [meta] [fn before => after :: {(Type * Type)} -> [before ~ after] => - $(map (meta' (map fst (before ++ after))) before)] - (fn [nm :: Name] [ts :: (Type * Type)] [before :: {(Type * Type)}] - [[nm] ~ before] (meta : meta ts) - (acc : after :: {(Type * Type)} -> [before ~ after] => - $(map (meta' (map fst (before ++ after))) before)) - [after :: {(Type * Type)}] [[nm = ts] ++ before ~ after] => - {nm = {Col = {Exp = sql_field [#T] [nm], - Inj = meta.Inj}, - Parent = fn r => meta.Link r.nm}} - ++ acc [[nm = ts] ++ after] !) - (fn [after :: {(Type * Type)}] [[] ~ after] => {}) - [_] M.folder M.cols - [[Id = (id, row)]] ! + val cols = @foldR [meta] [fn before => after :: {(Type * Type)} -> [before ~ after] => + $(map (meta' (map fst (before ++ after))) before)] + (fn [nm :: Name] [ts :: (Type * Type)] [before :: {(Type * Type)}] + [[nm] ~ before] (meta : meta ts) + (acc : after :: {(Type * Type)} -> [before ~ after] => + $(map (meta' (map fst (before ++ after))) before)) + [after :: {(Type * Type)}] [[nm = ts] ++ before ~ after] => + {nm = {Col = {Exp = sql_field [#T] [nm], + Inj = meta.Inj}, + Parent = fn r => meta.Link r.nm}} + ++ acc [[nm = ts] ++ after] !) + (fn [after :: {(Type * Type)}] [[] ~ after] => {}) + M.folder M.cols + [[Id = (id, row)]] ! type filter = sql_exp [T = fs] [] [] bool fun find (f : filter) = resultOut (SELECT * FROM t WHERE {f}) @@ -80,12 +80,12 @@ fun bin (b : t ::: Type -> sql_binary t t bool) [t] (c : col t) (v : t) = sql_binary b c.Exp (@sql_inject c.Inj v) - val eq = bin @@sql_eq - val ne = bin @@sql_ne - val lt = bin @@sql_lt - val le = bin @@sql_le - val gt = bin @@sql_gt - val ge = bin @@sql_ge + val eq = @@bin @@sql_eq + val ne = @@bin @@sql_ne + val lt = @@bin @@sql_lt + val le = @@bin @@sql_le + val gt = @@bin @@sql_gt + val ge = @@bin @@sql_ge fun bb (b : sql_binary bool bool bool) (f1 : filter) (f2 : filter) = sql_binary b f1 f2