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

Add new SLOT-PROTOCOL: word; shorthand for PROTOCOL: comprised for slot readers and writers

db4
Slava Pestov 2009-01-16 16:39:24 -06:00
parent 3697fa1aa3
commit 21f81ab57d
1 changed files with 15 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
basis/delegate/delegate.factor
View File

@ -1,9 +1,8 @@
! Copyright (C) 2007, 2008 Daniel Ehrenberg ! Copyright (C) 2007, 2008 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors parser generic kernel classes classes.tuple USING: accessors arrays assocs classes.tuple definitions
words slots assocs sequences arrays vectors definitions generalizations generic hashtables kernel lexer make math parser
math hashtables sets generalizations namespaces make sequences sets slots words words.symbol ;
words.symbol ;
IN: delegate IN: delegate
: protocol-words ( protocol -- words ) : protocol-words ( protocol -- words )
@ -78,16 +77,15 @@ M: tuple-class group-words
[ dup word? [ 0 2array ] when ] map ; [ dup word? [ 0 2array ] when ] map ;
: define-protocol ( protocol wordlist -- ) : define-protocol ( protocol wordlist -- )
fill-in-depth [ drop define-symbol ] [
[ forget-old-definitions ] fill-in-depth
[ add-new-definitions ] [ forget-old-definitions ]
[ initialize-protocol-props ] 2tri ; [ add-new-definitions ]
[ initialize-protocol-props ] 2tri
] 2bi ;
: PROTOCOL: : PROTOCOL:
CREATE-WORD CREATE-WORD parse-definition define-protocol ; parsing
[ define-symbol ]
[ f "inline" set-word-prop ]
[ parse-definition define-protocol ] tri ; parsing
PREDICATE: protocol < word protocol-words ; ! Subclass of symbol? 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 definer drop \ PROTOCOL: \ ; ;
M: protocol group-words protocol-words ; M: protocol group-words protocol-words ;
: SLOT-PROTOCOL:
CREATE-WORD ";" parse-tokens
[ [ reader-word ] [ writer-word ] bi 2array ] map concat
define-protocol ; parsing