diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index e5e8097d3f..a002175ea8 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -4,9 +4,9 @@ USING: arrays assocs alien alien.syntax continuations io kernel math math.parser namespaces make prettyprint quotations sequences debugger db db.postgresql.lib db.postgresql.ffi db.tuples db.types tools.annotations math.ranges -combinators classes locals words tools.walker db.private -nmake accessors random db.queries destructors db.tuples.private -db.postgresql db.errors.postgresql splitting ; +combinators classes classes.tuple locals words tools.walker +db.private nmake accessors random db.queries destructors +db.tuples.private db.postgresql db.errors.postgresql splitting ; IN: db.postgresql TUPLE: postgresql-db host port pgopts pgtty database username password ; diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 409a6e8ab9..522a62045e 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays byte-arrays classes combinators -continuations db db.errors db.private db.tuples +USING: accessors arrays byte-arrays classes classes.tuple +combinators continuations db db.errors db.private db.tuples db.tuples.private db.types destructors kernel make math math.bitwise math.intervals math.parser namespaces nmake prettyprint random sequences shuffle strings words fry ; diff --git a/basis/db/types/types-docs.factor b/basis/db/types/types-docs.factor index 8b62e7d4ae..2ac358982e 100644 --- a/basis/db/types/types-docs.factor +++ b/basis/db/types/types-docs.factor @@ -116,12 +116,6 @@ HELP: find-primary-key { $description "Returns the rows from the SQL specs array that are part of the primary key. Composite primary keys are supported, so this word must return a sequence." } { $notes "This is a low-level word." } ; -HELP: get-slot-named -{ $values - { "name" "a slot name" } { "tuple" tuple } - { "value" "the value stored in the slot" } } -{ $description "Returns the value stored in a tuple slot, where the tuple slot is a string." } ; - HELP: no-sql-type { $values { "type" "a SQL type" } } @@ -132,12 +126,6 @@ HELP: normalize-spec { "spec" "a SQL spec" } } { $description "Normalizes a SQL spec." } ; -HELP: offset-of-slot -{ $values - { "string" string } { "tuple" tuple } - { "n" integer } } -{ $description "Returns the offset of a tuple slot accessed by name." } ; - HELP: primary-key? { $values { "spec" "a SQL spec" } diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index d6ab241778..222ac2a9f5 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -35,17 +35,6 @@ SYMBOL: IGNORE [ [ nip IGNORE = ] assoc-filter keys ] dip [ slot-name>> swap member? not ] with filter ; -ERROR: no-slot ; - -: offset-of-slot ( string tuple -- n ) - class-of all-slots slot-named dup [ no-slot ] unless offset>> ; - -: get-slot-named ( name tuple -- value ) - [ nip ] [ offset-of-slot ] 2bi slot ; - -: set-slot-named ( value name obj -- ) - [ nip ] [ offset-of-slot ] 2bi set-slot ; - ERROR: not-persistent class ; : db-table-name ( class -- object ) diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor index 7fd0cb0850..55edb5f969 100644 --- a/core/classes/tuple/tuple-docs.factor +++ b/core/classes/tuple/tuple-docs.factor @@ -1,7 +1,7 @@ USING: generic help.markup help.syntax kernel classes.tuple.private classes slots quotations words arrays generic.standard sequences definitions compiler.units -growable vectors sbufs assocs math ; +growable vectors sbufs assocs math strings ; IN: classes.tuple ARTICLE: "slot-read-only-declaration" "Read-only slots" @@ -448,3 +448,15 @@ HELP: boa HELP: bad-superclass { $error-description "Thrown if an attempt is made to subclass a class that is not a tuple class, or a tuple class declared " { $link POSTPONE: final } "." } ; + +HELP: offset-of-slot +{ $values { "name" string } { "tuple" tuple } { "n" integer } } +{ $description "Returns the offset of a tuple slot accessed by " { $snippet "name" } "." } ; + +HELP: get-slot-named +{ $values { "name" string } { "tuple" tuple } { "value" object } } +{ $description "Returns the " { $snippet "value" } " stored in a tuple slot accessed by " { $snippet "name" } "." } ; + +HELP: set-slot-named +{ $values { "value" object } { "name" string } { "tuple" tuple } } +{ $description "Stores the " { $snippet "value" } " into a tuple slot accessed by " { $snippet "name" } "." } ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index dd7c63dea4..c92a1fe6cb 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -16,6 +16,17 @@ ERROR: not-a-tuple object ; : all-slots ( class -- slots ) superclasses [ "slots" word-prop ] map concat ; +ERROR: no-slot ; + +: offset-of-slot ( name tuple -- n ) + class-of all-slots slot-named dup [ no-slot ] unless offset>> ; + +: get-slot-named ( name tuple -- value ) + [ nip ] [ offset-of-slot ] 2bi slot ; + +: set-slot-named ( value name tuple -- ) + [ nip ] [ offset-of-slot ] 2bi set-slot ; + PREDICATE: immutable-tuple-class < tuple-class all-slots [ read-only>> ] all? ;