Hello,
with-slots example:
----------------------------------------------------------------------
TUPLE: <abc> a b c ;
T{ <abc> 10 20 30 } dup
[with-slots <abc>
A B C 3array
1 A!
2 B!
3 C! ]
----------------------------------------------------------------------
As you can see, the setter words change the original object.
Implementation available here:
http://paste.factorcode.org/paste?id=360
It's also included below.
Ed
----------------------------------------------------------------------
USING: accessors arrays assocs classes.tuple kernel locals
locals.parser locals.types namespaces parser quotations
sequences slots unicode.case vectors ;
IN: with-slots
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: make-reader-binding ( SLOT-NAME OBJECT-WORD -- binding )
SLOT-NAME >upper
OBJECT-WORD SLOT-NAME reader-word 2array >quotation
tuck make-local-word swap 2array ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: make-writer-binding ( SLOT-NAME OBJECT-WORD -- binding )
SLOT-NAME >upper "!" append
OBJECT-WORD SLOT-NAME writer-word 2array >quotation
tuck make-local-word swap 2array ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: bindings->vars ( bindings -- vars ) keys [ dup name>> swap 2array ] map ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
:: [with-slots ( ACCUM -- accum )
[let | CLASS [ scan-word ]
OBJECT [ "OBJECT" <local> ] |
[let | LET-BINDINGS [ { { OBJECT [ ] } } ]
LET-VARS [ { { "OBJECT" OBJECT } } ]
SLOTS [ CLASS all-slots [ name>> ] map ] |
[
in-lambda? on
LET-VARS locals set
LET-VARS push-locals
! process wlet
[let | READER-BINDINGS [ SLOTS [ OBJECT make-reader-binding ] map ]
WRITER-BINDINGS [ SLOTS [ OBJECT make-writer-binding ] map ] |
[let | WLET-BINDINGS [ READER-BINDINGS WRITER-BINDINGS append ] |
[let | WLET-VARS [ WLET-BINDINGS bindings->vars ] |
[let | WLET-BODY [ WLET-VARS \ ] (parse-lambda) ] |
[let | WLET [ WLET-BINDINGS WLET-BODY <wlet> ] |
100 <vector> WLET parsed-lambda >quotation ] ] ] ] ]
! end process wlet
LET-VARS pop-locals
]
with-scope
[let | LET-BINDINGS [ { { OBJECT [ ] } } ]
LET-BODY [ ] |
[let | LET [ LET-BINDINGS LET-BODY <let> ] |
ACCUM LET parsed-lambda ] ] ] ] ; parsing
------------------------------------------------------------------------------
This SF.net email is sponsored by:
SourcForge Community
SourceForge wants to tell your story.
http://p.sf.net/sfu/sf-spreadtheword
_______________________________________________
Factor-talk mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/factor-talk
