Merge branch 'master' of git://factorcode.org/git/factor

extra/classes/singleton/singleton-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax kernel words ;
-IN: singleton
+IN: classes.singleton
 
 HELP: SINGLETON:
 { $syntax "SINGLETON: class"
@@ -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/classes/singleton/singleton-tests.factor

@@ -0,0 +1,12 @@
+USING: kernel singleton tools.test prettyprint io.streams.string ;
+IN: classes.singleton.tests
+
+[ ] [ SINGLETON: bzzt ] unit-test
+[ t ] [ bzzt bzzt? ] unit-test
+[ t ] [ bzzt bzzt eq? ] unit-test
+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: classes.singleton.tests\nSINGLETON: omg\n" ] [ [ omg see ] with-string-writer ] unit-test

extra/classes/singleton/singleton.factor

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

extra/db/types/types.factor

@@ -4,7 +4,7 @@ USING: arrays assocs db kernel math math.parser
 sequences continuations sequences.deep sequences.lib
 words namespaces tools.walker slots slots.private classes
 mirrors classes.tuple combinators calendar.format symbols
-singleton ;
+classes.singleton ;
 IN: db.types
 
 HOOK: modifier-table db ( -- hash )

extra/http/server/auth/providers/db/db.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: db db.tuples db.types accessors
 http.server.auth.providers kernel continuations
-singleton ;
+classes.singleton ;
 IN: http.server.auth.providers.db
 
 user "USERS"

extra/http/server/sessions/storage/db/db.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors http.server.sessions.storage
-alarms kernel http.server db.tuples db.types singleton
+alarms kernel http.server db.tuples db.types math.parser
-math.parser ;
+classes.singleton ;
 IN: http.server.sessions.storage.db
 
 SINGLETON: sessions-in-db

extra/math/polynomials/polynomials.factor

@@ -22,7 +22,7 @@ PRIVATE>
 : p= ( p p -- ? ) pextend = ;
 
 : ptrim ( p -- p )
-    dup singleton? [ [ zero? ] right-trim ] unless ;
+    dup length 1 = [ [ zero? ] right-trim ] unless ;
 
 : 2ptrim ( p p -- p p ) [ ptrim ] bi@ ;
 : p+ ( p p -- p ) pextend v+ ;

extra/math/text/english/english.factor

@@ -79,7 +79,7 @@ SYMBOL: and-needed?
     ] if ;
 
 : recombine ( seq -- str )
-    dup singleton? [
+    dup length 1 = [
         first 3digits>text
     ] [
         dup set-conjunction "" swap

extra/random/unix/unix.factor

@@ -1,5 +1,5 @@
 USING: alien.c-types io io.files io.nonblocking kernel
-namespaces random io.encodings.binary singleton init
+namespaces random io.encodings.binary init
 accessors system ;
 IN: random.unix
 

extra/sequences/lib/lib-tests.factor

@@ -46,9 +46,6 @@ IN: sequences.lib.tests
 [ { 1 -1 5 2 4 } [ < ] monotonic-split [ >array ] map ] unit-test
 [ { { 1 1 1 1 } { 2 2 } { 3 } { 4 } { 5 } { 6 6 6 } } ]
 [ { 1 1 1 1 2 2 3 4 5 6 6 6 } [ = ] monotonic-split [ >array ] map ] unit-test
-[ f ] [ { } singleton? ] unit-test
-[ t ] [ { "asdf" } singleton? ] unit-test
-[ f ] [ { "asdf" "bsdf" } singleton? ] unit-test
 
 [ 2 ] [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test
 [ V{ } [ delete-random drop ] keep length ] must-fail

extra/sequences/lib/lib.factor

@@ -98,9 +98,6 @@ MACRO: firstn ( n -- )
         v, [ pick ,, call [ v, ] unless ] curry 2each ,v
     ] { } make ;
 
-: singleton? ( seq -- ? )
-    length 1 = ;
-
 : delete-random ( seq -- value )
     [ length random ] keep [ nth ] 2keep delete-nth ;
 

extra/singleton/singleton-tests.factor

@@ -1,9 +0,0 @@
-USING: kernel singleton tools.test ;
-IN: singleton.tests
-
-[ ] [ SINGLETON: bzzt ] unit-test
-[ t ] [ bzzt bzzt? ] unit-test
-[ t ] [ bzzt bzzt eq? ] unit-test
-GENERIC: zammo ( obj -- )
-[ ] [ M: bzzt zammo drop "yes!" ; ] unit-test
-[ "yes!" ] [ bzzt zammo ] unit-test

extra/singleton/singleton.factor

@@ -1,16 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: classes.predicate kernel namespaces parser quotations
-sequences words ;
-IN: singleton
-
-: define-singleton ( token -- )
-    create-class-in
-    \ word
-    over [ eq? ] curry define-predicate-class ;
-
-: SINGLETON:
-    scan define-singleton ; parsing
-
-: SINGLETONS:
-    ";" parse-tokens [ define-singleton ] each ; parsing