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

@@ -1,42 +1,42 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: db db.tuples db.types accessors
-http.server.auth.providers kernel continuations
-singleton ;
-IN: http.server.auth.providers.db
-
-user "USERS"
-{
-    { "username" "USERNAME" { VARCHAR 256 } +assigned-id+ }
-    { "realname" "REALNAME" { VARCHAR 256 } }
-    { "password" "PASSWORD" { VARCHAR 256 } +not-null+ }
-    { "email" "EMAIL" { VARCHAR 256 } }
-    { "ticket" "TICKET" { VARCHAR 256 } }
-    { "profile" "PROFILE" FACTOR-BLOB }
-} define-persistent
-
-: init-users-table user ensure-table ;
-
-SINGLETON: users-in-db
-
-: find-user ( username -- user )
-    <user>
-        swap >>username
-    select-tuple ;
-
-M: users-in-db get-user
-    drop
-    find-user ;
-
-M: users-in-db new-user
-    drop
-    [
-        dup username>> find-user [
-            drop f
-        ] [
-            dup insert-tuple
-        ] if
-    ] with-transaction ;
-
-M: users-in-db update-user
-    drop update-tuple ;
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: db db.tuples db.types accessors
+http.server.auth.providers kernel continuations
+classes.singleton ;
+IN: http.server.auth.providers.db
+
+user "USERS"
+{
+    { "username" "USERNAME" { VARCHAR 256 } +assigned-id+ }
+    { "realname" "REALNAME" { VARCHAR 256 } }
+    { "password" "PASSWORD" { VARCHAR 256 } +not-null+ }
+    { "email" "EMAIL" { VARCHAR 256 } }
+    { "ticket" "TICKET" { VARCHAR 256 } }
+    { "profile" "PROFILE" FACTOR-BLOB }
+} define-persistent
+
+: init-users-table user ensure-table ;
+
+SINGLETON: users-in-db
+
+: find-user ( username -- user )
+    <user>
+        swap >>username
+    select-tuple ;
+
+M: users-in-db get-user
+    drop
+    find-user ;
+
+M: users-in-db new-user
+    drop
+    [
+        dup username>> find-user [
+            drop f
+        ] [
+            dup insert-tuple
+        ] if
+    ] with-transaction ;
+
+M: users-in-db update-user
+    drop update-tuple ;

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

@@ -1,46 +1,46 @@
-! 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
-math.parser ;
-IN: http.server.sessions.storage.db
-
-SINGLETON: sessions-in-db
-
-TUPLE: session id namespace ;
-
-session "SESSIONS"
-{
-    { "id" "ID" INTEGER +native-id+ }
-    { "namespace" "NAMESPACE" FACTOR-BLOB }
-} define-persistent
-
-: init-sessions-table session ensure-table ;
-
-: <session> ( id -- session )
-    session construct-empty
-        swap dup [ string>number ] when >>id ;
-
-M: sessions-in-db get-session ( id storage -- namespace/f )
-    drop
-    dup [
-        <session>
-        select-tuple dup [ namespace>> ] when
-    ] when ;
-
-M: sessions-in-db update-session ( namespace id storage -- )
-    drop
-    <session>
-        swap >>namespace
-    update-tuple ;
-
-M: sessions-in-db delete-session ( id storage -- )
-    drop
-    <session>
-    delete-tuple ;
-
-M: sessions-in-db new-session ( namespace storage -- id )
-    drop
-    f <session>
-        swap >>namespace
-    [ insert-tuple ] [ id>> number>string ] bi ;
+! 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 math.parser
+classes.singleton ;
+IN: http.server.sessions.storage.db
+
+SINGLETON: sessions-in-db
+
+TUPLE: session id namespace ;
+
+session "SESSIONS"
+{
+    { "id" "ID" INTEGER +native-id+ }
+    { "namespace" "NAMESPACE" FACTOR-BLOB }
+} define-persistent
+
+: init-sessions-table session ensure-table ;
+
+: <session> ( id -- session )
+    session construct-empty
+        swap dup [ string>number ] when >>id ;
+
+M: sessions-in-db get-session ( id storage -- namespace/f )
+    drop
+    dup [
+        <session>
+        select-tuple dup [ namespace>> ] when
+    ] when ;
+
+M: sessions-in-db update-session ( namespace id storage -- )
+    drop
+    <session>
+        swap >>namespace
+    update-tuple ;
+
+M: sessions-in-db delete-session ( id storage -- )
+    drop
+    <session>
+    delete-tuple ;
+
+M: sessions-in-db new-session ( namespace storage -- id )
+    drop
+    f <session>
+        swap >>namespace
+    [ insert-tuple ] [ id>> number>string ] bi ;

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