compiler doesn't like new and boa being overridden so much

db4
Joe Groff 2009-08-14 07:09:37 -04:00
parent 4a1b2d0d77
commit 4991171ca6
3 changed files with 15 additions and 16 deletions

View File

@ -7,16 +7,16 @@ HELP: <struct-boa>
{ $values { $values
{ "class" class } { "class" class }
} }
{ $description "This macro implements " { $link boa } " for " { $link struct } " classes. User code does not need to call this word directly and should use " { $snippet "boa" } " instead." } ; { $description "This macro implements " { $link boa } " for " { $link struct } " classes. A struct of the given class is constructed, and its slots are initialized using values off the top of the datastack." } ;
HELP: <struct> HELP: <struct>
{ $values { $values
{ "class" class } { "class" class }
{ "struct" struct } { "struct" struct }
} }
{ $description "Allocates garbage-collected heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are left uninitialized; to allocate a struct with the slots initialized, call " { $link new } " or " { $link boa } " instead." } ; { $description "Allocates garbage-collected heap memory for a new " { $link struct } " of the specified " { $snippet "class" } ". The new struct's slots are initialized with the initial values specified in the struct definition." } ;
{ <struct> malloc-struct memory>struct } related-words { <struct> <struct-boa> malloc-struct memory>struct } related-words
HELP: STRUCT: HELP: STRUCT:
{ $syntax "STRUCT: class { slot type } { slot type } ... ;" } { $syntax "STRUCT: class { slot type } { slot type } ... ;" }
@ -75,7 +75,9 @@ HELP: struct-class
ARTICLE: "classes.struct" "Struct classes" ARTICLE: "classes.struct" "Struct classes"
{ $link struct } " classes are similar to " { $link tuple } "s, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for structured access to C memory or Factor byte arrays and for passing struct values in and out of the FFI. Struct types are defined using a syntax similar to tuple syntax:" { $link struct } " classes are similar to " { $link tuple } "s, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for structured access to C memory or Factor byte arrays and for passing struct values in and out of the FFI. Struct types are defined using a syntax similar to tuple syntax:"
{ $subsection POSTPONE: STRUCT: } { $subsection POSTPONE: STRUCT: }
"Structs can be allocated with " { $link new } " and " { $link boa } " like tuples. Additional words are provided for building structs from C memory and from existing buffers:" "Structs can be allocated with " { $link new } "- and " { $link boa } "-like constructor words. Additional words are provided for building structs from C memory and from existing buffers:"
{ $subsection <struct> }
{ $subsection <struct-boa> }
{ $subsection malloc-struct } { $subsection malloc-struct }
{ $subsection memory>struct } { $subsection memory>struct }
"Structs have literal syntax like tuples:" "Structs have literal syntax like tuples:"

View File

@ -14,11 +14,11 @@ STRUCT: bar
[ 12 ] [ foo heap-size ] unit-test [ 12 ] [ foo heap-size ] unit-test
[ 16 ] [ bar heap-size ] unit-test [ 16 ] [ bar heap-size ] unit-test
[ 123 ] [ foo new y>> ] unit-test [ 123 ] [ foo <struct> y>> ] unit-test
[ 123 ] [ bar new foo>> y>> ] unit-test [ 123 ] [ bar <struct> foo>> y>> ] unit-test
[ 1 2 3 t ] [ [ 1 2 3 t ] [
1 2 3 t foo boa bar boa 1 2 3 t foo <struct-boa> bar <struct-boa>
{ {
[ w>> ] [ w>> ]
[ foo>> x>> ] [ foo>> x>> ]
@ -30,7 +30,7 @@ STRUCT: bar
[ 7654 ] [ S{ foo f 98 7654 f } y>> ] unit-test [ 7654 ] [ S{ foo f 98 7654 f } y>> ] unit-test
[ 7654 ] [ S{ foo { y 7654 } } y>> ] unit-test [ 7654 ] [ S{ foo { y 7654 } } y>> ] unit-test
[ 98 7654 t ] [ S{ foo f 98 7654 t } [ foo boa ] undo ] unit-test [ 98 7654 t ] [ S{ foo f 98 7654 t } [ foo <struct-boa> ] undo ] unit-test
UNION-STRUCT: float-and-bits UNION-STRUCT: float-and-bits
{ f single-float } { f single-float }

View File

@ -27,16 +27,16 @@ M: struct >c-ptr
: malloc-struct ( class -- struct ) : malloc-struct ( class -- struct )
[ heap-size malloc ] keep memory>struct ; inline [ heap-size malloc ] keep memory>struct ; inline
: <struct> ( class -- struct ) : (struct) ( class -- struct )
[ heap-size <byte-array> ] keep memory>struct ; inline [ heap-size <byte-array> ] keep memory>struct ; inline
M: struct-class new : <struct> ( class -- struct )
dup "prototype" word-prop dup "prototype" word-prop
[ >c-ptr clone swap memory>struct ] [ <struct> ] if* ; inline [ >c-ptr clone swap memory>struct ] [ (struct) ] if* ; inline
MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) ) MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
[ [
[ \ <struct> [ ] 2sequence ] [ <wrapper> \ (struct) [ ] 2sequence ]
[ [
"struct-slots" word-prop "struct-slots" word-prop
[ length \ ndip ] [ length \ ndip ]
@ -44,15 +44,12 @@ MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
] bi ] bi
] [ ] output>sequence ; ] [ ] output>sequence ;
M: struct-class boa
<struct-boa> ; inline
: pad-struct-slots ( slots class -- slots' class ) : pad-struct-slots ( slots class -- slots' class )
[ class-slots [ initial>> ] map over length tail append ] keep ; [ class-slots [ initial>> ] map over length tail append ] keep ;
M: struct-class boa>object M: struct-class boa>object
swap pad-struct-slots swap pad-struct-slots
[ <struct> swap ] [ "struct-slots" word-prop ] bi [ (struct) swap ] [ "struct-slots" word-prop ] bi
[ name>> setter-word execute( struct value -- struct ) ] 2each ; [ name>> setter-word execute( struct value -- struct ) ] 2each ;
! Struct slot accessors ! Struct slot accessors