Mercurial > urweb
changeset 434:c471345f5165
Remove need for '() <-' notation
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Mon, 27 Oct 2008 08:27:45 -0400 |
| parents | 659c17441250 |
| children | f7b25375c0cf |
| files | CHANGELOG demo/crud.ur demo/ref.ur demo/refFun.ur demo/sql.ur src/urweb.grm |
| diffstat | 6 files changed, 50 insertions(+), 43 deletions(-) [+] |
line wrap: on
line diff
--- a/CHANGELOG Mon Oct 27 08:16:19 2008 -0400 +++ b/CHANGELOG Mon Oct 27 08:27:45 2008 -0400 @@ -3,6 +3,7 @@ ======== - On missing inputs, print an error message, but don't exit the web server. +- Remove need for "() <-" notation. ======== 20081026
--- a/demo/crud.ur Mon Oct 27 08:16:19 2008 -0400 +++ b/demo/crud.ur Mon Oct 27 08:27:45 2008 -0400 @@ -94,15 +94,15 @@ and create (inputs : $(mapT2T sndTT M.cols)) = id <- nextval seq; - () <- dml (insert tab - (foldT2R2 [sndTT] [colMeta] - [fn cols => $(mapT2T (fn t :: (Type * Type) => - sql_exp [] [] [] t.1) cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] => - fn input col acc => acc with nm = @sql_inject col.Inject (col.Parse input)) - {} [M.cols] inputs M.cols - with #Id = (SQL {id}))); + dml (insert tab + (foldT2R2 [sndTT] [colMeta] + [fn cols => $(mapT2T (fn t :: (Type * Type) => + sql_exp [] [] [] t.1) cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] => + fn input col acc => acc with nm = @sql_inject col.Inject (col.Parse input)) + {} [M.cols] inputs M.cols + with #Id = (SQL {id}))); ls <- list (); return <xml><body> <p>Inserted with ID {[id]}.</p> @@ -111,18 +111,18 @@ </body></xml> and save (id : int) (inputs : $(mapT2T sndTT M.cols)) = - () <- dml (update [mapT2T fstTT M.cols] - (foldT2R2 [sndTT] [colMeta] - [fn cols => $(mapT2T (fn t :: (Type * Type) => - sql_exp [T = [Id = int] - ++ mapT2T fstTT M.cols] - [] [] t.1) cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] => - fn input col acc => acc with nm = - @sql_inject col.Inject (col.Parse input)) - {} [M.cols] inputs M.cols) - tab (WHERE T.Id = {id})); + dml (update [mapT2T fstTT M.cols] + (foldT2R2 [sndTT] [colMeta] + [fn cols => $(mapT2T (fn t :: (Type * Type) => + sql_exp [T = [Id = int] + ++ mapT2T fstTT M.cols] + [] [] t.1) cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] => + fn input col acc => acc with nm = + @sql_inject col.Inject (col.Parse input)) + {} [M.cols] inputs M.cols) + tab (WHERE T.Id = {id})); ls <- list (); return <xml><body> <p>Saved!</p> @@ -150,7 +150,7 @@ </form></body></xml> and delete (id : int) = - () <- dml (DELETE FROM tab WHERE Id = {id}); + dml (DELETE FROM tab WHERE Id = {id}); ls <- list (); return <xml><body> <p>The deed is done.</p>
--- a/demo/ref.ur Mon Oct 27 08:16:19 2008 -0400 +++ b/demo/ref.ur Mon Oct 27 08:27:45 2008 -0400 @@ -13,15 +13,15 @@ ir' <- IR.new 7; sr <- SR.new "hi"; - () <- IR.write ir' 10; + IR.write ir' 10; iv <- IR.read ir; iv' <- IR.read ir'; sv <- SR.read sr; - () <- IR.delete ir; - () <- IR.delete ir'; - () <- SR.delete sr; + IR.delete ir; + IR.delete ir'; + SR.delete sr; return <xml><body> {[iv]}, {[iv']}, {[sv]}
--- a/demo/refFun.ur Mon Oct 27 08:16:19 2008 -0400 +++ b/demo/refFun.ur Mon Oct 27 08:27:45 2008 -0400 @@ -10,7 +10,7 @@ fun new d = id <- nextval s; - () <- dml (INSERT INTO t (Id, Data) VALUES ({id}, {d})); + dml (INSERT INTO t (Id, Data) VALUES ({id}, {d})); return id fun read r =
--- a/demo/sql.ur Mon Oct 27 08:16:19 2008 -0400 +++ b/demo/sql.ur Mon Oct 27 08:27:45 2008 -0400 @@ -26,8 +26,8 @@ </xml> and add r = - () <- dml (INSERT INTO t (A, B, C, D) - VALUES ({readError r.A}, {readError r.B}, {r.C}, {r.D})); + dml (INSERT INTO t (A, B, C, D) + VALUES ({readError r.A}, {readError r.B}, {r.C}, {r.D})); xml <- list (); return <xml><body> <p>Row added.</p> @@ -36,8 +36,8 @@ </body></xml> and delete a = - () <- dml (DELETE FROM t - WHERE t.A = {a}); + dml (DELETE FROM t + WHERE t.A = {a}); xml <- list (); return <xml><body> <p>Row deleted.</p>
--- a/src/urweb.grm Mon Oct 27 08:16:19 2008 -0400 +++ b/src/urweb.grm Mon Oct 27 08:27:45 2008 -0400 @@ -263,6 +263,7 @@ | xmlOne of exp | tag of string * exp | tagHead of string * exp + | bind of string * con option * exp | earg of exp * con -> exp * con | eargp of exp * con -> exp * con @@ -668,20 +669,13 @@ (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2), ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc) end) - | SYMBOL LARROW eexp SEMI eexp (let - val loc = s (SYMBOLleft, eexp2right) + | bind SEMI eexp (let + val loc = s (bindleft, eexpright) + val (v, to, e1) = bind val e = (EVar (["Basis"], "bind", Infer), loc) - val e = (EApp (e, eexp1), loc) + val e = (EApp (e, e1), loc) in - (EApp (e, (EAbs (SYMBOL, NONE, eexp2), loc)), loc) - end) - | UNIT LARROW eexp SEMI eexp (let - val loc = s (UNITleft, eexp2right) - val e = (EVar (["Basis"], "bind", Infer), loc) - val e = (EApp (e, eexp1), loc) - val t = (TRecord (CRecord [], loc), loc) - in - (EApp (e, (EAbs ("_", SOME t, eexp2), loc)), loc) + (EApp (e, (EAbs (v, to, eexp), loc)), loc) end) | eexp EQ eexp (native_op ("eq", eexp1, eexp2, s (eexp1left, eexp2right))) | eexp NE eexp (native_op ("ne", eexp1, eexp2, s (eexp1left, eexp2right))) @@ -699,6 +693,18 @@ | eexp WITH cterm EQ eexp (EWith (eexp1, cterm, eexp2), s (eexp1left, eexp2right)) +bind : SYMBOL LARROW eapps (SYMBOL, NONE, eapps) + | UNIT LARROW eapps (let + val loc = s (UNITleft, eappsright) + in + ("_", SOME (TRecord (CRecord [], loc), loc), eapps) + end) + | eapps (let + val loc = s (eappsleft, eappsright) + in + ("_", SOME (TRecord (CRecord [], loc), loc), eapps) + end) + eargs : earg (earg) | eargl (eargl)