# HG changeset patch # User Adam Chlipala # Date 1225809215 18000 # Node ID d4a81273d4b10b8cf3012ea335a3e09100d29439 # Parent 9163f8014f9b7d38cbf6b253b5ca0ecbe983855b Nested demo diff -r 9163f8014f9b -r d4a81273d4b1 demo/crud.ur --- 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

Inserted with ID {[id]}.

@@ -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 (); diff -r 9163f8014f9b -r d4a81273d4b1 demo/nested.ur --- /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 + + A + + +
+ + + + + + + + + +
Forename:
Enter a Surname?
+ + + +
+ +and fromA r = + let + val forename = r.Forename + + fun pageB () = return + + B + + +
+ Surname: + + + + Previous + +
+ + and pageC' r = pageC (Some r.Surname) + + and pageC surname = return + + C + + +

Hello {[forename]}{case surname of + None => + | Some s => {[s]}}

+ {case surname of + None => Previous + | Some _ => Previous} + +
+ in + if r.EnterSurname then + pageB () + else + pageC None + end + +val main = pageA diff -r 9163f8014f9b -r d4a81273d4b1 demo/nested.urp --- /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 diff -r 9163f8014f9b -r d4a81273d4b1 demo/nested.urs --- /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 diff -r 9163f8014f9b -r d4a81273d4b1 demo/prose --- 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 @@

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.

+nested.urp + +

Here is an implementation of the tiny challenge problem from this web framework comparison. Using nested function definitions, it is easy to persist state across clicks.

+ listShop.urp

This example shows off algebraic datatypes, parametric polymorphism, and functors.

diff -r 9163f8014f9b -r d4a81273d4b1 src/core_untangle.sml --- 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); diff -r 9163f8014f9b -r d4a81273d4b1 src/unnest.sml --- 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