Add new SLOT-PROTOCOL: word; shorthand for PROTOCOL: comprised for slot readers and writers
parent
3697fa1aa3
commit
21f81ab57d
|
@ -1,9 +1,8 @@
|
|||
! Copyright (C) 2007, 2008 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors parser generic kernel classes classes.tuple
|
||||
words slots assocs sequences arrays vectors definitions
|
||||
math hashtables sets generalizations namespaces make
|
||||
words.symbol ;
|
||||
USING: accessors arrays assocs classes.tuple definitions
|
||||
generalizations generic hashtables kernel lexer make math parser
|
||||
sequences sets slots words words.symbol ;
|
||||
IN: delegate
|
||||
|
||||
: protocol-words ( protocol -- words )
|
||||
|
@ -78,16 +77,15 @@ M: tuple-class group-words
|
|||
[ dup word? [ 0 2array ] when ] map ;
|
||||
|
||||
: define-protocol ( protocol wordlist -- )
|
||||
fill-in-depth
|
||||
[ forget-old-definitions ]
|
||||
[ add-new-definitions ]
|
||||
[ initialize-protocol-props ] 2tri ;
|
||||
[ drop define-symbol ] [
|
||||
fill-in-depth
|
||||
[ forget-old-definitions ]
|
||||
[ add-new-definitions ]
|
||||
[ initialize-protocol-props ] 2tri
|
||||
] 2bi ;
|
||||
|
||||
: PROTOCOL:
|
||||
CREATE-WORD
|
||||
[ define-symbol ]
|
||||
[ f "inline" set-word-prop ]
|
||||
[ parse-definition define-protocol ] tri ; parsing
|
||||
CREATE-WORD parse-definition define-protocol ; parsing
|
||||
|
||||
PREDICATE: protocol < word protocol-words ; ! Subclass of symbol?
|
||||
|
||||
|
@ -102,3 +100,8 @@ M: protocol definition protocol-words show-words ;
|
|||
M: protocol definer drop \ PROTOCOL: \ ; ;
|
||||
|
||||
M: protocol group-words protocol-words ;
|
||||
|
||||
: SLOT-PROTOCOL:
|
||||
CREATE-WORD ";" parse-tokens
|
||||
[ [ reader-word ] [ writer-word ] bi 2array ] map concat
|
||||
define-protocol ; parsing
|
Loading…
Reference in New Issue