summaryrefslogtreecommitdiff
path: root/demo
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-26 11:56:40 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-26 11:56:40 -0500
commitc4120c8ddaa5340efad5f835ce4565f2a8ae2cbf (patch)
treeb4c6e798738335ded8d209afc369885664396d08 /demo
parent4300120544123e9dfb262eb8b4e3d0a0f17ff9bc (diff)
Make summary unification more conservative; infer implicit arguments after applications
Diffstat (limited to 'demo')
-rw-r--r--demo/batchFun.ur78
-rw-r--r--demo/crud.ur96
-rw-r--r--demo/metaform.ur26
-rw-r--r--demo/more/dbgrid.ur34
-rw-r--r--demo/more/grid.ur170
-rw-r--r--demo/more/grid1.ur14
-rw-r--r--demo/more/orm.ur48
-rw-r--r--demo/more/orm1.ur6
-rw-r--r--demo/more/versioned.ur76
-rw-r--r--demo/sum.ur6
-rw-r--r--demo/tcSum.ur6
11 files changed, 280 insertions, 280 deletions
diff --git a/demo/batchFun.ur b/demo/batchFun.ur
index c75cbb07..3f0317a8 100644
--- a/demo/batchFun.ur
+++ b/demo/batchFun.ur
@@ -45,14 +45,14 @@ functor Make(M : sig
fun add r =
dml (insert t
- (foldR2 [fst] [colMeta]
- [fn cols => $(map (fn t :: (Type * Type) =>
- sql_exp [] [] [] t.1) cols)]
- (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] input col acc =>
- acc ++ {nm = @sql_inject col.Inject input})
- {} [M.cols] M.fl (r -- #Id) M.cols
- ++ {Id = (SQL {[r.Id]})}))
+ (@foldR2 [fst] [colMeta]
+ [fn cols => $(map (fn t :: (Type * Type) =>
+ sql_exp [] [] [] t.1) cols)]
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] input col acc =>
+ acc ++ {nm = @sql_inject col.Inject input})
+ {} M.fl (r -- #Id) M.cols
+ ++ {Id = (SQL {[r.Id]})}))
fun doBatch ls =
case ls of
@@ -72,11 +72,11 @@ functor Make(M : sig
| Cons (r, ls) => <xml>
<tr>
<td>{[r.Id]}</td>
- {foldRX2 [colMeta] [fst] [_]
- (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] m v =>
- <xml><td>{m.Show v}</td></xml>)
- [M.cols] M.fl M.cols (r -- #Id)}
+ {@foldRX2 [colMeta] [fst] [_]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] m v =>
+ <xml><td>{m.Show v}</td></xml>)
+ M.fl M.cols (r -- #Id)}
{if withDel then
<xml><td><button value="Delete" onclick={rpc (del r.Id)}/></td></xml>
else
@@ -88,11 +88,11 @@ functor Make(M : sig
<xml><dyn signal={ls <- signal lss; return <xml><table>
<tr>
<th>Id</th>
- {foldRX [colMeta] [_]
- (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] m =>
- <xml><th>{[m.Nam]}</th></xml>)
- [M.cols] M.fl M.cols}
+ {@foldRX [colMeta] [_]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] m =>
+ <xml><th>{[m.Nam]}</th></xml>)
+ M.fl M.cols}
</tr>
{show' ls}
</table></xml>}/></xml>
@@ -103,25 +103,25 @@ functor Make(M : sig
batched <- source Nil;
id <- source "";
- inps <- foldR [colMeta] [fn r => transaction ($(map snd r))]
- (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m acc =>
- s <- m.NewState;
- r <- acc;
- return ({nm = s} ++ r))
- (return {})
- [M.cols] M.fl M.cols;
-
+ inps <- @foldR [colMeta] [fn r => transaction ($(map snd r))]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}] [[nm] ~ rest] m acc =>
+ s <- m.NewState;
+ r <- acc;
+ return ({nm = s} ++ r))
+ (return {})
+ M.fl M.cols;
+
let
fun add () =
id <- get id;
- vs <- foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))]
- (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] m s acc =>
- v <- m.ReadState s;
- r <- acc;
- return ({nm = v} ++ r))
- (return {})
- [M.cols] M.fl M.cols inps;
+ vs <- @foldR2 [colMeta] [snd] [fn r => transaction ($(map fst r))]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] m s acc =>
+ v <- m.ReadState s;
+ r <- acc;
+ return ({nm = v} ++ r))
+ (return {})
+ M.fl M.cols inps;
ls <- get batched;
set batched (Cons ({Id = readError id} ++ vs, ls))
@@ -144,11 +144,11 @@ functor Make(M : sig
<table>
<tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
- {foldRX2 [colMeta] [snd] [_]
- (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] m s =>
- <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>)
- [M.cols] M.fl M.cols inps}
+ {@foldRX2 [colMeta] [snd] [_]
+ (fn [nm :: Name] [p :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] m s =>
+ <xml><tr> <th>{[m.Nam]}:</th> <td>{m.Widget s}</td> </tr></xml>)
+ M.fl M.cols inps}
<tr> <th/> <td><button value="Batch it" onclick={add ()}/></td> </tr>
</table>
diff --git a/demo/crud.ur b/demo/crud.ur
index 21c85d8f..bccc3822 100644
--- a/demo/crud.ur
+++ b/demo/crud.ur
@@ -50,12 +50,12 @@ functor Make(M : sig
(fn (fs : {T : $([Id = int] ++ map fst M.cols)}) => <xml>
<tr>
<td>{[fs.T.Id]}</td>
- {foldRX2 [fst] [colMeta] [tr]
- (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] v col => <xml>
- <td>{col.Show v}</td>
- </xml>)
- [M.cols] M.fl (fs.T -- #Id) M.cols}
+ {@foldRX2 [fst] [colMeta] [tr]
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] v col => <xml>
+ <td>{col.Show v}</td>
+ </xml>)
+ M.fl (fs.T -- #Id) M.cols}
<td>
<a link={upd fs.T.Id}>[Update]</a>
<a link={confirm fs.T.Id}>[Delete]</a>
@@ -66,12 +66,12 @@ functor Make(M : sig
<table border={1}>
<tr>
<th>ID</th>
- {foldRX [colMeta] [tr]
- (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] col => <xml>
- <th>{cdata col.Nam}</th>
- </xml>)
- [M.cols] M.fl M.cols}
+ {@foldRX [colMeta] [tr]
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] col => <xml>
+ <th>{cdata col.Nam}</th>
+ </xml>)
+ M.fl M.cols}
</tr>
{rows}
</table>
@@ -79,14 +79,14 @@ functor Make(M : sig
<br/><hr/><br/>
<form>
- {foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
- (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml>
- <li> {cdata col.Nam}: {col.Widget [nm]}</li>
- {useMore acc}
- </xml>)
- <xml/>
- [M.cols] M.fl M.cols}
+ {@foldR [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (map snd rest)) => <xml>
+ <li> {cdata col.Nam}: {col.Widget [nm]}</li>
+ {useMore acc}
+ </xml>)
+ <xml/>
+ M.fl M.cols}
<submit action={create}/>
</form>
@@ -95,13 +95,13 @@ functor Make(M : sig
and create (inputs : $(map snd M.cols)) =
id <- nextval seq;
dml (insert tab
- (foldR2 [snd] [colMeta]
- [fn cols => $(map (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 ++ {nm = @sql_inject col.Inject (col.Parse input)})
- {} [M.cols] M.fl inputs M.cols
+ (@foldR2 [snd] [colMeta]
+ [fn cols => $(map (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 ++ {nm = @sql_inject col.Inject (col.Parse input)})
+ {} M.fl inputs M.cols
++ {Id = (SQL {[id]})}));
ls <- list ();
return <xml><body>
@@ -113,17 +113,17 @@ functor Make(M : sig
and upd (id : int) =
let
fun save (inputs : $(map snd M.cols)) =
- dml (update [map fst M.cols] !
- (foldR2 [snd] [colMeta]
- [fn cols => $(map (fn t :: (Type * Type) =>
- sql_exp [T = [Id = int]
- ++ map fst M.cols]
- [] [] t.1) cols)]
- (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] =>
- fn input col acc => acc ++ {nm =
- @sql_inject col.Inject (col.Parse input)})
- {} [M.cols] M.fl inputs M.cols)
+ dml (update [map fst M.cols]
+ (@foldR2 [snd] [colMeta]
+ [fn cols => $(map (fn t :: (Type * Type) =>
+ sql_exp [T = [Id = int]
+ ++ map fst M.cols]
+ [] [] t.1) cols)]
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] =>
+ fn input col acc => acc ++ {nm =
+ @sql_inject col.Inject (col.Parse input)})
+ {} M.fl inputs M.cols)
tab (WHERE T.Id = {[id]}));
ls <- list ();
return <xml><body>
@@ -136,16 +136,16 @@ functor Make(M : sig
case fso : (Basis.option {Tab : $(map fst M.cols)}) of
None => return <xml><body>Not found!</body></xml>
| Some fs => return <xml><body><form>
- {foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
- (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
- [[nm] ~ rest] (v : t.1) (col : colMeta t)
- (acc : xml form [] (map snd rest)) =>
- <xml>
- <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
- {useMore acc}
- </xml>)
- <xml/>
- [M.cols] M.fl fs.Tab M.cols}
+ {@foldR2 [fst] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (map snd cols)]
+ (fn [nm :: Name] [t :: (Type * Type)] [rest :: {(Type * Type)}]
+ [[nm] ~ rest] (v : t.1) (col : colMeta t)
+ (acc : xml form [] (map snd rest)) =>
+ <xml>
+ <li> {cdata col.Nam}: {col.WidgetPopulated [nm] v}</li>
+ {useMore acc}
+ </xml>)
+ <xml/>
+ M.fl fs.Tab M.cols}
<submit action={save}/>
</form></body></xml>
diff --git a/demo/metaform.ur b/demo/metaform.ur
index 54bf0fc7..606b3863 100644
--- a/demo/metaform.ur
+++ b/demo/metaform.ur
@@ -5,23 +5,23 @@ functor Make (M : sig
end) = struct
fun handler values = return <xml><body>
- {foldURX2 [string] [string] [body]
- (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name value => <xml>
- <li> {[name]} = {[value]}</li>
- </xml>)
- [M.fs] M.fl M.names values}
+ {@foldURX2 [string] [string] [body]
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name value => <xml>
+ <li> {[name]} = {[value]}</li>
+ </xml>)
+ M.fl M.names values}
</body></xml>
fun main () = return <xml><body>
<form>
- {foldUR [string] [fn cols :: {Unit} => xml form [] (mapU string cols)]
- (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name
- (acc : xml form [] (mapU string rest)) => <xml>
- <li> {[name]}: <textbox{nm}/></li>
- {useMore acc}
- </xml>)
- <xml/>
- [M.fs] M.fl M.names}
+ {@foldUR [string] [fn cols :: {Unit} => xml form [] (mapU string cols)]
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] name
+ (acc : xml form [] (mapU string rest)) => <xml>
+ <li> {[name]}: <textbox{nm}/></li>
+ {useMore acc}
+ </xml>)
+ <xml/>
+ M.fl M.names}
<submit action={handler}/>
</form>
</body></xml>
diff --git a/demo/more/dbgrid.ur b/demo/more/dbgrid.ur
index fe77f21b..b6cd94ae 100644
--- a/demo/more/dbgrid.ur
+++ b/demo/more/dbgrid.ur
@@ -384,31 +384,31 @@ functor Make(M : sig
val wholeRow = @Folder.concat ! M.keyFolder M.rowFolder
fun ensql [env] (r : $(M.key ++ M.row)) =
- map2 [rawMeta] [id] [sql_exp env [] []]
- (fn [t] meta v => @sql_inject meta.Inj v)
- [_] wholeRow M.raw r
+ @map2 [rawMeta] [id] [sql_exp env [] []]
+ (fn [t] meta v => @sql_inject meta.Inj v)
+ wholeRow M.raw r
val new =
- row <- Monad.mapR [rawMeta] [id]
- (fn [nm :: Name] [t :: Type] meta => meta.New)
- [_] wholeRow M.raw;
+ row <- @Monad.mapR _ [rawMeta] [id]
+ (fn [nm :: Name] [t :: Type] meta => meta.New)
+ wholeRow M.raw;
dml (insert M.tab (ensql row));
return row
fun selector (r : $M.key) : sql_exp [T = M.key ++ M.row] [] [] bool =
- foldR2 [rawMeta] [id]
- [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool]
- (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key]
- (meta : rawMeta t) (v : t)
- (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool)
- [rest :: {Type}] [rest ~ [nm = t] ++ key] =>
- (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !}))
- (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE))
- [_] M.keyFolder (M.raw --- map rawMeta M.row) r
- [_] !
+ @foldR2 [rawMeta] [id]
+ [fn key => rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool]
+ (fn [nm :: Name] [t :: Type] [key :: {Type}] [[nm] ~ key]
+ (meta : rawMeta t) (v : t)
+ (exp : rest :: {Type} -> [rest ~ key] => sql_exp [T = key ++ rest] [] [] bool)
+ [rest :: {Type}] [rest ~ [nm = t] ++ key] =>
+ (WHERE T.{nm} = {@sql_inject meta.Inj v} AND {exp [[nm = t] ++ rest] !}))
+ (fn [rest :: {Type}] [rest ~ []] => (WHERE TRUE))
+ M.keyFolder (M.raw --- map rawMeta M.row) r
+ [_] !
fun save key row =
- dml (update [M.key ++ M.row] !
+ dml (update [M.key ++ M.row]
(ensql row)
M.tab
(selector key))
diff --git a/demo/more/grid.ur b/demo/more/grid.ur
index 170c6f2c..7540ca27 100644
--- a/demo/more/grid.ur
+++ b/demo/more/grid.ur
@@ -49,9 +49,9 @@ functor Make(M : sig
fun make (row : M.row) [input] [filter] (m : colMeta' M.row input filter) : transaction input = m.Project row
fun makeAll cols row = @@Monad.exec [transaction] _ [map snd3 M.cols]
- (map2 [fst3] [colMeta M.row] [fn p => transaction (snd3 p)]
- (fn [p] data meta => make row [_] [_] (meta.Handlers data))
- [_] M.folder cols M.cols)
+ (@map2 [fst3] [colMeta M.row] [fn p => transaction (snd3 p)]
+ (fn [p] data meta => make row(meta.Handlers data))
+ M.folder cols M.cols)
(@@Folder.mp [_] [_] M.folder)
type grid = {Cols : $(map fst3 M.cols),
@@ -80,14 +80,14 @@ functor Make(M : sig
Monad.ignore (Dlist.append rows r)
val grid =
- cols <- Monad.mapR [colMeta M.row] [fst3]
- (fn [nm :: Name] [p :: (Type * Type * Type)] meta => meta.Initialize)
- [_] M.folder M.cols;
+ cols <- @Monad.mapR _ [colMeta M.row] [fst3]
+ (fn [nm :: Name] [p :: (Type * Type * Type)] meta => meta.Initialize)
+ M.folder M.cols;
- filters <- Monad.mapR2 [colMeta M.row] [fst3] [thd3]
- (fn [nm :: Name] [p :: (Type * Type * Type)] meta state =>
- (meta.Handlers state).CreateFilter)
- [_] M.folder M.cols cols;
+ filters <- @Monad.mapR2 _ [colMeta M.row] [fst3] [thd3]
+ (fn [nm :: Name] [p :: (Type * Type * Type)] meta state =>
+ (meta.Handlers state).CreateFilter)
+ M.folder M.cols cols;
rows <- Dlist.create;
sel <- source False;
@@ -109,30 +109,30 @@ functor Make(M : sig
fun myFilter grid all =
row <- signal all.Row;
- foldR3 [colMeta M.row] [fst3] [thd3] [fn _ => M.row -> signal bool]
- (fn [nm :: Name] [p :: (Type * Type * Type)]
- [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
- meta state filter combinedFilter row =>
- previous <- combinedFilter row;
- this <- (meta.Handlers state).Filter filter row;
- return (previous && this))
- (fn _ => return True)
- [_] M.folder M.cols grid.Cols grid.Filters row
+ @foldR3 [colMeta M.row] [fst3] [thd3] [fn _ => M.row -> signal bool]
+ (fn [nm :: Name] [p :: (Type * Type * Type)]
+ [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
+ meta state filter combinedFilter row =>
+ previous <- combinedFilter row;
+ this <- (meta.Handlers state).Filter filter row;
+ return (previous && this))
+ (fn _ => return True)
+ M.folder M.cols grid.Cols grid.Filters row
fun render (grid : grid) = <xml>
<table class={tabl}>
<tr class={tr}>
<th/> <th/> <th><button value="No sort" onclick={set grid.Sort None}/></th>
- {foldRX2 [fst3] [colMeta M.row] [_]
- (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
- data (meta : colMeta M.row p) =>
- <xml><th class={th}>
- {case (meta.Handlers data).Sort of
- None => txt (meta.Handlers data).Header
- | sort => <xml><button value={(meta.Handlers data).Header}
- onclick={set grid.Sort sort}/></xml>}
- </th></xml>)
- [_] M.folder grid.Cols M.cols}
+ {@foldRX2 [fst3] [colMeta M.row] [_]
+ (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
+ data (meta : colMeta M.row p) =>
+ <xml><th class={th}>
+ {case (meta.Handlers data).Sort of
+ None => txt (meta.Handlers data).Header
+ | sort => <xml><button value={(meta.Handlers data).Header}
+ onclick={set grid.Sort sort}/></xml>}
+ </th></xml>)
+ M.folder grid.Cols M.cols}
</tr>
{Dlist.render (fn {Row = rowS, Cols = colsS, Updating = ud, Selected = sd} pos =>
@@ -152,18 +152,18 @@ functor Make(M : sig
val save =
cols <- get colsS;
- errors <- Monad.foldR3 [fst3] [colMeta M.row] [snd3] [fn _ => option string]
- (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}]
- [[nm] ~ rest] data meta v errors =>
- b <- current ((meta.Handlers data).Validate v);
- return (if b then
- errors
- else
- case errors of
- None => Some ((meta.Handlers data).Header)
- | Some s => Some ((meta.Handlers data).Header
- ^ ", " ^ s)))
- None [_] M.folder grid.Cols M.cols cols;
+ errors <- @Monad.foldR3 _ [fst3] [colMeta M.row] [snd3] [fn _ => option string]
+ (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}]
+ [[nm] ~ rest] data meta v errors =>
+ b <- current ((meta.Handlers data).Validate v);
+ return (if b then
+ errors
+ else
+ case errors of
+ None => Some ((meta.Handlers data).Header)
+ | Some s => Some ((meta.Handlers data).Header
+ ^ ", " ^ s)))
+ None M.folder grid.Cols M.cols cols;
case errors of
Some s => alert ("Can't save because the following columns have invalid values:\n"
@@ -171,12 +171,12 @@ functor Make(M : sig
| None =>
set ud False;
row <- get rowS;
- row' <- Monad.foldR3 [fst3] [colMeta M.row] [snd3] [fn _ => M.row]
- (fn [nm :: Name] [t :: (Type * Type * Type)]
- [rest :: {(Type * Type * Type)}]
- [[nm] ~ rest] data meta v row' =>
- (meta.Handlers data).Update row' v)
- row [_] M.folder grid.Cols M.cols cols;
+ row' <- @Monad.foldR3 _ [fst3] [colMeta M.row] [snd3] [fn _ => M.row]
+ (fn [nm :: Name] [t :: (Type * Type * Type)]
+ [rest :: {(Type * Type * Type)}]
+ [[nm] ~ rest] data meta v row' =>
+ (meta.Handlers data).Update row' v)
+ row M.folder grid.Cols M.cols cols;
rpc (M.save (M.keyOf row) row');
set rowS row';
@@ -208,29 +208,29 @@ functor Make(M : sig
</td>
<dyn signal={cols <- signal colsS;
- return (foldRX3 [fst3] [colMeta M.row] [snd3] [_]
- (fn [nm :: Name] [t :: (Type * Type * Type)]
- [rest :: {(Type * Type * Type)}]
- [[nm] ~ rest] data meta v =>
- <xml><td class={td}>
- <dyn signal={b <- signal ud;
- return (if b then
- (meta.Handlers data).Edit v
- else
- (meta.Handlers data).Display
- v)}/>
- <dyn signal={b <- signal ud;
- if b then
- valid <-
- (meta.Handlers data).Validate v;
- return (if valid then
- <xml/>
- else
- <xml>!</xml>)
- else
- return <xml/>}/>
- </td></xml>)
- [_] M.folder grid.Cols M.cols cols)}/>
+ return (@foldRX3 [fst3] [colMeta M.row] [snd3] [_]
+ (fn [nm :: Name] [t :: (Type * Type * Type)]
+ [rest :: {(Type * Type * Type)}]
+ [[nm] ~ rest] data meta v =>
+ <xml><td class={td}>
+ <dyn signal={b <- signal ud;
+ return (if b then
+ (meta.Handlers data).Edit v
+ else
+ (meta.Handlers data).Display
+ v)}/>
+ <dyn signal={b <- signal ud;
+ if b then
+ valid <-
+ (meta.Handlers data).Validate v;
+ return (if valid then
+ <xml/>
+ else
+ <xml>!</xml>)
+ else
+ return <xml/>}/>
+ </td></xml>)
+ M.folder grid.Cols M.cols cols)}/>
</tr></xml>
end)
{StartPosition = case M.pageLength of
@@ -250,27 +250,27 @@ functor Make(M : sig
return (f r1 r2)) f)}
grid.Rows}
- <dyn signal={rows <- Dlist.foldl (fn row => Monad.mapR2 [aggregateMeta M.row] [id] [id]
- (fn [nm :: Name] [t :: Type] meta acc =>
- Monad.mp (fn v => meta.Step v acc)
- (signal row.Row))
- [_] M.aggFolder M.aggregates)
- (mp [aggregateMeta M.row] [id]
+ <dyn signal={rows <- Dlist.foldl (fn row => @Monad.mapR2 _ [aggregateMeta M.row] [id] [id]
+ (fn [nm :: Name] [t :: Type] meta acc =>
+ Monad.mp (fn v => meta.Step v acc)
+ (signal row.Row))
+ M.aggFolder M.aggregates)
+ (@mp [aggregateMeta M.row] [id]
(fn [t] meta => meta.Initial)
- [_] M.aggFolder M.aggregates) grid.Rows;
+ M.aggFolder M.aggregates) grid.Rows;
return <xml><tr>
<th colspan={3}>Aggregates</th>
- {foldRX2 [aggregateMeta M.row] [id] [_]
- (fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc =>
- <xml><td class={agg}>{meta.Display acc}</td></xml>)
- [_] M.aggFolder M.aggregates rows}
+ {@foldRX2 [aggregateMeta M.row] [id] [_]
+ (fn [nm :: Name] [t :: Type] [rest :: {Type}] [[nm] ~ rest] meta acc =>
+ <xml><td class={agg}>{meta.Display acc}</td></xml>)
+ M.aggFolder M.aggregates rows}
</tr></xml>}/>
<tr><th colspan={3}>Filters</th>
- {foldRX3 [colMeta M.row] [fst3] [thd3] [_]
- (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
- meta state filter => <xml><td>{(meta.Handlers state).DisplayFilter filter}</td></xml>)
- [_] M.folder M.cols grid.Cols grid.Filters}
+ {@foldRX3 [colMeta M.row] [fst3] [thd3] [_]
+ (fn [nm :: Name] [p :: (Type * Type * Type)] [rest :: {(Type * Type * Type)}] [[nm] ~ rest]
+ meta state filter => <xml><td>{(meta.Handlers state).DisplayFilter filter}</td></xml>)
+ M.folder M.cols grid.Cols grid.Filters}
</tr>
</table>
diff --git a/demo/more/grid1.ur b/demo/more/grid1.ur
index 1eb5e596..2e58bdb7 100644
--- a/demo/more/grid1.ur
+++ b/demo/more/grid1.ur
@@ -35,13 +35,13 @@ open Make(struct
fun render r = r.A
end)
- val cols = {Id = Direct.readOnly [#Id] ! "Id" Direct.int,
- A = Direct.editable [#A] ! "A" Direct.int,
- B = Direct.editable [#B] ! "B" Direct.string,
- C = Direct.editable [#C] ! "C" Direct.bool,
- D = Direct.editable [#D] ! "D" F.meta,
- E = Direct.editable [#E] ! "E" (Direct.nullable Direct.int),
- F = Direct.editable [#F] ! "F" (Direct.nullable F.meta),
+ val cols = {Id = Direct.readOnly [#Id] "Id" Direct.int,
+ A = Direct.editable [#A] "A" Direct.int,
+ B = Direct.editable [#B] "B" Direct.string,
+ C = Direct.editable [#C] "C" Direct.bool,
+ D = Direct.editable [#D] "D" F.meta,
+ E = Direct.editable [#E] "E" (Direct.nullable Direct.int),
+ F = Direct.editable [#F] "F" (Direct.nullable F.meta),
DA = computed "2A" (fn r => 2 * r.A),
Link = computedHtml "Link" (fn r => <xml><a link={page (r.A, r.B)}>Go</a></xml>)}
diff --git a/demo/more/orm.ur b/demo/more/orm.ur
index 620db9ad..d9f57f3b 100644
--- a/demo/more/orm.ur
+++ b/demo/more/orm.ur
@@ -32,9 +32,9 @@ functor Table(M : sig
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 @@ functor Table(M : sig
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 @@ functor Table(M : sig
{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 @@ functor Table(M : sig
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
diff --git a/demo/more/orm1.ur b/demo/more/orm1.ur
index bbbe2b00..b5ba29ac 100644
--- a/demo/more/orm1.ur
+++ b/demo/more/orm1.ur
@@ -1,13 +1,13 @@
open Orm
structure T = Table(struct
- val cols = {A = local [int] _,
- B = local [string] _}
+ val cols = {A = local [int],
+ B = local [string]}
end)
structure S = Table(struct
val cols = {C = T.id,
- D = local [float] _}
+ D = local [float]}
end)
fun action () =
diff --git a/demo/more/versioned.ur b/demo/more/versioned.ur
index bc9911e3..8579559e 100644
--- a/demo/more/versioned.ur
+++ b/demo/more/versioned.ur
@@ -24,33 +24,33 @@ functor Make(M : sig
Eq : eq t}
fun keyRecd (r : $(M.key ++ M.data)) =
- map2 [sql_injectable] [id] [sql_exp [] [] []]
- (fn [t] => @sql_inject)
- [_] M.keyFolder M.key (r --- M.data)
+ @map2 [sql_injectable] [id] [sql_exp [] [] []]
+ (fn [t] => @sql_inject)
+ M.keyFolder M.key (r --- M.data)
fun insert r =
vr <- nextval s;
dml (Basis.insert t
({Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)}
++ keyRecd r
- ++ map2 [dmeta] [id]
+ ++ @map2 [dmeta] [id]
[fn t => sql_exp [] [] [] (option t)]
(fn [t] x v => @sql_inject (@sql_option_prim x.Inj)
(Some v))
- [_] M.dataFolder M.data (r --- M.key)))
+ M.dataFolder M.data (r --- M.key)))
fun keyExp (r : $M.key) : sql_exp [T = all] [] [] bool =
- foldR2 [sql_injectable] [id] [fn before => after :: {Type} -> [before ~ after]
- => sql_exp [T = before ++ after] [] [] bool]
- (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before]
- (inj : sql_injectable t) (v : t)
- (e : after :: {Type} -> [before ~ after]
- => sql_exp [T = before ++ after] [] [] bool)
- [after :: {Type}] [[nm = t] ++ before ~ after] =>
- (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after] !}))
- (fn [after :: {Type}] [[] ~ after] => (SQL TRUE))
- [_] M.keyFolder M.key r
- [_] !
+ @foldR2 [sql_injectable] [id] [fn before => after :: {Type} -> [before ~ after]
+ => sql_exp [T = before ++ after] [] [] bool]
+ (fn [nm :: Name] [t :: Type] [before :: {Type}] [[nm] ~ before]
+ (inj : sql_injectable t) (v : t)
+ (e : after :: {Type} -> [before ~ after]
+ => sql_exp [T = before ++ after] [] [] bool)
+ [after :: {Type}] [[nm = t] ++ before ~ after] =>
+ (SQL t.{nm} = {[v]} AND {e [[nm = t] ++ after] !}))
+ (fn [after :: {Type}] [[] ~ after] => (SQL TRUE))
+ M.keyFolder M.key r
+ [_] !
datatype bound =
NoBound
@@ -61,13 +61,13 @@ functor Make(M : sig
let
fun current' vro r =
let
- val complete = foldR [option] [fn ts => option $ts]
- (fn [nm :: Name] [v :: Type] [r :: {Type}] [[nm] ~ r]
- v r =>
- case (v, r) of
- (Some v, Some r) => Some ({nm = v} ++ r)
- | _ => None)
- (Some {}) [_] M.dataFolder r
+ val complete = @foldR [option] [fn ts => option $ts]
+ (fn [nm :: Name] [v :: Type] [r :: {Type}] [[nm] ~ r]
+ v r =>
+ case (v, r) of
+ (Some v, Some r) => Some ({nm = v} ++ r)
+ | _ => None)
+ (Some {}) M.dataFolder r
in
case complete of
Some r => return (Some r)
@@ -88,19 +88,19 @@ functor Make(M : sig
None => return None
| Some r' =>
let
- val r = map2 [option] [option] [option]
- (fn [t ::: Type] old new =>
- case old of
- None => new
- | Some _ => old)
- [_] M.dataFolder r (r'.T -- #Version)
+ val r = @map2 [option] [option] [option]
+ (fn [t ::: Type] old new =>
+ case old of
+ None => new
+ | Some _ => old)
+ M.dataFolder r (r'.T -- #Version)
in
current' (Lt r'.T.Version) r
end
end
end
in
- current' vro (map0 [option] (fn [t :: Type] => None : option t) [_] M.dataFolder)
+ current' vro (@map0 [option] (fn [t :: Type] => None : option t) M.dataFolder)
end
val current = seek NoBound
@@ -113,14 +113,14 @@ functor Make(M : sig
| Some cur =>
vr <- nextval s;
let
- val r' = map3 [dmeta] [id] [id] [fn t => sql_exp [] [] [] (option t)]
- (fn [t] (meta : dmeta t) old new =>
- @sql_inject (@sql_option_prim meta.Inj)
- (if @@eq [_] meta.Eq old new then
- None
- else
- Some new))
- [_] M.dataFolder M.data cur (r --- M.key)
+ val r' = @map3 [dmeta] [id] [id] [fn t => sql_exp [] [] [] (option t)]
+ (fn [t] (meta : dmeta t) old new =>
+ @sql_inject (@sql_option_prim meta.Inj)
+ (if @@eq [_] meta.Eq old new then
+ None
+ else
+ Some new))
+ M.dataFolder M.data cur (r --- M.key)
val r' = {Version = (SQL {[vr]}), When = (SQL CURRENT_TIMESTAMP)}
++ keyRecd r
++ r'
diff --git a/demo/sum.ur b/demo/sum.ur
index 483cbf0a..c8d42887 100644
--- a/demo/sum.ur
+++ b/demo/sum.ur
@@ -1,7 +1,7 @@
fun sum [fs ::: {Unit}] (fl : folder fs) (x : $(mapU int fs)) =
- foldUR [int] [fn _ => int]
- (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
- 0 [fs] fl x
+ @foldUR [int] [fn _ => int]
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
+ 0 fl x
fun main () = return <xml><body>
{[sum {}]}<br/>
diff --git a/demo/tcSum.ur b/demo/tcSum.ur
index 57e61c38..0026d506 100644
--- a/demo/tcSum.ur
+++ b/demo/tcSum.ur
@@ -1,7 +1,7 @@
fun sum [t] (_ : num t) [fs ::: {Unit}] (fl : folder fs) (x : $(mapU t fs)) =
- foldUR [t] [fn _ => t]
- (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
- zero [fs] fl x
+ @foldUR [t] [fn _ => t]
+ (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] n acc => n + acc)
+ zero fl x
fun main () = return <xml><body>
{[sum {A = 0, B = 1}]}<br/>