comparison demo/more/dbgrid.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 fbc3a0eef45a
children f0afe61a6f8b
comparison
equal deleted inserted replaced
1092:6f4b05fc4361 1093:8d3aa6c7cee0
382 val list = query (SELECT * FROM {{M.tab}} AS T) (fn r rs => return (r.T :: rs)) [] 382 val list = query (SELECT * FROM {{M.tab}} AS T) (fn r rs => return (r.T :: rs)) []
383 383
384 val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder 384 val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder
385 385
386 fun ensql [env] (r : $(M.key ++ M.row)) = 386 fun ensql [env] (r : $(M.key ++ M.row)) =
387 map2 [rawMeta] [id] [sql_exp env [] []] 387 @map2 [rawMeta] [id] [sql_exp env [] []]
388 (fn [t] meta v => @sql_inject meta.Inj v) 388 (fn [t] meta v => @sql_inject meta.Inj v)
389 [_] wholeRow M.raw r 389 wholeRow M.raw r
390 390
391 val new = 391 val new =
392 row <- Monad.mapR [rawMeta] [id] 392 row <- @Monad.mapR _ [rawMeta] [id]
393 (fn [nm :: Name] [t :: Type] meta => meta.New) 393 (fn [nm :: Name] [t :: Type] meta => meta.New)
394 [_] wholeRow M.raw; 394 wholeRow M.raw;
395 dml (insert M.tab (ensql row)); 395 dml (insert M.tab (ensql row));
396 return row 396 return row
397 397
398 fun selector (r : $M.key) : sql_exp [T = M.key ++ M.row] [] [] bool = 398 fun selector (r : $M.key) : sql_exp [T = M.key ++ M.row] [] [] bool =
399 foldR2 [rawMeta] [id] 399 @foldR2 [rawMeta] [id]
400 [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool] 400 [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool]
401 (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key] 401 (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key]
402 (meta : rawMeta t) (v : t) 402 (meta : rawMeta t) (v : t)
403 (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool) 403 (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool)
404 [rest :: {Type}] [rest ~ [nm = t] ++ key] => 404 [rest :: {Type}] [rest ~ [nm = t] ++ key] =>
405 (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !})) 405 (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !}))
406 (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE)) 406 (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE))
407 [_] M.keyFolder (M.raw --- map rawMeta M.row) r 407 M.keyFolder (M.raw --- map rawMeta M.row) r
408 [_] ! 408 [_] !
409 409
410 fun save key row = 410 fun save key row =
411 dml (update [M.key ++ M.row] ! 411 dml (update [M.key ++ M.row]
412 (ensql row) 412 (ensql row)
413 M.tab 413 M.tab
414 (selector key)) 414 (selector key))
415 415
416 fun delete key = 416 fun delete key =