comparison demo/more/versioned.ur @ 1778:818d4097e2ed

Lighter-weight encoding of window function use
author Adam Chlipala <adam@chlipala.net>
date Sun, 03 Jun 2012 11:29:31 -0400
parents 6bc2a8cb3a67
children
comparison
equal deleted inserted replaced
1777:59b07fdae1ff 1778:818d4097e2ed
22 22
23 con dmeta = fn t => {Inj : sql_injectable_prim t, 23 con dmeta = fn t => {Inj : sql_injectable_prim t,
24 Eq : eq t} 24 Eq : eq t}
25 25
26 fun keyRecd (r : $(M.key ++ M.data)) = 26 fun keyRecd (r : $(M.key ++ M.data)) =
27 @map2 [sql_injectable] [ident] [sql_exp [] [] [] disallow_window] 27 @map2 [sql_injectable] [ident] [sql_exp [] [] []]
28 (fn [t] => @sql_inject) 28 (fn [t] => @sql_inject)
29 M.keyFolder M.key (r --- M.data) 29 M.keyFolder M.key (r --- M.data)
30 30
31 fun insert r = 31 fun insert r =
32 vr <- nextval s; 32 vr <- nextval s;
33 dml (Basis.insert t 33 dml (Basis.insert t
34 ({Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)} 34 ({Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)}
35 ++ keyRecd r 35 ++ keyRecd r
36 ++ @map2 [dmeta] [ident] 36 ++ @map2 [dmeta] [ident]
37 [fn t => sql_exp [] [] [] disallow_window (option t)] 37 [fn t => sql_exp [] [] [] (option t)]
38 (fn [t] x v => @sql_inject (@sql_option_prim x.Inj) 38 (fn [t] x v => @sql_inject (@sql_option_prim x.Inj)
39 (Some v)) 39 (Some v))
40 M.dataFolder M.data (r --- M.key))) 40 M.dataFolder M.data (r --- M.key)))
41 41
42 fun keyExp (r : $M.key) : sql_exp [T = all] [] [] disallow_window bool = 42 fun keyExp (r : $M.key) : sql_exp [T = all] [] [] bool =
43 @foldR2 [sql_injectable] [ident] [fn before => after :: {Type} -> [before ~ after] 43 @foldR2 [sql_injectable] [ident] [fn before => after :: {Type} -> [before ~ after]
44 => sql_exp [T = before ++ after] [] [] disallow_window bool] 44 => sql_exp [T = before ++ after] [] [] bool]
45 (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before] 45 (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before]
46 (inj : sql_injectable t) (v : t) 46 (inj : sql_injectable t) (v : t)
47 (e : after :: {Type} -> [before ~ after] 47 (e : after :: {Type} -> [before ~ after]
48 => sql_exp [T = before ++ after] [] [] disallow_window bool) 48 => sql_exp [T = before ++ after] [] [] bool)
49 [after :: {Type}] [[nm = t] ++ before ~ after] => 49 [after :: {Type}] [[nm = t] ++ before ~ after] =>
50 (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after]})) 50 (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after]}))
51 (fn [after :: {Type}] [[] ~ after] => (SQL TRUE)) 51 (fn [after :: {Type}] [[] ~ after] => (SQL TRUE))
52 M.keyFolder M.key r 52 M.keyFolder M.key r
53 [_] ! 53 [_] !
111 case cur of 111 case cur of
112 None => error <xml>Tried to update nonexistent key</xml> 112 None => error <xml>Tried to update nonexistent key</xml>
113 | Some cur => 113 | Some cur =>
114 vr <- nextval s; 114 vr <- nextval s;
115 let 115 let
116 val r' = @map3 [dmeta] [ident] [ident] [fn t => sql_exp [] [] [] disallow_window (option t)] 116 val r' = @map3 [dmeta] [ident] [ident] [fn t => sql_exp [] [] [] (option t)]
117 (fn [t] (meta : dmeta t) old new => 117 (fn [t] (meta : dmeta t) old new =>
118 @sql_inject (@sql_option_prim meta.Inj) 118 @sql_inject (@sql_option_prim meta.Inj)
119 (if @@eq [_] meta.Eq old new then 119 (if @@eq [_] meta.Eq old new then
120 None 120 None
121 else 121 else