implement CREATE-CLASS with create-class

add SINGLETONS:
db4
Doug Coleman 2008-03-08 12:01:48 -06:00
parent 07e8986226
commit 3b7d630a84
3 changed files with 27 additions and 7 deletions

View File

@ -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

View File

@ -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:
} ;

View File

@ -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