removed inlines from benchmark.factor

added call( and execute( statements to make code compile

diff --git a/mongodb/benchmark/benchmark.factor b/mongodb/benchmark/benchmark.factor
index 683f41b83bdc0ba51246da62fedffac01a58520b..ff963bcebc55fe493cb021f15f16c162e00482de 100644 (file)
--- a/mongodb/benchmark/benchmark.factor
+++ b/mongodb/benchmark/benchmark.factor
@@ -1,6 +1,7 @@
 USING: calendar math fry kernel assocs math.ranges bson.reader io.streams.byte-array
 sequences formatting combinators namespaces io tools.time prettyprint io.encodings.binary
-accessors words mongodb.driver strings math.parser tools.walker bson.writer ;
+accessors words mongodb.driver strings math.parser tools.walker bson.writer
+tools.continuations ;
 
 IN: mongodb.benchmark
 
@@ -106,25 +107,25 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
 : set-doc ( name -- )
     [ result ] dip '[ _ >>doc ] change ; inline
 
-: small-doc ( -- )
-    "small" set-doc ; inline
+: small-doc ( -- quot )
+    "small" set-doc [ ] ; inline
 
-: medium-doc ( -- )
-    "medium" set-doc ; inline
+: medium-doc ( -- quot )
+    "medium" set-doc [ ] ; inline
 
-: large-doc ( -- )
-    "large" set-doc ; inline
+: large-doc ( -- quot )
+    "large" set-doc [ ] ; inline
 
 : small-doc-prepare ( -- quot: ( i -- doc ) )
-    small-doc
-    '[ "x" DOC-SMALL clone [ set-at ] keep ] ; inline
+    small-doc drop
+    '[ "x" DOC-SMALL clone [ set-at ] keep ] ; 
 
 : medium-doc-prepare ( -- quot: ( i -- doc ) )
-    medium-doc
-    '[ "x" DOC-MEDIUM clone [ set-at ] keep ] ; inline
+    medium-doc drop
+    '[ "x" DOC-MEDIUM clone [ set-at ] keep ] ; 
 
 : large-doc-prepare ( -- quot: ( i -- doc ) )
-    large-doc
+    large-doc drop
     [ "x" DOC-LARGE clone [ set-at ] keep 
        [ now "access-time" ] dip
        [ set-at ] keep ] ;
@@ -132,36 +133,36 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
 : (insert) ( quot: ( i -- doc ) collection -- )
     [ trial-size ] 2dip
     '[ _ call( i -- doc ) [ _ ] dip
-       result get lasterror>> [ save ] [ save-unsafe ] if ] each-integer ; inline
+       result get lasterror>> [ save ] [ save-unsafe ] if ] each-integer ; 
 
 : (prepare-batch) ( i b quot: ( i -- doc ) -- batch-seq )
     [ [ * ] keep 1 range boa ] dip
-    '[ _ call( i -- doc ) ] map ; inline
+    '[ _ call( i -- doc ) ] map ; 
 
 : (insert-batch) ( quot: ( i -- doc ) collection -- )
     [ trial-size batch-size [ / ] keep ] 2dip
     '[ _ _ (prepare-batch) [ _ ] dip
        result get lasterror>> [ save ] [ save-unsafe ] if
-    ] each-integer ; inline
+    ] each-integer ; 
 
 : bchar ( boolean -- char )
-    [ "t" ] [ "f" ] if ; inline
+    [ "t" ] [ "f" ] if ; inline 
 
 : collection-name ( -- collection )
     collection "benchmark" get*
     result get doc>>
     result get index>> bchar
     "%s-%s-%s" sprintf
-    [ [ result get ] dip >>collection drop ] keep ; inline
+    [ [ result get ] dip >>collection drop ] keep ; 
     
 : prepare-collection ( -- collection )
     collection-name
     [ "_x_idx" drop-index ] keep
     [ drop-collection ] keep
-    [ create-collection ] keep ; inline
+    [ create-collection ] keep ; 
 
 : prepare-index ( collection -- )
-    "_x_idx" H{ { "x" 1 } } ensure-index ; inline
+    "_x_idx" H{ { "x" 1 } } ensure-index ; 
 
 : insert ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
     prepare-collection
@@ -170,14 +171,14 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
     [ '[ _ _ (insert-batch) ] ] [ '[ _ _ (insert) ] ] if ;
 
 : serialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
