From 45bf6d15b049ae8365ca320c8d8a33e22c7019ae Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Fri, 1 May 2009 16:06:18 +0200 Subject: [PATCH 1/6] fixed missing use --- extra/mongodb/mmm/mmm.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/mongodb/mmm/mmm.factor b/extra/mongodb/mmm/mmm.factor index 467070859e..25c4c88203 100644 --- a/extra/mongodb/mmm/mmm.factor +++ b/extra/mongodb/mmm/mmm.factor @@ -1,6 +1,6 @@ USING: accessors fry io io.encodings.binary io.servers.connection io.sockets io.streams.byte-array kernel math mongodb.msg classes formatting -namespaces prettyprint tools.walker calendar calendar.format +namespaces prettyprint tools.walker calendar calendar.format bson.writer.private json.writer mongodb.operations.private mongodb.operations ; IN: mongodb.mmm From cce0341e28dfaf0868a858fd8fa6712cf585f7a9 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Fri, 1 May 2009 16:13:51 +0200 Subject: [PATCH 2/6] fixed compile errors --- extra/mongodb/tuple/tuple.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/mongodb/tuple/tuple.factor b/extra/mongodb/tuple/tuple.factor index beb7f41384..e4c2e5b69a 100644 --- a/extra/mongodb/tuple/tuple.factor +++ b/extra/mongodb/tuple/tuple.factor @@ -20,7 +20,7 @@ SYNTAX: MDBTUPLE: tuple-collection [ create-collection ] [ [ tuple-index-list ] keep - '[ _ name>> swap [ name>> ] [ spec>> ] bi ensure-index ] each + '[ _ name>> swap [ name>> ] [ spec>> ] bi ensure-index ] each ] bi ; : ensure-tables ( classes -- ) @@ -80,4 +80,4 @@ PRIVATE> : count-tuples ( tuple/query -- n ) dup mdb-query-msg? [ tuple>query ] unless - [ collection>> ] [ query>> ] bi count ; + [ collection>> ] [ query>> ] bi count ; From 286026d5d5abd6b0c5c32e2b3d634633cca52d77 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Fri, 1 May 2009 16:22:48 +0200 Subject: [PATCH 3/6] fixed tuple query --- extra/mongodb/tuple/tuple.factor | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/extra/mongodb/tuple/tuple.factor b/extra/mongodb/tuple/tuple.factor index e4c2e5b69a..19281b769a 100644 --- a/extra/mongodb/tuple/tuple.factor +++ b/extra/mongodb/tuple/tuple.factor @@ -71,13 +71,12 @@ PRIVATE> tuple>selector ; : select-tuple ( tuple/query -- tuple/f ) - dup mdb-query-msg? [ ] [ tuple>query ] if + dup mdb-query-msg? [ tuple>query ] unless find-one [ assoc>tuple ] [ f ] if* ; : select-tuples ( tuple/query -- cursor tuples/f ) - dup mdb-query-msg? [ ] [ tuple>query ] if + dup mdb-query-msg? [ tuple>query ] unless find [ assoc>tuple ] map ; : count-tuples ( tuple/query -- n ) - dup mdb-query-msg? [ tuple>query ] unless - [ collection>> ] [ query>> ] bi count ; + dup mdb-query-msg? [ tuple>query ] unless count ; From 62846be4f6155f3e572ac277b4460dcb5cbf23bf Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Fri, 1 May 2009 16:23:06 +0200 Subject: [PATCH 4/6] removed trash / reformatted some lines --- extra/bson/writer/writer.factor | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/extra/bson/writer/writer.factor b/extra/bson/writer/writer.factor index ae12ca0a03..1b9d45b124 100644 --- a/extra/bson/writer/writer.factor +++ b/extra/bson/writer/writer.factor @@ -6,11 +6,8 @@ io.encodings.utf8 io.streams.byte-array kernel math math.parser namespaces quotations sequences sequences.private serialize strings words combinators.short-circuit literals ; - IN: bson.writer -#! Writes the object out to a byte-vector in BSON format - [ shared-buffer set ] keep ] unless* ; inline : >le-stream ( x n -- ) - ! >le write - swap '[ _ swap nth-byte 0 B{ 0 } - [ set-nth-unsafe ] keep write ] each - ; inline + swap + '[ _ swap nth-byte 0 B{ 0 } + [ set-nth-unsafe ] keep write ] each ; inline PRIVATE> From f2ec59d6589d8bf94032ba26a9ad2c01fa8068b0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 1 May 2009 09:36:53 -0500 Subject: [PATCH 5/6] Fix infinite loop when compiling a word containing a tuple literal with circular structure in it. This was triggered by call( inline caching in core-foundation.fsevents on Mac OS X --- basis/compiler/tree/propagation/info/info.factor | 15 ++++++--------- .../tree/propagation/propagation-tests.factor | 7 ++++++- .../compiler/tree/propagation/slots/slots.factor | 7 ++++++- 3 files changed, 18 insertions(+), 11 deletions(-) diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 2776ed914f..4d4b22218d 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -59,21 +59,18 @@ CONSTANT: object-info T{ value-info f object full-interval } : ( -- info ) \ value-info new ; -: read-only-slots ( values class -- slots ) - all-slots - [ read-only>> [ drop f ] unless ] 2map - f prefix ; - DEFER: +: tuple-slot-infos ( tuple -- slots ) + [ tuple-slots ] [ class all-slots ] bi + [ read-only>> [ ] [ drop f ] if ] 2map + f prefix ; + : init-literal-info ( info -- info ) dup literal>> class >>class dup literal>> dup real? [ [a,a] >>interval ] [ [ [-inf,inf] >>interval ] dip - dup tuple? [ - [ tuple-slots [ ] map ] [ class ] bi - read-only-slots >>slots - ] [ drop ] if + dup tuple? [ tuple-slot-infos >>slots ] [ drop ] if ] if ; inline : init-value-info ( info -- info ) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index ed8d2983b5..eba41dbfdf 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -9,7 +9,7 @@ compiler.tree.propagation.info compiler.tree.def-use compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals specialized-arrays.double system sorting math.libm -math.intervals ; +math.intervals quotations ; IN: compiler.tree.propagation.tests [ V{ } ] [ [ ] final-classes ] unit-test @@ -686,3 +686,8 @@ TUPLE: littledan-2 { from read-only } { to read-only } ; [ V{ 0 } ] [ [ { } length ] final-literals ] unit-test [ V{ 1 } ] [ [ { } length 1+ f length ] final-literals ] unit-test + +! Mutable tuples with circularity should not cause problems +TUPLE: circle me ; + +[ ] [ circle new dup >>me 1quotation final-info drop ] unit-test \ No newline at end of file diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor index 89c2bada8b..86114772f7 100644 --- a/basis/compiler/tree/propagation/slots/slots.factor +++ b/basis/compiler/tree/propagation/slots/slots.factor @@ -30,8 +30,13 @@ UNION: fixed-length-sequence array byte-array string ; [ [ literal>> ] map ] dip prefix >tuple ; +: read-only-slots ( values class -- slots ) + all-slots + [ read-only>> [ value-info ] [ drop f ] if ] 2map + f prefix ; + : (propagate-tuple-constructor) ( values class -- info ) - [ [ value-info ] map ] dip [ read-only-slots ] keep + [ read-only-slots ] keep over rest-slice [ dup [ literal?>> ] when ] all? [ [ rest-slice ] dip fold- ] [ From abac42a00118e2892c6af208cb33b153a8060d53 Mon Sep 17 00:00:00 2001 From: Sascha Matzke Date: Fri, 1 May 2009 18:31:19 +0200 Subject: [PATCH 6/6] fixed driver documentation --- extra/mongodb/driver/driver-docs.factor | 110 ++++++++++++------------ extra/mongodb/driver/driver.factor | 8 +- 2 files changed, 61 insertions(+), 57 deletions(-) diff --git a/extra/mongodb/driver/driver-docs.factor b/extra/mongodb/driver/driver-docs.factor index 48d7f7b65f..1086105306 100644 --- a/extra/mongodb/driver/driver-docs.factor +++ b/extra/mongodb/driver/driver-docs.factor @@ -8,10 +8,8 @@ HELP: { "name" "name of the collection" } { "collection" "mdb-collection instance" } } -{ $description "Creates a new mdb-collection instance. Use this to create capped/limited collections. See also: " { $link mdb-collection } } -{ $examples - { $example "! creates a mdb-collection instance capped to a maximum of 1000000 entries" - "\"mycollection\" t >>capped 1000000 >>max" } } ; +{ $examples { $unchecked-example "USING: mongodb.driver ;" "\"mycollection\" t >>capped 1000000 >>max" "" } } +{ $description "Creates a new mdb-collection instance. Use this to create capped/limited collections." } ; HELP: { $values @@ -22,7 +20,7 @@ HELP: } { $description "Create a new mdb-db instance and automatically resolves master/slave information in a paired MongoDB setup." } { $examples - { $example "\"db\" \"127.0.0.1\" 27017 " } } ; + { $unchecked-example "USING: mongodb.driver ;" "\"db\" \"127.0.0.1\" 27017 " "" } } ; HELP: { $values @@ -35,7 +33,7 @@ HELP: "For more see: " { $link with-db } } { $examples - { $example "\"mycollection\" H{ } " } } ; + { $unchecked-example "USING: mongodb.driver ;" "\"mycollection\" H{ } " "" } } ; HELP: { $values @@ -118,22 +116,22 @@ HELP: drop-index HELP: ensure-collection { $values - { "collection" "a collection; e.g. mycollection " } - { "fq-collection" "full qualified collection name; e.g. db.mycollection" } + { "name" "a collection; e.g. mycollection " } } -{ $description "ensures that the collection exists in the database and returns its full qualified name" } ; +{ $description "ensures that the collection exists in the database" } ; HELP: ensure-index { $values - { "collection" "a collection" } - { "name" "index name" } - { "spec" "index spec" } + { "index-spec" "an index specification" } } { $description "Ensures the existence of the given index. " "For more information on MongoDB indexes see: " { $url "http://www.mongodb.org/display/DOCS/Indexes" } } { $examples - { $example "\"mycollection\" nameIdx [ \"name\" asc ] keyspec ensure-index" } - { $example "\"mycollection\" nameIdx [ \"name\" asc ] keyspec unique-index ensure-index" } } ; + { $unchecked-example "USING: mongodb.driver ;" + "\"db\" \"127.0.0.1\" 27017 " + "[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec ensure-index ] with-db" "" } + { $unchecked-example "USING: mongodb.driver ;" + "\"db\" \"127.0.0.1\" 27017 " "[ \"mycollection\" nameIdx [ \"name\" asc ] keyspec unique-index ensure-index ] with-db" "" } } ; HELP: explain. { $values @@ -143,31 +141,35 @@ HELP: explain. HELP: find { $values - { "mdb-query" "a query" } - { "cursor" "a cursor (if there are more results) or f" } - { "result" "a sequences of objects" } + { "selector" "a mdb-query or mdb-cursor" } + { "mdb-cursor/f" "a cursor (if there are more results) or f" } + { "seq" "a sequences of objects" } } { $description "executes the given query" } { $examples - { $example "\"mycollection\" H{ { \"name\" \"Alfred\" } } find " } } ; + { $unchecked-example "USING: mongodb.driver ;" + "\"db\" \"127.0.0.1\" 27017 " + "[ \"mycollection\" H{ { \"name\" \"Alfred\" } } find ] with-db" "" } } ; HELP: find-one { $values - { "mdb-query" "a query" } - { "result" "a single object or f" } + { "mdb-query-msg" "a query" } + { "result/f" "a single object or f" } } { $description "Executes the query and returns one object at most" } ; HELP: hint { $values - { "mdb-query" "a query" } + { "mdb-query-msg" "a query" } { "index-hint" "a hint to an index" } - { "mdb-query" "modified query object" } + { "mdb-query-msg" "modified query object" } } { $description "Annotates the query with a hint to an index. " "For detailed information see: " { $url "http://www.mongodb.org/display/DOCS/Optimizing+Mongo+Performance#OptimizingMongoPerformance-Hint" } } { $examples - { $example "\"mycollection\" H{ { \"name\" \"Alfred\" } { \"age\" 70 } } H{ { \"name\" 1 } } hint find" } } ; + { $unchecked-example "USING: mongodb.driver ;" + "\"db\" \"127.0.0.1\" 27017 " + "[ \"mycollection\" H{ { \"name\" \"Alfred\" } { \"age\" 70 } } H{ { \"name\" 1 } } hint find ] with-db" "" } } ; HELP: lasterror { $values @@ -179,13 +181,15 @@ HELP: lasterror HELP: limit { $values - { "mdb-query" "a query" } + { "mdb-query-msg" "a query" } { "limit#" "number of objects that should be returned at most" } - { "mdb-query" "modified query object" } + { "mdb-query-msg" "modified query object" } } { $description "Limits the number of returned objects to limit#" } { $examples - { $example "\"mycollection\" H{ } 10 limit find" } } ; + { $unchecked-example "USING: mongodb.driver ;" + "\"db\" \"127.0.0.1\" 27017 " + "[ \"mycollection\" H{ } 10 limit find ] with-db" "" } } ; HELP: load-collection-list { $values @@ -202,23 +206,23 @@ HELP: load-index-list { $description "Returns a list of all indexes that exist in the current database" } ; HELP: mdb-collection -{ $var-description "" } ; +{ $var-description "MongoDB collection" } ; HELP: mdb-cursor -{ $var-description "" } ; +{ $var-description "MongoDB cursor" } ; HELP: mdb-error { $values { "msg" "error message" } } -{ $description "" } ; +{ $description "error class" } ; HELP: r/ { $values - { "token" null } - { "mdbregexp" null } + { "token" "a regexp string" } + { "mdbregexp" "a mdbregexp tuple instance" } } -{ $description "" } ; +{ $description "creates a new mdbregexp instance" } ; HELP: save { $values @@ -230,53 +234,53 @@ HELP: save HELP: save-unsafe { $values - { "collection" null } - { "object" object } + { "collection" "a collection" } + { "assoc" "object" } } -{ $description "" } ; +{ $description "Save the object to the given collection without automatic error check" } ; HELP: skip { $values - { "mdb-query" null } - { "skip#" null } - { "mdb-query" null } + { "mdb-query-msg" "a query message" } + { "skip#" "number of objects to skip" } + { "mdb-query-msg" "annotated query message" } } -{ $description "" } ; +{ $description "annotates a query message with a number of objects to skip when returning the results" } ; HELP: sort { $values - { "mdb-query" null } - { "quot" quotation } - { "mdb-query" null } + { "mdb-query-msg" "a query message" } + { "sort-quot" "a quotation with sort specifiers" } + { "mdb-query-msg" "annotated query message" } } -{ $description "" } ; +{ $description "annotates the query message for sort specifiers" } ; HELP: update { $values - { "mdb-update-msg" null } + { "mdb-update-msg" "a mdb-update message" } } -{ $description "" } ; +{ $description "performs an update" } ; HELP: update-unsafe { $values - { "mdb-update-msg" null } + { "mdb-update-msg" "a mdb-update message" } } -{ $description "" } ; +{ $description "performs an update without automatic error check" } ; HELP: validate. { $values - { "collection" null } + { "collection" "collection to validate" } } -{ $description "" } ; +{ $description "validates the collection" } ; HELP: with-db { $values - { "mdb" null } - { "quot" quotation } + { "mdb" "mdb instance" } + { "quot" "quotation to execute with the given mdb instance as context" } } -{ $description "" } ; +{ $description "executes a quotation with the given mdb instance in its context" } ; -ARTICLE: "mongodb.driver" "mongodb.driver" +ARTICLE: "mongodb.driver" "MongoDB factor driver" { $vocab-link "mongodb.driver" } ; diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index 355838b82d..a972d1c380 100644 --- a/extra/mongodb/driver/driver.factor +++ b/extra/mongodb/driver/driver.factor @@ -162,7 +162,7 @@ PRIVATE> : ( collection assoc -- mdb-query-msg ) ; inline -GENERIC# limit 1 ( mdb-query-msg limit# -- mdb-query ) +GENERIC# limit 1 ( mdb-query-msg limit# -- mdb-query-msg ) M: mdb-query-msg limit >>return# ; inline @@ -188,7 +188,7 @@ GENERIC# hint 1 ( mdb-query-msg index-hint -- mdb-query-msg ) M: mdb-query-msg hint >>hint ; -GENERIC: find ( mdb-query-msg/mdb-cursor -- mdb-cursor seq ) +GENERIC: find ( selector -- mdb-cursor/f seq ) M: mdb-query-msg find fix-query-collection send-query ; @@ -243,7 +243,7 @@ M: assoc save [ check-collection ] dip send-message-check-error ; -GENERIC: save-unsafe ( collection object -- ) +GENERIC: save-unsafe ( collection assoc -- ) M: assoc save-unsafe [ check-collection ] dip send-message ; @@ -266,7 +266,7 @@ M: index-spec ensure-index [ cmd-collection ] dip find-one drop ; -: ( collection selector object -- update-msg ) +: ( collection selector object -- mdb-update-msg ) [ check-collection ] 2dip ; : >upsert ( mdb-update-msg -- mdb-update-msg )