implement CREATE-CLASS with create-class

add SINGLETONS:

core/parser/parser.factor

@@ -240,11 +240,14 @@ PREDICATE: unexpected unexpected-eof
 
 : CREATE ( -- word ) scan create-in ;
 
-: CREATE-CLASS ( -- word )
+: create-class ( word vocab -- word )
-    scan in get create
+    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

extra/singleton/singleton-docs.factor

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

extra/singleton/singleton.factor

@@ -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
+    scan define-singleton ; parsing
-    CREATE-CLASS
+
-    dup [ eq? ] curry define-predicate-class ; parsing
+: SINGLETONS:
+    ";" parse-tokens [ define-singleton ] each ; parsing