-    '[ trial-size [ _ call( i -- doc ) assoc>bv drop ] each-integer ] ; inline
+    '[ trial-size [ _ call( i -- doc ) assoc>bv drop ] each-integer ] ; 
 
 : deserialize ( doc-quot: ( i -- doc ) -- quot: ( -- ) )
     [ 0 ] dip call( i -- doc ) assoc>bv
-    '[ trial-size [  _ binary [ H{ } stream>assoc 2drop ] with-byte-reader ] times ] ; inline
+    '[ trial-size [  _ binary [ H{ } stream>assoc 2drop ] with-byte-reader ] times ] ; 
 
 : check-for-key ( assoc key -- )
-    CHECK-KEY [ swap key? [ "ups... where's the key" throw ] unless ] [ 2drop ] if ; inline
+    CHECK-KEY [ swap key? [ "ups... where's the key" throw ] unless ] [ 2drop ] if ; 
 
 : (check-find-result) ( result -- )
     "x" check-for-key ; inline
@@ -185,24 +186,28 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
 : (find) ( cursor -- )
     [ find [ (check-find-result) ] each (find) ] when* ; inline recursive
 
-: find-one ( -- quot: ( -- ) )
+: find-one ( quot -- quot: ( -- ) )
+    drop
     [ trial-size
       collection-name
       trial-size 2 / "x" H{ } clone [ set-at ] keep
       '[ _ _ <query> 1 limit (find) ] times ] ;
   
-: find-all ( -- quot: ( -- ) )
-      collection-name
-      H{ } clone
-      '[ _ _ <query> (find) ] ;
+: find-all ( quot -- quot: ( -- ) )
+    drop
+    collection-name
+    H{ } clone
+    '[ _ _ <query> (find) ] ;
   
-: find-range ( -- quot: ( -- ) )
+: find-range ( quot -- quot: ( -- ) )
+    break
+    drop
     [ trial-size batch-size /i
        collection-name
        trial-size 2 / "$gt" H{ } clone [ set-at ] keep
        [ trial-size 2 / batch-size + "$lt" ] dip [ set-at ] keep
        "x" H{ } clone [ set-at ] keep
-       '[ _ _ <query> find [ "x" check-for-key ] each drop ] times ] ;
+       '[ _ _ <query> (find) ] times ] ;
 
 : batch ( -- )
     result [ t >>batch ] change ; inline
@@ -221,7 +226,7 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
       trial-size ] dip
     1000000 / /i
     "%-18s: {batch:%s,index:%s;errchk:%s} %10s docs/s"
-    sprintf print flush ; inline
+    sprintf print flush ; 
 
 : print-separator ( -- )
     "----------------------------------------------------------------" print flush ; inline
@@ -236,45 +241,44 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
     sprintf print flush
     print-separator-bold ;
 
-: with-result ( quot: ( -- ) -- )
-    [ <result> ] prepose
-    [ print-result ] compose with-scope ; inline
+: with-result ( options quot -- )
+    '[ <result> _ call( options -- time ) print-result ] with-scope ; 
 
 : [bench-quot] ( feat-seq op-word -- quot: ( doc-word -- ) )
     '[ _ swap _
-       '[ [ [ _ execute( -- quot: ( i -- doc ) ) ] dip
-          [ execute( -- ) ] each _ execute( -- quot: ( -- ) ) benchmark ] with-result ] each
-       print-separator ] ; inline
+       '[ [ [ _ execute( -- quot ) ] dip
+          [ execute( -- ) ] each _ execute( quot -- quot ) benchmark ] with-result ] each
+       print-separator ] ; 
 
 : run-serialization-bench ( doc-word-seq feat-seq -- )
     "Serialization Tests" print
     print-separator-bold
-    \ serialize [bench-quot] each ; inline
+    \ serialize [bench-quot] '[ _ call( doc-word -- ) ] each ; 
 
 : run-deserialization-bench ( doc-word-seq feat-seq -- )
     "Deserialization Tests" print
     print-separator-bold
-    \ deserialize [bench-quot] each ; inline
+    \ deserialize [bench-quot] '[ _ call( doc-word -- ) ] each ; 
     
 : run-insert-bench ( doc-word-seq feat-seq -- )
     "Insert Tests" print
     print-separator-bold 
