summaryrefslogtreecommitdiff
path: root/demo
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-06 17:09:53 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-06 17:09:53 -0500
commit36952b2e49afdb4ba8024eb6372992e4b5d8df7a (patch)
tree16401277a8c24a1bcfcc410700526f64ba27a5b8 /demo
parent49f721d39e46ab0635cc2e9a5ed2a66944586640 (diff)
About to begin optimization of recursive transaction functions
Diffstat (limited to 'demo')
-rw-r--r--demo/ref.ur2
-rw-r--r--demo/tree.ur15
-rw-r--r--demo/tree.urp6
-rw-r--r--demo/tree.urs1
-rw-r--r--demo/treeFun.ur35
-rw-r--r--demo/treeFun.urs22
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