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 -- )
 | 
			
		||||
    [ drop define-symbol ] [
 | 
			
		||||
        fill-in-depth
 | 
			
		||||
        [ forget-old-definitions ]
 | 
			
		||||
        [ add-new-definitions ]
 | 
			
		||||
    [ initialize-protocol-props ] 2tri ;
 | 
			
		||||
        [ 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