-    \ insert [bench-quot] each ; inline
+    \ insert [bench-quot] '[ _ call( doc-word -- ) ] each ; 
 
 : run-find-one-bench ( doc-word-seq feat-seq -- )
     "Query Tests - Find-One" print
     print-separator-bold
-    \ find-one [bench-quot] each ; inline
+    \ find-one [bench-quot] '[ _ call( doc-word -- ) ] each ; 
 
 : run-find-all-bench ( doc-word-seq feat-seq -- )
     "Query Tests - Find-All" print
     print-separator-bold
-    \ find-all [bench-quot] each ; inline
+    \ find-all [bench-quot] '[ _ call( doc-word -- ) ] each ; 
 
 : run-find-range-bench ( doc-word-seq feat-seq -- )
     "Query Tests - Find-Range" print
     print-separator-bold
-    \ find-range [bench-quot] each ; inline
+    \ find-range [bench-quot] '[ _ call( doc-word -- ) ] each ; 
 
     
 : run-benchmarks ( -- )

diff --git a/mongodb/connection/connection.factor b/mongodb/connection/connection.factor
index 87718a97884421a8d495883ef5adf2a4ab5159a4..7e5bd81f58423d16fdf7685a249ab0c1860216f9 100644 (file)
--- a/mongodb/connection/connection.factor
+++ b/mongodb/connection/connection.factor
@@ -19,8 +19,9 @@ TUPLE: mdb-connection instance node handle remote local ;
 
 CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
 
-: check-ok ( result -- ? )
-     [ "ok" ] dip at >integer 1 =  ; inline 
+: check-ok ( result -- errmsg ? )
+    [ [ "errmsg" ] dip at ] 
+    [ [ "ok" ] dip at >integer 1 = ] bi ; inline 
 
 : <mdb-db> ( name nodes -- mdb-db )
     mdb-db new swap >>nodes swap >>name H{ } clone >>collections ;
@@ -87,7 +88,7 @@ CONSTRUCTOR: mdb-connection ( instance -- mdb-connection ) ;
     
 : perform-authentication ( --  )
     cmd-collection build-auth-query send-query-1result
-    dup check-ok [ drop ] [ [ "errmsg" ] dip at throw ] if ; inline
+    check-ok [ drop ] [ throw ] if ; inline
 
 : authenticate-connection ( mdb-connection -- )
    [ mdb-connection get instance>> auth?

diff --git a/mongodb/driver/driver.factor b/mongodb/driver/driver.factor
index 426167b08e78f15f130c62439f76cc87af7e8ff5..02b2f1b7c8e6600896f700dc3f7e70828d4d1aef 100644 (file)
--- a/mongodb/driver/driver.factor
+++ b/mongodb/driver/driver.factor
@@ -86,7 +86,7 @@ M: mdb-collection create-collection ( mdb-collection -- )
         ] 2bi
     ] keep <mdb-query-msg> 1 >>return# send-query-plain
     objects>> first check-ok
-    [ "could not create collection" throw ] unless ;
+    [ drop ] [ throw ] if ;
 
 : load-collection-list ( -- collection-list )
     namespaces-collection
@@ -101,7 +101,6 @@ M: mdb-collection create-collection ( mdb-collection -- )
 USE: tools.continuations
 
 : (ensure-collection) ( collection --  )
-    break
     mdb-instance collections>> dup keys length 0 = 
     [ load-collection-list      
       [ [ "options" ] dip key? ] filter
@@ -170,7 +169,7 @@ M: mdb-query-msg count
     [ collection>> "count" H{ } clone [ set-at ] keep ] keep
     query>> [ over [ "query" ] dip set-at ] when*
     [ cmd-collection ] dip <mdb-query-msg> find-one 
-    [ check-ok ] keep '[ "n" _ at >fixnum ] [ f ] if ;
+    [ check-ok nip ] keep '[ "n" _ at >fixnum ] [ f ] if ;
 
 : lasterror ( -- error )
     cmd-collection H{ { "getlasterror" 1 } } <mdb-query-msg>
@@ -180,8 +179,8 @@ GENERIC: validate. ( collection -- )
 M: string validate.
     [ cmd-collection ] dip
     "validate" H{ } clone [ set-at ] keep
-    <mdb-query-msg> find-one [ check-ok ] keep
-    '[ "result" _ at print ] when ;
+    <mdb-query-msg> find-one [ check-ok nip ] keep
+    '[ "result" _ at print ] [  ] if ;
 M: mdb-collection validate.
     name>> validate. ;