classes.tuple: moving get-slot-named and set-slot-named from db.types.

db4
John Benediktsson 2012-07-24 11:55:16 -07:00
parent 66624ce7da
commit 30a198e2ab
6 changed files with 29 additions and 29 deletions

View File

@ -4,9 +4,9 @@ USING: arrays assocs alien alien.syntax continuations io
kernel math math.parser namespaces make prettyprint quotations kernel math math.parser namespaces make prettyprint quotations
sequences debugger db db.postgresql.lib db.postgresql.ffi sequences debugger db db.postgresql.lib db.postgresql.ffi
db.tuples db.types tools.annotations math.ranges db.tuples db.types tools.annotations math.ranges
combinators classes locals words tools.walker db.private combinators classes classes.tuple locals words tools.walker
nmake accessors random db.queries destructors db.tuples.private db.private nmake accessors random db.queries destructors
db.postgresql db.errors.postgresql splitting ; db.tuples.private db.postgresql db.errors.postgresql splitting ;
IN: db.postgresql IN: db.postgresql
TUPLE: postgresql-db host port pgopts pgtty database username password ; TUPLE: postgresql-db host port pgopts pgtty database username password ;

View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays byte-arrays classes combinators USING: accessors arrays byte-arrays classes classes.tuple
continuations db db.errors db.private db.tuples combinators continuations db db.errors db.private db.tuples
db.tuples.private db.types destructors kernel make math db.tuples.private db.types destructors kernel make math
math.bitwise math.intervals math.parser namespaces nmake math.bitwise math.intervals math.parser namespaces nmake
prettyprint random sequences shuffle strings words fry ; prettyprint random sequences shuffle strings words fry ;

View File

@ -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." } { $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." } ; { $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 HELP: no-sql-type
{ $values { $values
{ "type" "a SQL type" } } { "type" "a SQL type" } }
@ -132,12 +126,6 @@ HELP: normalize-spec
{ "spec" "a SQL spec" } } { "spec" "a SQL spec" } }
{ $description "Normalizes 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? HELP: primary-key?
{ $values { $values
{ "spec" "a SQL spec" } { "spec" "a SQL spec" }

View File

@ -35,17 +35,6 @@ SYMBOL: IGNORE
[ <mirror> [ nip IGNORE = ] assoc-filter keys ] dip [ <mirror> [ nip IGNORE = ] assoc-filter keys ] dip
[ slot-name>> swap member? not ] with filter ; [ 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 ; ERROR: not-persistent class ;
: db-table-name ( class -- object ) : db-table-name ( class -- object )

View File

@ -1,7 +1,7 @@
USING: generic help.markup help.syntax kernel USING: generic help.markup help.syntax kernel
classes.tuple.private classes slots quotations words arrays classes.tuple.private classes slots quotations words arrays
generic.standard sequences definitions compiler.units generic.standard sequences definitions compiler.units
growable vectors sbufs assocs math ; growable vectors sbufs assocs math strings ;
IN: classes.tuple IN: classes.tuple
ARTICLE: "slot-read-only-declaration" "Read-only slots" ARTICLE: "slot-read-only-declaration" "Read-only slots"
@ -448,3 +448,15 @@ HELP: boa
HELP: bad-superclass 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 } "." } ; { $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" } "." } ;

View File

@ -16,6 +16,17 @@ ERROR: not-a-tuple object ;
: all-slots ( class -- slots ) : all-slots ( class -- slots )
superclasses [ "slots" word-prop ] map concat ; 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 PREDICATE: immutable-tuple-class < tuple-class
all-slots [ read-only>> ] all? ; all-slots [ read-only>> ] all? ;