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
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 ;

View File

@ -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 ;

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." }
{ $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" }

View File

@ -35,17 +35,6 @@ SYMBOL: IGNORE
[ <mirror> [ 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 )

View File

@ -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" } "." } ;

View File

@ -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? ;