! John Benediktsson, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license
USING: accessors alien alien.c-types alien.data alien.parser
-arrays byte-arrays classes classes.parser
+arrays byte-arrays classes classes.parser classes.private
classes.struct.bit-accessors classes.tuple classes.tuple.parser
-combinators combinators.smart cpu.architecture fry
-functors.backend generalizations generic.parser kernel
+combinators combinators.smart cpu.architecture definitions fry
+functors.backend generalizations generic generic.parser io kernel
kernel.private lexer libc locals macros math math.order parser
quotations sequences slots slots.private specialized-arrays
-stack-checker.dependencies summary vectors vocabs.parser words
-classes.private generic definitions ;
+stack-checker.dependencies summary vectors vocabs.loader
+vocabs.parser words ;
FROM: delegate.private => group-words slot-group-words ;
QUALIFIED: math
IN: classes.struct
M: struct equal?
over struct? [
- 2dup [ class-of ] bi@ = [
+ 2dup [ class-of ] same? [
2dup [ >c-ptr ] both?
[ [ >c-ptr ] [ binary-object ] bi* memory= ]
[ [ >c-ptr not ] both? ]
! optimized down to efficient code if it is.
'[ _ boa ] call( ptr -- struct ) ; inline
+: read-struct ( class -- struct )
+ [ heap-size read ] [ memory>struct ] bi ;
+
<PRIVATE
: (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
'[ dup struct-prototype _ _ ?if ] keep memory>struct ; inline
drop [ >c-ptr ] ;
MACRO: read-struct-slot ( slot -- )
- dup type>> depends-on-c-type
+ dup type>> add-depends-on-c-type
(reader-quot) ;
MACRO: write-struct-slot ( slot -- )
- dup type>> depends-on-c-type
+ dup type>> add-depends-on-c-type
(writer-quot) ;
PRIVATE>
[ <struct> ] [ struct-slots ] bi
[ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
-M: struct-class initial-value* <struct> ; inline
+M: struct-class initial-value* <struct> t ; inline
! Struct slot accessors
1 [ 0 >>offset type>> heap-size max ] reduce ;
: struct-alignment ( slots -- align )
- [ struct-bit-slot-spec? not ] filter
+ [ struct-bit-slot-spec? ] reject
1 [ dup offset>> c-type-align-at max ] reduce ;
PRIVATE>
-M: struct byte-length class-of "struct-size" word-prop ; foldable
+: struct-size ( class -- n ) "struct-size" word-prop ; inline
+
+M: struct byte-length class-of struct-size ; inline foldable
M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inline
! class definition
<PRIVATE
-ERROR: bad-type-for-bits type ;
-
:: set-bits ( slot-spec n -- slot-spec )
struct-bit-slot-spec new
n >>bits
- slot-spec type>> {
- { int [ t ] }
- { uint [ f ] }
- [ bad-type-for-bits ]
- } case >>signed?
+ slot-spec type>> c-type-signed >>signed?
slot-spec name>> >>name
slot-spec class>> >>class
slot-spec type>> >>type
: <struct-slot-spec> ( name c-type attributes -- slot-spec )
[ struct-slot-spec new ] 3dip
[ >>name ]
- [ [ >>type ] [ struct-slot-class >>class ] bi ]
+ [ [ >>type ] [ struct-slot-class init-slot-class ] bi ]
[ [ dup empty? ] [ peel-off-struct-attributes ] until drop ] tri* ;
<PRIVATE
[ parse-struct-slots` ] [ ] while
[ >array define-struct-class ] append! ;
-USING: vocabs vocabs.loader ;
-
{ "classes.struct" "prettyprint" } "classes.struct.prettyprint" require-when