From 78266a3fc8ad6a6c3ebefab661cc4f77efc52fd1 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 27 Feb 2008 19:30:31 -0600
Subject: [PATCH] cache statements in db

---
 extra/db/db.factor            | 18 +++++++++-------
 extra/db/tuples/tuples.factor | 39 ++++++++++++++++-------------------
 2 files changed, 28 insertions(+), 29 deletions(-)

diff --git a/extra/db/db.factor b/extra/db/db.factor
index f6596af101..a577ff5fc5 100755
--- a/extra/db/db.factor
+++ b/extra/db/db.factor
@@ -5,10 +5,14 @@ namespaces sequences sequences.lib tuples words strings
 tools.walker ;
 IN: db
 
-TUPLE: db handle ;
-! TUPLE: db handle insert-statements update-statements delete-statements ;
+TUPLE: db
+    handle
+    insert-statements
+    update-statements
+    delete-statements ;
+
 : <db> ( handle -- obj )
-    ! H{ } clone H{ } clone H{ } clone
+    H{ } clone H{ } clone H{ } clone
     db construct-boa ;
 
 GENERIC: make-db* ( seq class -- db )
@@ -21,9 +25,9 @@ HOOK: db-close db ( handle -- )
 
 : dispose-db ( db -- ) 
     dup db [
-        ! dup db-insert-statements dispose-statements
-        ! dup db-update-statements dispose-statements
-        ! dup db-delete-statements dispose-statements
+        dup db-insert-statements dispose-statements
+        dup db-update-statements dispose-statements
+        dup db-delete-statements dispose-statements
         db-handle db-close
     ] with-variable ;
 
@@ -50,7 +54,6 @@ GENERIC# row-column 1 ( result-set n -- obj )
 GENERIC: advance-row ( result-set -- )
 GENERIC: more-rows? ( result-set -- ? )
 
-! must be called from within with-disposal
 : execute-statement ( statement -- )
     dup sequence? [
         [ execute-statement ] each
@@ -101,7 +104,6 @@ GENERIC: more-rows? ( result-set -- ? )
 : do-bound-command ( obj query -- )
     [ bind-statement ] keep execute-statement ;
 
-
 SYMBOL: in-transaction
 HOOK: begin-transaction db ( -- )
 HOOK: commit-transaction db ( -- )
diff --git a/extra/db/tuples/tuples.factor b/extra/db/tuples/tuples.factor
index 96c171c96f..f384ea08db 100755
--- a/extra/db/tuples/tuples.factor
+++ b/extra/db/tuples/tuples.factor
@@ -26,14 +26,14 @@ IN: db.tuples
 HOOK: create-sql-statement db ( class -- obj )
 HOOK: drop-sql-statement db ( class -- obj )
 
-HOOK: <insert-native-statement> db ( tuple -- obj )
-HOOK: <insert-assigned-statement> db ( tuple -- obj )
+HOOK: <insert-native-statement> db ( class -- obj )
+HOOK: <insert-assigned-statement> db ( class -- obj )
 
-HOOK: <update-tuple-statement> db ( tuple -- obj )
-HOOK: <update-tuples-statement> db ( tuple -- obj )
+HOOK: <update-tuple-statement> db ( class -- obj )
+HOOK: <update-tuples-statement> db ( class -- obj )
 
-HOOK: <delete-tuple-statement> db ( tuple -- obj )
-HOOK: <delete-tuples-statement> db ( tuple -- obj )
+HOOK: <delete-tuple-statement> db ( class -- obj )
+HOOK: <delete-tuples-statement> db ( class -- obj )
 
 HOOK: <select-by-slots-statement> db ( tuple -- tuple )
 
@@ -73,14 +73,14 @@ HOOK: insert-tuple* db ( tuple statement -- )
     drop-sql-statement [ execute-statement ] with-disposals ;
 
 : insert-native ( tuple -- )
-    dup class <insert-native-statement> [
-        [ bind-tuple ] 2keep dup . insert-tuple*
-    ] with-disposal ;
+    dup class
+    db get db-insert-statements [ <insert-native-statement> ] cache
+    [ bind-tuple ] 2keep insert-tuple* ;
 
 : insert-assigned ( tuple -- )
-    dup class <insert-assigned-statement> [
-        [ bind-tuple ] keep execute-statement
-    ] with-disposal ;
+    dup class
+    db get db-insert-statements [ <insert-assigned-statement> ] cache
+    [ bind-tuple ] keep execute-statement ;
 
 : insert-tuple ( tuple -- )
     dup class db-columns find-primary-key assigned-id? [
@@ -90,17 +90,14 @@ HOOK: insert-tuple* db ( tuple statement -- )
     ] if ;
 
 : update-tuple ( tuple -- )
-    dup class <update-tuple-statement> [
-        [ bind-tuple ] keep execute-statement
-    ] with-disposal ;
-
-! : update-tuples ( seq -- )
-    ! <update-tuples-statement> execute-statement ;
+    dup class
+    db get db-update-statements [ <update-tuple-statement> ] cache
+    [ bind-tuple ] keep execute-statement ;
 
 : delete-tuple ( tuple -- )
-    dup class <delete-tuple-statement> [
-        [ bind-tuple ] keep execute-statement
-    ] with-disposal ;
+    dup class
+    db get db-delete-statements [ <delete-tuple-statement> ] cache
+    [ bind-tuple ] keep execute-statement ;
 
 : select-tuples ( tuple -- tuple )
     dup dup class <select-by-slots-statement> [