Remove slots.deprecated, remove unused slots from slot-spec tuple; last vestiges of old accessors are now gone forever
Slava Pestov
parent
6d506b89e8
commit
fdf75fe110
|
|
@ -0,0 +1,76 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays kernel kernel.private math namespaces
|
||||
sequences strings words effects combinators alien.c-types ;
|
||||
IN: alien.structs.fields
|
||||
|
||||
TUPLE: field-spec name offset type reader writer ;
|
||||
|
||||
: reader-effect ( type spec -- effect )
|
||||
[ 1array ] [ name>> 1array ] bi* <effect> ;
|
||||
|
||||
PREDICATE: slot-reader < word "reading" word-prop >boolean ;
|
||||
|
||||
: set-reader-props ( class spec -- )
|
||||
2dup reader-effect
|
||||
over reader>>
|
||||
swap "declared-effect" set-word-prop
|
||||
reader>> swap "reading" set-word-prop ;
|
||||
|
||||
: writer-effect ( type spec -- effect )
|
||||
name>> swap 2array 0 <effect> ;
|
||||
|
||||
PREDICATE: slot-writer < word "writing" word-prop >boolean ;
|
||||
|
||||
: set-writer-props ( class spec -- )
|
||||
2dup writer-effect
|
||||
over writer>>
|
||||
swap "declared-effect" set-word-prop
|
||||
writer>> swap "writing" set-word-prop ;
|
||||
|
||||
: reader-word ( class name vocab -- word )
|
||||
>r >r "-" r> 3append r> create ;
|
||||
|
||||
: writer-word ( class name vocab -- word )
|
||||
>r [ swap "set-" % % "-" % % ] "" make r> create ;
|
||||
|
||||
: <field-spec> ( struct-name vocab type field-name -- spec )
|
||||
field-spec new
|
||||
0 >>offset
|
||||
swap >>name
|
||||
swap expand-constants >>type
|
||||
3dup name>> swap reader-word >>reader
|
||||
3dup name>> swap writer-word >>writer
|
||||
2nip ;
|
||||
|
||||
: align-offset ( offset type -- offset )
|
||||
c-type-align align ;
|
||||
|
||||
: struct-offsets ( specs -- size )
|
||||
0 [
|
||||
[ type>> align-offset ] keep
|
||||
[ (>>offset) ] [ type>> heap-size + ] 2bi
|
||||
] reduce ;
|
||||
|
||||
: define-struct-slot-word ( spec word quot -- )
|
||||
rot offset>> prefix define-inline ;
|
||||
|
||||
: define-getter ( type spec -- )
|
||||
[ set-reader-props ] keep
|
||||
[ ]
|
||||
[ reader>> ]
|
||||
[
|
||||
type>>
|
||||
[ c-getter ] [ c-type-boxer-quot ] bi append
|
||||
] tri
|
||||
define-struct-slot-word ;
|
||||
|
||||
: define-setter ( type spec -- )
|
||||
[ set-writer-props ] keep
|
||||
[ ]
|
||||
[ writer>> ]
|
||||
[ type>> c-setter ] tri
|
||||
define-struct-slot-word ;
|
||||
|
||||
: define-field ( type spec -- )
|
||||
[ define-getter ] [ define-setter ] 2bi ;
|
||||
|
|
@ -1,75 +1,7 @@
|
|||
IN: alien.structs
|
||||
USING: accessors alien.c-types strings help.markup help.syntax
|
||||
alien.syntax sequences io arrays slots.deprecated
|
||||
kernel words slots assocs namespaces accessors ;
|
||||
|
||||
! Deprecated code
|
||||
: ($spec-reader-values) ( slot-spec class -- element )
|
||||
dup ?word-name swap 2array
|
||||
over name>>
|
||||
rot class>> 2array 2array
|
||||
[ { $instance } swap suffix ] assoc-map ;
|
||||
|
||||
: $spec-reader-values ( slot-spec class -- )
|
||||
($spec-reader-values) $values ;
|
||||
|
||||
: $spec-reader-description ( slot-spec class -- )
|
||||
[
|
||||
"Outputs the value stored in the " ,
|
||||
{ $snippet } rot name>> suffix ,
|
||||
" slot of " ,
|
||||
{ $instance } swap suffix ,
|
||||
" instance." ,
|
||||
] { } make $description ;
|
||||
|
||||
: slot-of-reader ( reader specs -- spec/f )
|
||||
[ reader>> eq? ] with find nip ;
|
||||
|
||||
: $spec-reader ( reader slot-specs class -- )
|
||||
>r slot-of-reader r>
|
||||
over [
|
||||
2dup $spec-reader-values
|
||||
2dup $spec-reader-description
|
||||
] when 2drop ;
|
||||
|
||||
GENERIC: slot-specs ( help-type -- specs )
|
||||
|
||||
M: word slot-specs "slots" word-prop ;
|
||||
|
||||
: $slot-reader ( reader -- )
|
||||
first dup "reading" word-prop [ slot-specs ] keep
|
||||
$spec-reader ;
|
||||
|
||||
: $spec-writer-values ( slot-spec class -- )
|
||||
($spec-reader-values) reverse $values ;
|
||||
|
||||
: $spec-writer-description ( slot-spec class -- )
|
||||
[
|
||||
"Stores a new value to the " ,
|
||||
{ $snippet } rot name>> suffix ,
|
||||
" slot of " ,
|
||||
{ $instance } swap suffix ,
|
||||
" instance." ,
|
||||
] { } make $description ;
|
||||
|
||||
: slot-of-writer ( writer specs -- spec/f )
|
||||
[ writer>> eq? ] with find nip ;
|
||||
|
||||
: $spec-writer ( writer slot-specs class -- )
|
||||
>r slot-of-writer r>
|
||||
over [
|
||||
2dup $spec-writer-values
|
||||
2dup $spec-writer-description
|
||||
dup ?word-name 1array $side-effects
|
||||
] when 2drop ;
|
||||
|
||||
: $slot-writer ( reader -- )
|
||||
first dup "writing" word-prop [ slot-specs ] keep
|
||||
$spec-writer ;
|
||||
|
||||
M: string slot-specs c-type fields>> ;
|
||||
|
||||
M: array ($instance) first ($instance) " array" write ;
|
||||
alien.syntax sequences io arrays kernel words assocs namespaces
|
||||
accessors ;
|
||||
IN: alien.structs
|
||||
|
||||
ARTICLE: "c-structs" "C structure types"
|
||||
"A " { $snippet "struct" } " in C is essentially a block of memory with the value of each structure field stored at a fixed offset from the start of the block. The C library interface provides some utilities to define words which read and write structure fields given a base address."
|
||||
|
|
|
|||
|
|
@ -1,43 +1,10 @@
|
|||
! Copyright (C) 2004, 2007 Slava Pestov.
|
||||
! Copyright (C) 2004, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays generic hashtables kernel kernel.private
|
||||
math namespaces parser sequences strings words libc slots
|
||||
slots.deprecated alien.c-types cpu.architecture ;
|
||||
math namespaces parser sequences strings words libc
|
||||
alien.c-types alien.structs.fields cpu.architecture ;
|
||||
IN: alien.structs
|
||||
|
||||
: align-offset ( offset type -- offset )
|
||||
c-type-align align ;
|
||||
|
||||
: struct-offsets ( specs -- size )
|
||||
0 [
|
||||
[ class>> align-offset ] keep
|
||||
[ (>>offset) ] 2keep
|
||||
class>> heap-size +
|
||||
] reduce ;
|
||||
|
||||
: define-struct-slot-word ( spec word quot -- )
|
||||
rot offset>> prefix define-inline ;
|
||||
|
||||
: define-getter ( type spec -- )
|
||||
[ set-reader-props ] keep
|
||||
[ ]
|
||||
[ reader>> ]
|
||||
[
|
||||
class>>
|
||||
[ c-getter ] [ c-type-boxer-quot ] bi append
|
||||
] tri
|
||||
define-struct-slot-word ;
|
||||
|
||||
: define-setter ( type spec -- )
|
||||
[ set-writer-props ] keep
|
||||
[ ]
|
||||
[ writer>> ]
|
||||
[ class>> c-setter ] tri
|
||||
define-struct-slot-word ;
|
||||
|
||||
: define-field ( type spec -- )
|
||||
2dup define-getter define-setter ;
|
||||
|
||||
: if-value-structs? ( ctype true false -- )
|
||||
value-structs?
|
||||
[ drop call ] [ >r 2drop "void*" r> call ] if ; inline
|
||||
|
|
@ -76,17 +43,8 @@ M: struct-type stack-size
|
|||
struct-type boa
|
||||
-rot define-c-type ;
|
||||
|
||||
: make-field ( struct-name vocab type field-name -- spec )
|
||||
<slot-spec>
|
||||
0 >>offset
|
||||
swap >>name
|
||||
swap expand-constants >>class
|
||||
3dup name>> swap reader-word >>reader
|
||||
3dup name>> swap writer-word >>writer
|
||||
2nip ;
|
||||
|
||||
: define-struct-early ( name vocab fields -- fields )
|
||||
-rot [ rot first2 make-field ] 2curry map ;
|
||||
-rot [ rot first2 <field-spec> ] 2curry map ;
|
||||
|
||||
: compute-struct-align ( types -- n )
|
||||
[ c-type-align ] map supremum ;
|
||||
|
|
@ -94,7 +52,7 @@ M: struct-type stack-size
|
|||
: define-struct ( name vocab fields -- )
|
||||
pick >r
|
||||
[ struct-offsets ] keep
|
||||
[ [ class>> ] map compute-struct-align ] keep
|
||||
[ [ type>> ] map compute-struct-align ] keep
|
||||
[ (define-struct) ] keep
|
||||
r> [ swap define-field ] curry each ;
|
||||
|
||||
|
|
|
|||
|
|
@ -178,7 +178,7 @@ stack-params "__stack_value" c-type (>>reg-class) >>
|
|||
|
||||
: struct-types&offset ( struct-type -- pairs )
|
||||
fields>> [
|
||||
[ class>> ] [ offset>> ] bi 2array
|
||||
[ type>> ] [ offset>> ] bi 2array
|
||||
] map ;
|
||||
|
||||
: split-struct ( pairs -- seq )
|
||||
|
|
|
|||
|
|
@ -1,81 +0,0 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays kernel kernel.private math namespaces
|
||||
sequences strings words effects generic generic.standard
|
||||
classes slots.private combinators slots ;
|
||||
IN: slots.deprecated
|
||||
|
||||
: reader-effect ( class spec -- effect )
|
||||
>r ?word-name 1array r> name>> 1array <effect> ;
|
||||
|
||||
PREDICATE: slot-reader < word "reading" word-prop >boolean ;
|
||||
|
||||
: set-reader-props ( class spec -- )
|
||||
2dup reader-effect
|
||||
over reader>>
|
||||
swap "declared-effect" set-word-prop
|
||||
reader>> swap "reading" set-word-prop ;
|
||||
|
||||
: define-slot-word ( class word quot -- )
|
||||
[
|
||||
dup define-simple-generic
|
||||
create-method
|
||||
] dip define ;
|
||||
|
||||
: define-reader ( class spec -- )
|
||||
dup reader>> [
|
||||
[ set-reader-props ] 2keep
|
||||
dup reader>>
|
||||
swap reader-quot
|
||||
define-slot-word
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
: writer-effect ( class spec -- effect )
|
||||
name>> swap ?word-name 2array 0 <effect> ;
|
||||
|
||||
PREDICATE: slot-writer < word "writing" word-prop >boolean ;
|
||||
|
||||
: set-writer-props ( class spec -- )
|
||||
2dup writer-effect
|
||||
over writer>>
|
||||
swap "declared-effect" set-word-prop
|
||||
writer>> swap "writing" set-word-prop ;
|
||||
|
||||
: define-writer ( class spec -- )
|
||||
dup writer>> [
|
||||
[ set-writer-props ] 2keep
|
||||
dup writer>>
|
||||
swap writer-quot
|
||||
define-slot-word
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
: define-slot ( class spec -- )
|
||||
2dup define-reader define-writer ;
|
||||
|
||||
: define-slots ( class specs -- )
|
||||
[ define-slot ] with each ;
|
||||
|
||||
: reader-word ( class name vocab -- word )
|
||||
>r >r "-" r> 3append r> create ;
|
||||
|
||||
: writer-word ( class name vocab -- word )
|
||||
>r [ swap "set-" % % "-" % % ] "" make r> create ;
|
||||
|
||||
: (simple-slot-word) ( class name -- class name vocab )
|
||||
over vocabulary>> >r >r name>> r> r> ;
|
||||
|
||||
: simple-reader-word ( class name -- word )
|
||||
(simple-slot-word) reader-word ;
|
||||
|
||||
: simple-writer-word ( class name -- word )
|
||||
(simple-slot-word) writer-word ;
|
||||
|
||||
: deprecated-slots ( class slot-specs -- slot-specs' )
|
||||
[
|
||||
2dup name>> simple-reader-word >>reader
|
||||
2dup name>> simple-writer-word >>writer
|
||||
] map nip ;
|
||||
|
|
@ -6,7 +6,7 @@ classes.algebra slots.private combinators accessors words
|
|||
sequences.private assocs alien ;
|
||||
IN: slots
|
||||
|
||||
TUPLE: slot-spec name offset class initial read-only reader writer ;
|
||||
TUPLE: slot-spec name offset class initial read-only ;
|
||||
|
||||
PREDICATE: reader < word "reader" word-prop ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue