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

Add copy-slots{ word to slots.syntax. Alias slots{ to get{ and set-slots{ to set{, same for slots[ and set-slots[.

db4
Doug Coleman 2011-10-10 18:24:35 -07:00
parent e200656ce4
commit 4cece22c43
3 changed files with 45 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/slots/syntax/syntax-docs.factor
View File

@ -40,15 +40,25 @@ HELP: set-slots[
"T{ rectangle { width 3 } { height 5 } }"
} ;
HELP: copy-slots{
{ $description "Copy slots from the first object to the second and return the second object." }
{ $example "USING: prettyprint slots.syntax kernel ;"
"IN: slots.syntax.example"
"TUPLE: thing1 a b ;"
"TUPLE: thing2 a b c ;"
"1 2 thing1 boa 11 22 33 thing2 boa copy-slots{ a b } ."
"T{ thing2 f 1 2 33 }"
} ;
ARTICLE: "slots.syntax" "Slots syntax sugar"
"The " { $vocab-link "slots.syntax" } " vocabulary provides an alternative syntax for getting and setting multiple values of a tuple." $nl
"Syntax sugar for cleaving slots to the stack:"
{ $subsections POSTPONE: slots[ }
{ $subsections POSTPONE: slots[ POSTPONE: get[ }
"Cleaving slots to an array:"
{ $subsections POSTPONE: slots{ }
{ $subsections POSTPONE: slots{ POSTPONE: get{ }
"Setting slots from the stack:"
{ $subsections POSTPONE: set-slots[ }
{ $subsections POSTPONE: set-slots[ POSTPONE: set[ }
"Setting slots from an array:"
{ $subsections POSTPONE: set-slots{ } ;
{ $subsections POSTPONE: set-slots{ POSTPONE: set{ } ;
ABOUT: "slots.syntax"

21
extra/slots/syntax/syntax-tests.factor
View File

@ -1,14 +1,19 @@
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test slots.syntax ;
USING: kernel tools.test slots.syntax ;
IN: slots.syntax.tests
TUPLE: slot-test a b c ;
TUPLE: slot-test1 a b c ;
[ 1 2 3 ] [ T{ slot-test f 1 2 3 } slots[ a b c ] ] unit-test
[ 3 ] [ T{ slot-test f 1 2 3 } slots[ c ] ] unit-test
[ ] [ T{ slot-test f 1 2 3 } slots[ ] ] unit-test
[ 1 2 3 ] [ T{ slot-test1 f 1 2 3 } slots[ a b c ] ] unit-test
[ 3 ] [ T{ slot-test1 f 1 2 3 } slots[ c ] ] unit-test
[ ] [ T{ slot-test1 f 1 2 3 } slots[ ] ] unit-test
[ { 1 2 3 } ] [ T{ slot-test f 1 2 3 } slots{ a b c } ] unit-test
[ { 3 } ] [ T{ slot-test f 1 2 3 } slots{ c } ] unit-test
[ { } ] [ T{ slot-test f 1 2 3 } slots{ } ] unit-test
[ { 1 2 3 } ] [ T{ slot-test1 f 1 2 3 } slots{ a b c } ] unit-test
[ { 3 } ] [ T{ slot-test1 f 1 2 3 } slots{ c } ] unit-test
[ { } ] [ T{ slot-test1 f 1 2 3 } slots{ } ] unit-test
TUPLE: slot-test2 a b c d ;
[ T{ slot-test2 f 1 2 33 44 } ]
[ 1 2 3 slot-test1 boa 11 22 33 44 slot-test2 boa copy-slots{ a b } ] unit-test

21
extra/slots/syntax/syntax.factor
View File

@ -12,14 +12,29 @@ SYNTAX: slots{
"}" [ reader-word 1quotation ] map-tokens
'[ [ _ cleave ] output>array ] append! ;
: writer-word* ( name -- word )
: >>writer-word ( name -- word )
">>" prepend "accessors" lookup ;
: writer-word<< ( name -- word )
">>" prepend "accessors" lookup ;
SYNTAX: set-slots[
"]" [ writer-word* 1quotation ] map-tokens
"]" [ >>writer-word 1quotation ] map-tokens
'[ _ spread ] append! ;
SYNTAX: set-slots{
"}" [ writer-word* 1quotation ] map-tokens
"}" [ >>writer-word 1quotation ] map-tokens
[ length ] [ ] bi
'[ _ firstn _ spread ] append! ;
SYNTAX: copy-slots{
"}" [
[ reader-word 1quotation ]
[ writer-word<< 1quotation ] bi append
] map-tokens
'[ swap _ cleave ] append! ;
SYNTAX: get[ POSTPONE: slots[ ;
SYNTAX: get{ POSTPONE: slots{ ;
SYNTAX: set[ POSTPONE: set-slots[ ;
SYNTAX: set{ POSTPONE: set-slots{ ;