steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

update bitfields

db4
Doug Coleman 2008-01-10 10:47:57 -10:00
parent 39dfcee005
commit 4c9815d054
2 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
extra/bitfields/bitfields-docs.factor
View File

@ -1,4 +1,5 @@
USING: help.markup help.syntax bitfields ; USING: help.markup help.syntax ;
IN: bitfields
HELP: BITFIELD: HELP: BITFIELD:
{ $syntax "BITFIELD: name slot:size... ;" } { $syntax "BITFIELD: name slot:size... ;" }

12
extra/bitfields/bitfields.factor
View File

@ -1,6 +1,6 @@
USING: parser kernel math sequences namespaces assocs inspector USING: parser kernel math sequences namespaces assocs inspector
words splitting math.parser arrays sequences.next mirrors words splitting math.parser arrays sequences.next mirrors
shuffle ; shuffle compiler.units ;
IN: bitfields IN: bitfields
! Example: ! Example:
@ -51,7 +51,7 @@ M: check< summary drop "Number exceeds upper bound" ;
: define-constructor ( classname slots -- ) : define-constructor ( classname slots -- )
[ keys ] keep values [constructor] [ keys ] keep values [constructor]
>r in get constructor-word dup save-location r> >r in get constructor-word dup save-location r>
define-compound ; define ;
: range>accessor ( range -- quot ) : range>accessor ( range -- quot )
[ [
@ -81,7 +81,7 @@ M: check< summary drop "Number exceeds upper bound" ;
: define-slots ( prefix names quots -- ) : define-slots ( prefix names quots -- )
>r [ "-" swap 3append create-in ] with map r> >r [ "-" swap 3append create-in ] with map r>
[ define-compound ] 2each ; [ define ] 2each ;
: define-accessors ( classname slots -- ) : define-accessors ( classname slots -- )
dup values [accessors] dup values [accessors]
@ -96,8 +96,10 @@ M: check< summary drop "Number exceeds upper bound" ;
[ drop padding-name? not ] assoc-subset ; [ drop padding-name? not ] assoc-subset ;
: define-bitfield ( classname slots -- ) : define-bitfield ( classname slots -- )
[ define-constructor ] 2keep [
>ranges filter-pad [ define-setters ] 2keep define-accessors ; [ define-constructor ] 2keep
>ranges filter-pad [ define-setters ] 2keep define-accessors
] with-compilation-unit ;
: parse-bitfield : parse-bitfield
scan ";" parse-tokens parse-slots define-bitfield ; scan ";" parse-tokens parse-slots define-bitfield ;