redo singletons

extra/singleton/singleton-docs.factor

@@ -12,15 +12,3 @@ 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 "USE: singleton" "SINGLETONS: foo bar baz ;" "" }
-} { $see-also
-    POSTPONE: SINGLETON:
-} ;

extra/singleton/singleton-tests.factor

@@ -1,4 +1,4 @@
-USING: kernel singleton tools.test ;
+USING: kernel singleton tools.test prettyprint io.streams.string ;
 IN: singleton.tests
 
 [ ] [ SINGLETON: bzzt ] unit-test
@@ -7,3 +7,6 @@ IN: singleton.tests
 GENERIC: zammo ( obj -- )
 [ ] [ M: bzzt zammo drop "yes!" ; ] unit-test
 [ "yes!" ] [ bzzt zammo ] unit-test
+[ ] [ SINGLETON: omg ] unit-test
+[ t ] [ omg singleton? ] unit-test
+[ "USING: singleton ;\nIN: singleton.tests\nSINGLETON: omg\n" ] [ [ omg see ] with-string-writer ] unit-test

extra/singleton/singleton.factor

@@ -1,16 +1,23 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes.predicate kernel namespaces parser quotations
-sequences words ;
+sequences words prettyprint prettyprint.backend prettyprint.sections
+compiler.units classes ;
+USE: tools.walker
 IN: singleton
 
+PREDICATE: singleton < predicate-class
+    [ "predicate-definition" word-prop ]
+    [ [ eq? ] curry ] bi sequence= ;
+
 : define-singleton ( token -- )
     create-class-in
-    \ word
+    dup save-location
+    \ singleton
     over [ eq? ] curry define-predicate-class ;
 
 : SINGLETON:
     scan define-singleton ; parsing
 
-: SINGLETONS:
-    ";" parse-tokens [ define-singleton ] each ; parsing
+M: singleton see-class* ( class -- )
+    <colon \ SINGLETON: pprint-word pprint-word ;