diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-11-06 17:09:53 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-11-06 17:09:53 -0500 |
| commit | 36952b2e49afdb4ba8024eb6372992e4b5d8df7a (patch) | |
| tree | 16401277a8c24a1bcfcc410700526f64ba27a5b8 /demo | |
| parent | 49f721d39e46ab0635cc2e9a5ed2a66944586640 (diff) | |
About to begin optimization of recursive transaction functions
Diffstat (limited to 'demo')
| -rw-r--r-- | demo/ref.ur | 2 | ||||
| -rw-r--r-- | demo/tree.ur | 15 | ||||
| -rw-r--r-- | demo/tree.urp | 6 | ||||
| -rw-r--r-- | demo/tree.urs | 1 | ||||
| -rw-r--r-- | demo/treeFun.ur | 35 | ||||
| -rw-r--r-- | demo/treeFun.urs | 22 |
6 files changed, 79 insertions, 2 deletions
diff --git a/demo/ref.ur b/demo/ref.ur index 4030b6fa..1e406dd9 100644 --- a/demo/ref.ur +++ b/demo/ref.ur @@ -1,11 +1,9 @@ structure IR = RefFun.Make(struct type t = int - val inj = _ end) structure SR = RefFun.Make(struct type t = string - val inj = _ end) fun main () = diff --git a/demo/tree.ur b/demo/tree.ur new file mode 100644 index 00000000..06a30cf9 --- /dev/null +++ b/demo/tree.ur @@ -0,0 +1,15 @@ +table t : { Id : int, Parent : option int, Nam : string } + +open TreeFun.Make(struct + val tab = t + end) + +fun row r = <xml> + #{[r.Id]}: {[r.Nam]} +</xml> + +fun main () = + xml <- tree row None; + return <xml><body> + {xml} + </body></xml> diff --git a/demo/tree.urp b/demo/tree.urp new file mode 100644 index 00000000..2270dd06 --- /dev/null +++ b/demo/tree.urp @@ -0,0 +1,6 @@ +debug +database dbname=tree +sql tree.sql + +treeFun +tree diff --git a/demo/tree.urs b/demo/tree.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/demo/tree.urs @@ -0,0 +1 @@ +val main : unit -> transaction page diff --git a/demo/treeFun.ur b/demo/treeFun.ur new file mode 100644 index 00000000..60633695 --- /dev/null +++ b/demo/treeFun.ur @@ -0,0 +1,35 @@ +functor Make(M : sig + type key + con id :: Name + con parent :: Name + con cols :: {Type} + constraint [id] ~ [parent] + constraint [id, parent] ~ cols + + val key_inj : sql_injectable key + val option_key_inj : sql_injectable (option key) + + table tab : [id = key, parent = option key] ++ cols + end) = struct + + open M + + fun tree (f : $([id = key, parent = option key] ++ cols) -> xbody) + (root : option M.key) = + let + fun recurse (root : option key) = + queryX' (SELECT * FROM tab WHERE tab.{parent} = {root}) + (fn r => + children <- recurse (Some r.Tab.id); + return <xml> + <li> {f r.Tab}</li> + + <ul> + {children} + </ul> + </xml>) + in + recurse root + end + +end diff --git a/demo/treeFun.urs b/demo/treeFun.urs new file mode 100644 index 00000000..501a0575 --- /dev/null +++ b/demo/treeFun.urs @@ -0,0 +1,22 @@ +functor Make(M : sig + type key + con id :: Name + con parent :: Name + con cols :: {Type} + constraint [id] ~ [parent] + constraint [id, parent] ~ cols + + val key_inj : sql_injectable key + val option_key_inj : sql_injectable (option key) + + table tab : [id = key, parent = option key] ++ cols + end) : sig + + con id = M.id + con parent = M.parent + + val tree : ($([id = M.key, parent = option M.key] ++ M.cols) -> xbody) + -> option M.key + -> transaction xbody + +end |