From 449f677ad8262c2c98d94a6369dad3deb3682215 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Fri, 24 Apr 2009 08:24:12 +0200 Subject: [PATCH] removed inlines from benchmark.factor added call( and execute( statements to make code compile --- mongodb/benchmark/benchmark.factor | 88 +++++++++++++++------------- mongodb/connection/connection.factor | 7 ++- mongodb/driver/driver.factor | 9 ++- 3 files changed, 54 insertions(+), 50 deletions(-) diff --git a/mongodb/benchmark/benchmark.factor b/mongodb/benchmark/benchmark.factor index 683f41b83b..ff963bcebc 100644 --- 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 '[ _ _ 1 limit (find) ] times ] ; -: find-all ( -- quot: ( -- ) ) - collection-name - H{ } clone - '[ _ _ (find) ] ; +: find-all ( quot -- quot: ( -- ) ) + drop + collection-name + H{ } clone + '[ _ _ (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 - '[ _ _ find [ "x" check-for-key ] each drop ] times ] ; + '[ _ _ (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: ( -- ) -- ) - [ ] prepose - [ print-result ] compose with-scope ; inline +: with-result ( options quot -- ) + '[ _ 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 87718a9788..7e5bd81f58 100644 --- 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 : ( 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 426167b08e..02b2f1b7c8 100644 --- a/mongodb/driver/driver.factor +++ b/mongodb/driver/driver.factor @@ -86,7 +86,7 @@ M: mdb-collection create-collection ( mdb-collection -- ) ] 2bi ] keep 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 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 } } @@ -180,8 +179,8 @@ GENERIC: validate. ( collection -- ) M: string validate. [ cmd-collection ] dip "validate" H{ } clone [ set-at ] keep - find-one [ check-ok ] keep - '[ "result" _ at print ] when ; + find-one [ check-ok nip ] keep + '[ "result" _ at print ] [ ] if ; M: mdb-collection validate. name>> validate. ;