38 lines
		
	
	
		
			1.1 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			38 lines
		
	
	
		
			1.1 KiB
		
	
	
	
		
			Factor
		
	
	
| USING: accessors arrays assocs generic.standard kernel
 | |
| lexer locals.types namespaces parser quotations vocabs.parser
 | |
| words classes.tuple ;
 | |
| IN: functors.backend
 | |
| 
 | |
| DEFER: functor-words
 | |
| \ functor-words [ H{ } clone ] initialize
 | |
| 
 | |
| SYNTAX: FUNCTOR-SYNTAX:
 | |
|     scan-word
 | |
|     gensym [ parse-definition define-syntax ] keep
 | |
|     swap name>> \ functor-words get-global set-at ;
 | |
| 
 | |
| : functor-words ( -- assoc )
 | |
|     \ functor-words get-global ;
 | |
| 
 | |
| : scan-param ( -- obj ) scan-object literalize ;
 | |
| 
 | |
| : >string-param ( string -- string/param )
 | |
|     dup search dup lexical? [ nip ] [ drop ] if ;
 | |
| 
 | |
| : scan-string-param ( -- name/param )
 | |
|     scan-token >string-param ;
 | |
| 
 | |
| : scan-c-type-param ( -- c-type/param )
 | |
|     scan-token dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
 | |
| 
 | |
| : define* ( word def -- ) over set-last-word define ;
 | |
| 
 | |
| : define-declared* ( word def effect -- )
 | |
|     pick set-last-word define-declared ;
 | |
| 
 | |
| : define-simple-generic* ( word effect -- )
 | |
|     over set-last-word define-simple-generic ;
 | |
| 
 | |
| : define-tuple-class* ( class superclass slots -- )
 | |
|     pick set-last-word define-tuple-class ;
 |