Mercurial > urweb
annotate tests/gform.ur @ 1249:7c6fc92f6c31
Complain about DValRec; optimizations for unit-valued ECase and forgetting of path conditions across ESeq
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 29 Apr 2010 11:47:24 -0400 |
parents | 71bafe66dbe1 |
children |
rev | line source |
---|---|
adamc@146 | 1 con stringify = fold (fn nm :: Name => fn u :: Unit => fn t :: {Type} => [nm = string] ++ t) [] |
adamc@146 | 2 |
adamc@146 | 3 signature S = sig |
adamc@146 | 4 con rs :: {Unit} |
adamc@146 | 5 end |
adamc@146 | 6 |
adamc@146 | 7 signature S' = sig |
adamc@146 | 8 con rs :: {Unit} |
adamc@146 | 9 |
adamc@146 | 10 val handler : $(stringify rs) -> page |
adamc@146 | 11 val page : unit -> page |
adamc@146 | 12 end |
adamc@146 | 13 |
adamc@146 | 14 functor F (M : S) : S' where con rs = M.rs = struct |
adamc@146 | 15 con rs = M.rs |
adamc@146 | 16 |
adamc@146 | 17 val handler = fn x : $(stringify M.rs) => <html><body> |
adamc@150 | 18 {fold [fn rs :: {Unit} => $(stringify rs) -> xml body [] []] |
adamc@150 | 19 (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} => |
adamc@150 | 20 fn f : $(stringify rest) -> xml body [] [] => |
adamc@150 | 21 fn x : $(stringify ([nm] ++ rest)) => |
adamc@150 | 22 <body><li> {cdata x.nm}</li> {f (x -- nm)}</body>) |
adamc@150 | 23 (fn x => <body></body>) |
adamc@150 | 24 [M.rs] x} |
adamc@146 | 25 </body></html> |
adamc@146 | 26 |
adamc@146 | 27 val page = fn () => <html><body> |
adamc@147 | 28 <lform> |
adamc@147 | 29 {fold [fn rs :: {Unit} => xml lform [] (stringify rs)] |
adamc@147 | 30 (fn nm :: Name => fn u :: Unit => fn rest :: {Unit} => |
adamc@147 | 31 fn frag : xml lform [] (stringify rest) => |
adamc@148 | 32 <lform><li> <textbox{nm}/></li> {useMore frag}</lform>) |
adamc@147 | 33 <lform></lform> |
adamc@147 | 34 [rs]} |
adamc@146 | 35 |
adamc@147 | 36 <submit action={handler}/> |
adamc@147 | 37 </lform> |
adamc@146 | 38 </body></html> |
adamc@146 | 39 end |
adamc@146 | 40 |
adamc@146 | 41 structure M = F(struct |
adamc@147 | 42 con rs = [A, B, C] |
adamc@146 | 43 end) |
adamc@146 | 44 |
adamc@146 | 45 open M |
adamc@146 | 46 |