73 lines
2.0 KiB
Factor
73 lines
2.0 KiB
Factor
! Copyright (C) 2005, 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors arrays kernel kernel.private math namespaces
|
|
make 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 )
|
|
[ "-" glue ] dip create ;
|
|
|
|
: writer-word ( class name vocab -- word )
|
|
[ [ swap "set-" % % "-" % % ] "" make ] dip 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 ( word quot spec -- )
|
|
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 ;
|