Mercurial > urweb
changeset 455:d4a81273d4b1
Nested demo
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Tue, 04 Nov 2008 09:33:35 -0500 |
| parents | 9163f8014f9b |
| children | 1a4fa157fedd |
| files | demo/crud.ur demo/nested.ur demo/nested.urp demo/nested.urs demo/prose src/core_untangle.sml src/unnest.sml |
| diffstat | 7 files changed, 113 insertions(+), 13 deletions(-) [+] |
line wrap: on
line diff
--- a/demo/crud.ur Sat Nov 01 21:24:43 2008 -0400 +++ b/demo/crud.ur Tue Nov 04 09:33:35 2008 -0500 @@ -100,9 +100,9 @@ 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)) + fn input col acc => acc ++ {nm = @sql_inject col.Inject (col.Parse input)}) {} [M.cols] inputs M.cols - with #Id = (SQL {id}))); + ++ {Id = (SQL {id})})); ls <- list (); return <xml><body> <p>Inserted with ID {[id]}.</p> @@ -119,8 +119,8 @@ [] [] 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)) + fn input col acc => acc ++ {nm = + @sql_inject col.Inject (col.Parse input)}) {} [M.cols] inputs M.cols) tab (WHERE T.Id = {id})); ls <- list ();
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/nested.ur Tue Nov 04 09:33:35 2008 -0500 @@ -0,0 +1,62 @@ +fun pageA () = return <xml> + <head> + <title>A</title> + </head> + <body> + <form> + <table> + <tr> + <td>Forename:</td> + <td><textbox{#Forename}/></td> + </tr> + <tr> + <td>Enter a Surname?</td> + <td><checkbox{#EnterSurname}/></td> + </tr> + </table> + <submit action={fromA} /> + </form> + </body> +</xml> + +and fromA r = + let + val forename = r.Forename + + fun pageB () = return <xml> + <head> + <title>B</title> + </head> + <body> + <form> + Surname: + <textbox{#Surname}/> + <submit action={pageC'} /> + </form> + <a link={pageA ()}>Previous</a> + </body> + </xml> + + and pageC' r = pageC (Some r.Surname) + + and pageC surname = return <xml> + <head> + <title>C</title> + </head> + <body> + <p>Hello {[forename]}{case surname of + None => <xml/> + | Some s => <xml> {[s]}</xml>}</p> + {case surname of + None => <xml><a link={pageA ()}>Previous</a></xml> + | Some _ => <xml><a link={pageB ()}>Previous</a></xml>} + </body> + </xml> + in + if r.EnterSurname then + pageB () + else + pageC None + end + +val main = pageA
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/nested.urp Tue Nov 04 09:33:35 2008 -0500 @@ -0,0 +1,2 @@ + +nested
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/demo/nested.urs Tue Nov 04 09:33:35 2008 -0500 @@ -0,0 +1,1 @@ +val main : unit -> transaction page
--- a/demo/prose Sat Nov 01 21:24:43 2008 -0400 +++ b/demo/prose Tue Nov 04 09:33:35 2008 -0500 @@ -54,6 +54,10 @@ <p>Here we see a basic form. The type system tracks which form inputs we include, and it enforces that the form handler function expects a record containing exactly those fields, with exactly the proper types.</p> +nested.urp + +<p>Here is an implementation of the tiny challenge problem from <a href="http://www.accursoft.co.uk/web/">this web framework comparison</a>. Using nested function definitions, it is easy to persist state across clicks.</p> + listShop.urp <p>This example shows off algebraic datatypes, parametric polymorphism, and functors.</p>
--- a/src/core_untangle.sml Sat Nov 01 21:24:43 2008 -0400 +++ b/src/core_untangle.sml Tue Nov 04 09:33:35 2008 -0500 @@ -45,6 +45,15 @@ fun untangle file = let + val edefs = foldl (fn ((d, _), edefs) => + case d of + DVal (_, n, _, e, _) => IM.insert (edefs, n, e) + | DValRec vis => + foldl (fn ((_, n, _, e, _), edefs) => + IM.insert (edefs, n, e)) edefs vis + | _ => edefs) + IM.empty file + fun decl (dAll as (d, loc)) = case d of DValRec vis => @@ -52,16 +61,35 @@ val thisGroup = foldl (fn ((_, n, _, _, _), thisGroup) => IS.add (thisGroup, n)) IS.empty vis + val expUsed = U.Exp.fold {con = default, + kind = default, + exp = exp} IS.empty + val used = foldl (fn ((_, n, _, e, _), used) => let - val usedHere = U.Exp.fold {con = default, - kind = default, - exp = exp} IS.empty e + val usedHere = expUsed e in - IM.insert (used, n, IS.intersection (usedHere, thisGroup)) + IM.insert (used, n, usedHere) end) IM.empty vis + fun expand used = + IS.foldl (fn (n, used) => + case IM.find (edefs, n) of + NONE => used + | SOME e => + let + val usedHere = expUsed e + in + if IS.isEmpty (IS.difference (usedHere, used)) then + used + else + expand (IS.union (usedHere, used)) + end) + used used + + val used = IM.map (fn s => IS.intersection (expand s, thisGroup)) used + fun p_graph reachable = IM.appi (fn (n, reachableHere) => (print (Int.toString n);
--- a/src/unnest.sml Sat Nov 01 21:24:43 2008 -0400 +++ b/src/unnest.sml Tue Nov 04 09:33:35 2008 -0500 @@ -137,7 +137,7 @@ type state = { maxName : int, - decls : decl list + decls : (string * int * con * exp) list } fun kind (k, st) = (k, st) @@ -278,11 +278,9 @@ end) vis - val d = (DValRec vis, #2 ed) - val ts = map (fn (x, _, t, _) => (x, t)) vis @ ts in - ([], (ts, maxName, d :: ds, subs)) + ([], (ts, maxName, vis @ ds, subs)) end) (ts, #maxName st, #decls st, []) eds in @@ -319,8 +317,13 @@ fun explore () = let val (d, st) = unnestDecl st all + + val ds = + case #1 d of + DValRec vis => [(DValRec (vis @ #decls st), #2 d)] + | _ => [(DValRec (#decls st), #2 d), d] in - (rev (d :: #decls st), + (ds, {maxName = #maxName st, decls = []}) end