parent
							
								
									07e8986226
								
							
						
					
					
						commit
						3b7d630a84
					
				| 
						 | 
				
			
			@ -240,11 +240,14 @@ PREDICATE: unexpected unexpected-eof
 | 
			
		|||
 | 
			
		||||
: CREATE ( -- word ) scan create-in ;
 | 
			
		||||
 | 
			
		||||
: CREATE-CLASS ( -- word )
 | 
			
		||||
    scan in get create
 | 
			
		||||
: create-class ( word vocab -- word )
 | 
			
		||||
    create
 | 
			
		||||
    dup save-class-location
 | 
			
		||||
    dup predicate-word dup set-word save-location ;
 | 
			
		||||
 | 
			
		||||
: CREATE-CLASS ( -- word )
 | 
			
		||||
    scan in get create-class ;
 | 
			
		||||
 | 
			
		||||
: word-restarts ( possibilities -- restarts )
 | 
			
		||||
    natural-sort [
 | 
			
		||||
        [ "Use the word " swap summary append ] keep
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -12,3 +12,15 @@ HELP: SINGLETON:
 | 
			
		|||
} { $see-also
 | 
			
		||||
    POSTPONE: PREDICATE:
 | 
			
		||||
} ;
 | 
			
		||||
 | 
			
		||||
HELP: SINGLETONS:
 | 
			
		||||
{ $syntax "SINGLETONS: classes... ;"
 | 
			
		||||
} { $values
 | 
			
		||||
    { "classes" "new singletons to define" }
 | 
			
		||||
} { $description
 | 
			
		||||
    "Defines a new singleton for each class in the list."
 | 
			
		||||
} { $examples
 | 
			
		||||
    { $example "SINGLETONS: foo bar baz ;" "" }
 | 
			
		||||
} { $see-also
 | 
			
		||||
    POSTPONE: SINGLETON:
 | 
			
		||||
} ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,10 +1,15 @@
 | 
			
		|||
! Copyright (C) 2007 Doug Coleman.
 | 
			
		||||
! Copyright (C) 2008 Doug Coleman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: classes.predicate kernel parser quotations words ;
 | 
			
		||||
USING: classes.predicate kernel namespaces parser quotations
 | 
			
		||||
sequences words ;
 | 
			
		||||
IN: singleton
 | 
			
		||||
 | 
			
		||||
: define-singleton ( token -- )
 | 
			
		||||
    \ word swap in get create-class
 | 
			
		||||
    dup [ eq? ] curry define-predicate-class ;
 | 
			
		||||
 | 
			
		||||
: SINGLETON:
 | 
			
		||||
    \ word
 | 
			
		||||
    CREATE-CLASS
 | 
			
		||||
    dup [ eq? ] curry define-predicate-class ; parsing
 | 
			
		||||
    scan define-singleton ; parsing
 | 
			
		||||
 | 
			
		||||
: SINGLETONS:
 | 
			
		||||
    ";" parse-tokens [ define-singleton ] each ; parsing
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue