refactor struct slot parsing so that there's a <struct-slot-spec> word for easily constructing struct slots outside classes.struct
parent
4a243d2c04
commit
509ed99c79
|
@ -6,7 +6,7 @@ kernel libc literals math multiline namespaces prettyprint
|
||||||
prettyprint.config see sequences specialized-arrays.ushort
|
prettyprint.config see sequences specialized-arrays.ushort
|
||||||
system tools.test compiler.tree.debugger struct-arrays
|
system tools.test compiler.tree.debugger struct-arrays
|
||||||
classes.tuple.private specialized-arrays.direct.int
|
classes.tuple.private specialized-arrays.direct.int
|
||||||
compiler.units byte-arrays specialized-arrays.char ;
|
compiler.units specialized-arrays.char ;
|
||||||
IN: classes.struct.tests
|
IN: classes.struct.tests
|
||||||
|
|
||||||
<<
|
<<
|
||||||
|
|
|
@ -254,19 +254,22 @@ PRIVATE>
|
||||||
|
|
||||||
ERROR: invalid-struct-slot token ;
|
ERROR: invalid-struct-slot token ;
|
||||||
|
|
||||||
<PRIVATE
|
|
||||||
: struct-slot-class ( c-type -- class' )
|
: struct-slot-class ( c-type -- class' )
|
||||||
c-type c-type-boxed-class
|
c-type c-type-boxed-class
|
||||||
dup \ byte-array = [ drop \ c-ptr ] when ;
|
dup \ byte-array = [ drop \ c-ptr ] when ;
|
||||||
|
|
||||||
|
: <struct-slot-spec> ( name c-type attributes -- slot-spec )
|
||||||
|
[ struct-slot-spec new ] 3dip
|
||||||
|
[ >>name ]
|
||||||
|
[ [ >>c-type ] [ struct-slot-class >>class ] bi ]
|
||||||
|
[ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
: scan-c-type ( -- c-type )
|
: scan-c-type ( -- c-type )
|
||||||
scan dup "{" = [ drop \ } parse-until >array ] when ;
|
scan dup "{" = [ drop \ } parse-until >array ] when ;
|
||||||
|
|
||||||
: parse-struct-slot ( -- slot )
|
: parse-struct-slot ( -- slot )
|
||||||
struct-slot-spec new
|
scan scan-c-type \ } parse-until <struct-slot-spec> ;
|
||||||
scan >>name
|
|
||||||
scan-c-type [ >>c-type ] [ struct-slot-class >>class ] bi
|
|
||||||
\ } parse-until [ dup empty? ] [ peel-off-attributes ] until drop ;
|
|
||||||
|
|
||||||
: parse-struct-slots ( slots -- slots' more? )
|
: parse-struct-slots ( slots -- slots' more? )
|
||||||
scan {
|
scan {
|
||||||
|
@ -296,17 +299,9 @@ SYNTAX: S@
|
||||||
: scan-c-type` ( -- c-type/param )
|
: scan-c-type` ( -- c-type/param )
|
||||||
scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
|
scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
|
||||||
|
|
||||||
:: parse-struct-slot` ( accum -- accum )
|
: parse-struct-slot` ( accum -- accum )
|
||||||
scan-string-param :> name
|
scan-string-param scan-c-type` \ } parse-until
|
||||||
scan-c-type` :> c-type
|
[ <struct-slot-spec> ] 3curry over push-all ;
|
||||||
\ } parse-until :> attributes
|
|
||||||
accum {
|
|
||||||
\ struct-slot-spec new
|
|
||||||
name >>name
|
|
||||||
c-type [ >>c-type ] [ struct-slot-class >>class ] bi
|
|
||||||
attributes [ dup empty? ] [ peel-off-attributes ] until drop
|
|
||||||
over push
|
|
||||||
} over push-all ;
|
|
||||||
|
|
||||||
: parse-struct-slots` ( accum -- accum more? )
|
: parse-struct-slots` ( accum -- accum more? )
|
||||||
scan {
|
scan {
|
||||||
|
|
Loading…
Reference in New Issue