32 lines
959 B
Factor
32 lines
959 B
Factor
|
USING: kernel generic syntax words parser assocs sequences ;
|
||
|
|
IN: visitor
|
||
|
|
|
||
|
|
: define-visitor ( word -- )
|
||
|
|
dup dup reset-word define-simple-generic
|
||
|
|
H{ } clone "visitors" set-word-prop ;
|
||
|
|
|
||
|
|
: VISITOR:
|
||
|
|
CREATE define-visitor ; parsing
|
||
|
|
|
||
|
|
: connect-method ( top-class generic method-word -- )
|
||
|
|
[ swap ] swap add -rot define-method ;
|
||
|
|
|
||
|
|
: record-visitor ( top-class generic method-word -- )
|
||
|
|
swap "visitors" word-prop swapd set-at ;
|
||
|
|
|
||
|
|
: new-vmethod ( method bottom-class top-class generic -- )
|
||
|
|
gensym dup define-simple-generic
|
||
|
|
3dup connect-method
|
||
|
|
[ record-visitor ] keep
|
||
|
|
define-method ;
|
||
|
|
|
||
|
|
: define-visitor-method ( method bottom-class top-class generic -- )
|
||
|
|
>r >r >r \ swap add* r> r> r>
|
||
|
|
2dup "visitors" word-prop at
|
||
|
|
[ nip define-method ] [ new-vmethod ] ?if ;
|
||
|
|
|
||
|
|
: V:
|
||
|
|
! syntax: V: bottom-class top-class generic body... ;
|
||
|
|
f set-word scan-word scan-word scan-word
|
||
|
|
parse-definition -roll define-visitor-method ; parsing
|