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

core/bootstrap/stage2.factor

@@ -111,7 +111,8 @@ SYMBOL: bootstrap-time
         "output-image" get resource-path save-image-and-exit
     ] if
 ] [
-    print-error :c restarts.
+    :c
+    print-error restarts.
     "listener" vocab-main execute
     1 exit
 ] recover

extra/builder/builder.factor

@@ -97,8 +97,7 @@ VAR: stamp
                    } }
      { +stdout+   "../boot-log" }
      { +stderr+   +stdout+ }
-   }
+   } ;
-  >hashtable ;
 
 : builder-test ( -- desc ) `{ ,[ factor-binary ] "-run=builder.test" } ;
   
@@ -144,7 +143,11 @@ SYMBOL: build-status
 
     [ my-arch download-image ] [ "Image download error" print throw ] recover
 
-    bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
+    ! bootstrap [ "Bootstrap error" print "../boot-log" cat ] run-or-bail
+
+    bootstrap <process-stream> dup dispose process-stream-process wait-for-process zero? not
+      [ "Bootstrap error" print "../boot-log" cat "bootstrap error" throw ]
+    when
 
     [ builder-test try-process ]
     [ "Builder test error" print throw ]

extra/db/db.factor

@@ -27,32 +27,25 @@ HOOK: db-close db ( handle -- )
     ] with-variable ;
 
 TUPLE: statement sql params handle bound? ;
-
 TUPLE: simple-statement ;
 TUPLE: prepared-statement ;
 
 HOOK: <simple-statement> db ( str -- statement )
 HOOK: <prepared-statement> db ( str -- statement )
-
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( obj statement -- )
-GENERIC: rebind-statement ( obj statement -- )
+GENERIC: reset-statement ( statement -- )
-
 GENERIC: execute-statement ( statement -- )
 
 : bind-statement ( obj statement -- )
-    2dup dup statement-bound? [
+    dup statement-bound? [ dup reset-statement ] when
-        rebind-statement
+    [ bind-statement* ] 2keep
-    ] [
+    [ set-statement-params ] keep
-        bind-statement*
-    ] if
-    tuck set-statement-params
     t swap set-statement-bound? ;
 
 TUPLE: result-set sql params handle n max ;
 
 GENERIC: query-results ( query -- result-set )
-
 GENERIC: #rows ( result-set -- n )
 GENERIC: #columns ( result-set -- n )
 GENERIC# row-column 1 ( result-set n -- obj )

extra/db/postgresql/ffi/ffi.factor

@@ -1,17 +1,14 @@
-! Copyright (C) 2007 Doug Coleman.
+! Copyright (C) 2007, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 ! tested on debian linux with postgresql 8.1
-
 USING: alien alien.syntax combinators system ;
 IN: db.postgresql.ffi
 
-<<
+<< "postgresql" {
-"postgresql" {
     { [ win32? ]  [ "libpq.dll" ] }
     { [ macosx? ] [ "/opt/local/lib/postgresql81/libpq.dylib" ] }
     { [ unix?  ]  [ "libpq.so" ] }
-} cond "cdecl" add-library
+} cond "cdecl" add-library >>
->>
 
 ! ConnSatusType
 : CONNECTION_OK                     HEX: 0 ; inline
@@ -75,7 +72,6 @@ TYPEDEF: void* SSL*
 
 LIBRARY: postgresql
 
-
 ! Exported functions of libpq
 
 ! make a new client connection to the backend
@@ -102,10 +98,6 @@ FUNCTION: PQconninfoOption* PQconndefaults ( ) ;
 ! free the data structure returned by PQconndefaults()
 FUNCTION: void PQconninfoFree ( PQconninfoOption* connOptions ) ;
 
-! 
-! close the current connection and restablish a new one with the same
-! parameters
-!
 ! Asynchronous (non-blocking)
 FUNCTION: int    PQresetStart ( PGconn* conn ) ;
 FUNCTION: PostgresPollingStatusType PQresetPoll ( PGconn* conn ) ;

extra/db/postgresql/postgresql.factor

@@ -39,8 +39,8 @@ M: postgresql-db dispose ( db -- )
 M: postgresql-statement bind-statement* ( seq statement -- )
     set-statement-params ;
 
-M: postgresql-statement rebind-statement ( seq statement -- )
+M: postgresql-statement reset-statement ( statement -- )
-    bind-statement* ;
+    drop ;
 
 M: postgresql-result-set #rows ( result-set -- n )
     result-set-handle PQntuples ;

extra/db/sqlite/ffi/ffi.factor

@@ -1,17 +1,12 @@
 ! Copyright (C) 2005 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-!
 ! An interface to the sqlite database. Tested against sqlite v3.1.3.
-
+! Not all functions have been wrapped.
-! Not all functions have been wrapped yet. Only those directly involving
-! executing SQL calls and obtaining results.
-
 USING: alien compiler kernel math namespaces sequences strings alien.syntax
     system combinators ;
 IN: db.sqlite.ffi
 
-<<
+<< "sqlite" {
-    "sqlite" {
         { [ winnt? ]  [ "sqlite3.dll" ] }
         { [ macosx? ] [ "/usr/lib/libsqlite3.dylib" ] }
         { [ unix? ]  [ "libsqlite3.so" ] }
@@ -76,8 +71,9 @@ IN: db.sqlite.ffi
     "File opened that is not a database file"
 } ;
 
-: SQLITE_ROW         100  ; inline ! sqlite_step() has another row ready 
+! Return values from sqlite3_step
-: SQLITE_DONE        101  ; inline ! sqlite_step() has finished executing 
+: SQLITE_ROW         100  ; inline
+: SQLITE_DONE        101  ; inline
 
 ! Return values from the sqlite3_column_type function
 : SQLITE_INTEGER     1 ; inline
@@ -103,7 +99,6 @@ IN: db.sqlite.ffi
 : SQLITE_OPEN_SUBJOURNAL       HEX: 00002000 ; inline
 : SQLITE_OPEN_MASTER_JOURNAL   HEX: 00004000 ; inline
 
-
 TYPEDEF: void sqlite3
 TYPEDEF: void sqlite3_stmt
 TYPEDEF: longlong sqlite3_int64
@@ -112,7 +107,8 @@ TYPEDEF: ulonglong sqlite3_uint64
 LIBRARY: sqlite
 FUNCTION: int sqlite3_open ( char* filename, void* ppDb ) ;
 FUNCTION: int sqlite3_close ( sqlite3* pDb ) ;
-FUNCTION: int sqlite3_prepare ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
+FUNCTION: char* sqlite3_errmsg ( sqlite3* pDb ) ;
+FUNCTION: int sqlite3_prepare_v2 ( sqlite3* pDb, char* zSql, int nBytes, void* ppStmt, void* pzTail ) ;
 FUNCTION: int sqlite3_finalize ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_reset ( sqlite3_stmt* pStmt ) ;
 FUNCTION: int sqlite3_step ( sqlite3_stmt* pStmt ) ;

extra/db/sqlite/lib/lib.factor

@@ -1,18 +1,25 @@
 ! Copyright (C) 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types assocs kernel math math.parser sequences
+USING: alien.c-types arrays assocs kernel math math.parser
-db.sqlite.ffi ;
+namespaces sequences db.sqlite.ffi db combinators
+continuations db.types ;
 IN: db.sqlite.lib
 
-TUPLE: sqlite-error n message ;
+: sqlite-error ( n -- * )
+    sqlite-error-messages nth throw ;
 
-: sqlite-check-result ( result -- )
+: sqlite-statement-error-string ( -- str )
-    dup SQLITE_OK = [
+    db get db-handle sqlite3_errmsg ;
-        drop
+
-    ] [
+: sqlite-statement-error ( -- * )
-        dup sqlite-error-messages nth
+    sqlite-statement-error-string throw ;
-        sqlite-error construct-boa throw
+
-    ] if ;
+: sqlite-check-result ( n -- )
+    {
+        { [ dup SQLITE_OK = ] [ drop ] }
+        { [ dup SQLITE_ERROR = ] [ sqlite-statement-error ] }
+        { [ t ] [ sqlite-error ] }
+    } cond ;
 
 : sqlite-open ( filename -- db )
     "void*" <c-object>
@@ -21,61 +28,83 @@ TUPLE: sqlite-error n message ;
 : sqlite-close ( db -- )
     sqlite3_close sqlite-check-result ;
 
-: sqlite-prepare ( db sql -- statement )
+: sqlite-prepare ( db sql -- handle )
-    #! TODO: Support multiple statements in the SQL string.
     dup length "void*" <c-object> "void*" <c-object>
-    [ sqlite3_prepare sqlite-check-result ] 2keep
+    [ sqlite3_prepare_v2 sqlite-check-result ] 2keep
     drop *void* ;
 
-: sqlite-bind-text ( statement index text -- )
+: sqlite-bind-parameter-index ( handle name -- index )
-    dup number? [ number>string ] when
-    dup length SQLITE_TRANSIENT sqlite3_bind_text sqlite-check-result ;
-
-: sqlite-bind-parameter-index ( statement name -- index )
     sqlite3_bind_parameter_index ;
 
-: sqlite-bind-text-by-name ( statement name text -- )
+: parameter-index ( handle name text -- handle name text )
-    >r dupd sqlite-bind-parameter-index r> sqlite-bind-text ;
+    >r dupd sqlite-bind-parameter-index r> ;
 
-: sqlite-bind-assoc ( statement assoc -- )
+: sqlite-bind-text ( handle index text -- )
-    swap [
+    dup length SQLITE_TRANSIENT
-        -rot sqlite-bind-text-by-name
+    sqlite3_bind_text sqlite-check-result ;
-    ] curry assoc-each ;
 
-: sqlite-finalize ( statement -- )
+: sqlite-bind-int ( handle i n -- )
+    sqlite3_bind_int sqlite-check-result ;
+
+: sqlite-bind-int64 ( handle i n -- )
+    sqlite3_bind_int64 sqlite-check-result ;
+
+: sqlite-bind-double ( handle i x -- )
+    sqlite3_bind_double sqlite-check-result ;
+
+: sqlite-bind-null ( handle i -- )
+    sqlite3_bind_null sqlite-check-result ;
+
+: sqlite-bind-text-by-name ( handle name text -- )
+    parameter-index sqlite-bind-text ;
+
+: sqlite-bind-int-by-name ( handle name int -- )
+    parameter-index sqlite-bind-int ;
+
+: sqlite-bind-int64-by-name ( handle name int64 -- )
+    parameter-index sqlite-bind-int ;
+
+: sqlite-bind-double-by-name ( handle name double -- )
+    parameter-index sqlite-bind-double ;
+
+: sqlite-bind-null-by-name ( handle name obj -- )
+    parameter-index drop sqlite-bind-null ;
+
+: sqlite-bind-type ( handle key value type -- )
+    dup array? [ first ] when
+    {
+        { INTEGER [ sqlite-bind-int-by-name ] }
+        { BIG_INTEGER [ sqlite-bind-int-by-name ] }
+        { TEXT [ sqlite-bind-text-by-name ] }
+        { VARCHAR [ sqlite-bind-text-by-name ] }
+        { DOUBLE [ sqlite-bind-double-by-name ] }
+        ! { NULL [ sqlite-bind-null-by-name ] }
+        [ no-sql-type ]
+    } case ;
+
+: sqlite-finalize ( handle -- )
     sqlite3_finalize sqlite-check-result ;
 
-: sqlite-reset ( statement -- )
+: sqlite-reset ( handle -- )
     sqlite3_reset sqlite-check-result ;
 
 : sqlite-#columns ( query -- int )
     sqlite3_column_count ;
 
-: sqlite-column ( statement index -- string )
+! TODO
+: sqlite-column ( handle index -- string )
     sqlite3_column_text ;
 
-: sqlite-row ( statement -- seq )
+! TODO
+: sqlite-row ( handle -- seq )
     dup sqlite-#columns [ sqlite-column ] with map ;
 
-! 2dup sqlite3_column_type .
-! SQLITE_INTEGER     1
-! SQLITE_FLOAT       2
-! SQLITE_TEXT        3
-! SQLITE_BLOB        4
-! SQLITE_NULL        5
-
 : step-complete? ( step-result -- bool )
     dup SQLITE_ROW =  [
         drop f
     ] [
-        dup SQLITE_DONE = [ drop t ] [ sqlite-check-result t ] if
+        dup SQLITE_DONE =
-    ] if ;
+        [ drop ] [ sqlite-check-result ] if t
-
-: sqlite-step ( prepared -- )
-    dup sqlite3_step step-complete? [
-        drop
-    ] [
-        sqlite-step
     ] if ;
 
 : sqlite-next ( prepared -- ? )

extra/db/sqlite/sqlite-tests.factor

@@ -1,6 +1,6 @@
 USING: io io.files io.launcher kernel namespaces
 prettyprint tools.test db.sqlite db sequences
-continuations ;
+continuations db.types ;
 IN: temporary
 
 : test.db "extra/db/sqlite/test.db" resource-path ;
@@ -26,13 +26,13 @@ IN: temporary
     test.db [
         "select * from person where name = :name and country = :country"
         <simple-statement> [
-            { { ":name" "Jane" } { ":country" "New Zealand" } }
+            { { ":name" "Jane" TEXT } { ":country" "New Zealand" TEXT } }
             over do-bound-query
 
             { { "Jane" "New Zealand" } } =
             [ "test fails" throw ] unless
 
-            { { ":name" "John" } { ":country" "America" } }
+            { { ":name" "John" TEXT } { ":country" "America" TEXT } }
             swap do-bound-query
         ] with-disposal
     ] with-sqlite

extra/db/sqlite/sqlite.factor

@@ -43,12 +43,14 @@ M: sqlite-statement dispose ( statement -- )
 M: sqlite-result-set dispose ( result-set -- )
     f swap set-result-set-handle ;
 
-M: sqlite-statement bind-statement* ( assoc statement -- )
+: sqlite-bind ( triples handle -- )
-    statement-handle swap sqlite-bind-assoc ;
+    swap [ first3 sqlite-bind-type ] with each ;
 
-M: sqlite-statement rebind-statement ( assoc statement -- )
+M: sqlite-statement bind-statement* ( triples statement -- )
-    dup statement-handle sqlite-reset
+    statement-handle sqlite-bind ;
-    statement-handle swap sqlite-bind-assoc ;
+
+M: sqlite-statement reset-statement ( statement -- )
+    statement-handle sqlite-reset ;
 
 M: sqlite-statement execute-statement ( statement -- )
     statement-handle sqlite-next drop ;
@@ -118,7 +120,7 @@ M: sqlite-db delete-sql* ( columns table -- sql )
         %
         " where " %
         first second dup % " = :" % %
-    ] "" make dup . ;
+    ] "" make ;
 
 M: sqlite-db select-sql* ( columns table -- sql )
     [
@@ -131,9 +133,10 @@ M: sqlite-db select-sql* ( columns table -- sql )
 
 M: sqlite-db tuple>params ( columns tuple -- obj )
     [
-        >r [ second ":" swap append ] keep first r> get-slot-named
+        >r [ second ":" swap append ] keep r>
-        number>string*
+        dupd >r first r> get-slot-named swap
-    ] curry { } map>assoc  ;
+        third 3array
+    ] curry map ;
     
 M: sqlite-db last-id ( -- id )
     db get db-handle sqlite3_last_insert_rowid ;
@@ -166,6 +169,7 @@ M: sqlite-db sql-modifiers* ( modifiers -- str )
         { INTEGER "integer" }
         { TEXT "text" }
         { VARCHAR "text" }
+        { DOUBLE "real" }
     } ;
 
 M: sqlite-db >sql-type ( obj -- str )

extra/db/tuples/tuples-tests.factor

@@ -1,26 +1,25 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: io.files kernel tools.test db db.sqlite db.tuples
 db.types continuations namespaces ;
 IN: temporary
 
-TUPLE: person the-id the-name the-number ;
+TUPLE: person the-id the-name the-number real ;
 : <person> ( name age -- person )
-    { set-person-the-name set-person-the-number } person construct ;
+    {
-
+        set-person-the-name
-person "PERSON"
+        set-person-the-number
-{
+        set-person-real
-    { "the-id" "ROWID" INTEGER +native-id+ }
+    } person construct ;
-    { "the-name" "NAME" { VARCHAR 256 } +not-null+ } 
-    { "the-number" "AGE" INTEGER { +default+ 0 } }
-} define-persistent
 
+: <assigned-person> ( id name number real -- obj )
+    <person> [ set-person-the-id ] keep ;
 
 SYMBOL: the-person
 
 : test-tuples ( -- )
-    [ person drop-table ] [ ] recover
+    [ person drop-table ] [ drop ] recover
-    person create-table
+    [ ] [ person create-table ] unit-test
-    f "billy" 100 person construct-boa
-    the-person set
     
     [  ] [ the-person get insert-tuple ] unit-test
 
@@ -37,9 +36,33 @@ SYMBOL: the-person
         test-tuples
     ] with-db ;
 
-test-sqlite
-
 ! : test-postgres ( -- )
     ! resource-path <postgresql-db> [
         ! test-tuples
     ! ] with-db ;
+
+person "PERSON"
+{
+    { "the-id" "ROWID" INTEGER +native-id+ }
+    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "the-number" "AGE" INTEGER { +default+ 0 } }
+    { "real" "REAL" DOUBLE { +default+ 0.3 } }
+} define-persistent
+
+"billy" 10 3.14 <person> the-person set
+
+test-sqlite
+! test-postgres
+
+person "PERSON"
+{
+    { "the-id" "ROWID" INTEGER +assigned-id+ }
+    { "the-name" "NAME" { VARCHAR 256 } +not-null+ }
+    { "the-number" "AGE" INTEGER { +default+ 0 } }
+    { "real" "REAL" DOUBLE { +default+ 0.3 } }
+} define-persistent
+
+1 "billy" 20 6.28 <assigned-person> the-person set
+
+test-sqlite
+! test-postgres

extra/db/tuples/tuples.factor

@@ -1,37 +1,28 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes db kernel namespaces
 tuples words sequences slots slots.private math
-math.parser io prettyprint db.types ;
+math.parser io prettyprint db.types continuations ;
-USE: continuations
 IN: db.tuples
 
-! only take a tuple if you have to extract things from it
+: db-columns ( class -- obj ) "db-columns" word-prop ;
-! otherwise take a class
+: db-table ( class -- obj ) "db-table" word-prop ;
-! primary-key vs primary-key-spec
-! define-persistent should enforce a primary key
-! in sqlite, defining a new primary key makes it an alias for rowid, _rowid_, and oid
-! -sql outputs sql code
-! table - string
-! columns - seq of column specifiers
-
-: db-columns ( class -- obj )
-    "db-columns" word-prop ;
-
-: db-table ( class -- obj )
-    "db-table" word-prop ;
 
+TUPLE: no-slot-named ;
+: no-slot-named ( -- * ) T{ no-slot-named } throw ;
 
 : slot-spec-named ( str class -- slot-spec )
-    "slots" word-prop [ slot-spec-name = ] with find nip ;
+    "slots" word-prop [ slot-spec-name = ] with find nip
+    [ no-slot-named ] unless* ;
 
 : offset-of-slot ( str obj -- n )
     class slot-spec-named slot-spec-offset ;
 
 : get-slot-named ( str obj -- value )
-    tuck offset-of-slot slot ;
+    tuck offset-of-slot [ no-slot-named ] unless* slot ;
 
 : set-slot-named ( value str obj -- )
-    tuck offset-of-slot set-slot ;
+    tuck offset-of-slot [ no-slot-named ] unless* set-slot ;
-    
 
 : primary-key-spec ( class -- spec )
     db-columns [ primary-key? ] find nip ;
@@ -43,7 +34,6 @@ IN: db.tuples
     [ class primary-key-spec first ] keep
     set-slot-named ;
 
-
 : cache-statement ( columns class assoc quot -- statement )
     [ db-table dupd ] swap
     [ <prepared-statement> ] 3compose cache nip ; inline
@@ -71,11 +61,12 @@ HOOK: tuple>params db ( columns tuple -- obj )
 
 : tuple-statement ( columns tuple quot -- statement )
     >r [ tuple>params ] 2keep class r> call
+    2dup . .
     [ bind-statement ] keep ;
 
 : do-tuple-statement ( tuple columns-quot statement-quot -- )
     >r [ class db-columns ] swap compose keep
-    r> tuple-statement dup . execute-statement ;
+    r> tuple-statement execute-statement ;
 
 : create-table ( class -- )
     dup db-columns swap db-table create-sql sql-command ;
@@ -101,19 +92,9 @@ HOOK: tuple>params db ( columns tuple -- obj )
 : persist ( tuple -- )
     dup primary-key [ update-tuple ] [ insert-tuple ] if ;
 
-! PERSISTENT:
-
 : define-persistent ( class table columns -- )
     >r dupd "db-table" set-word-prop r>
     "db-columns" set-word-prop ;
 
 : define-relation ( spec -- )
     drop ;
-
-
-
-
-
-
-
-

extra/db/types/types.factor

@@ -1,9 +1,9 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs db kernel math math.parser
 sequences continuations ;
 IN: db.types
 
-
-! id   serial not null primary key,
 ! ID is the Primary key
 SYMBOL: +native-id+
 SYMBOL: +assigned-id+
@@ -19,15 +19,8 @@ SYMBOL: +unique+
 SYMBOL: +default+
 SYMBOL: +null+
 SYMBOL: +not-null+
-SYMBOL: +has-many+
 
-! SQLite Types
+SYMBOL: +has-many+
-! http://www.sqlite.org/datatype3.html
-! SYMBOL: NULL
-! SYMBOL: INTEGER
-! SYMBOL: REAL
-! SYMBOL: TEXT
-! SYMBOL: BLOB
 
 SYMBOL: INTEGER
 SYMBOL: DOUBLE
@@ -41,24 +34,16 @@ SYMBOL: DATE
 
 SYMBOL: BIG_INTEGER
 
-! SYMBOL: LOCALE
-! SYMBOL: TIMEZONE
-! SYMBOL: CURRENCY
-
-
-! PostgreSQL Types
-! http://developer.postgresql.org/pgdocs/postgres/datatype.html
-
-
-: number>string* ( num/str -- str )
-    dup number? [ number>string ] when ;
-
 TUPLE: no-sql-type ;
+: no-sql-type ( -- * ) T{ no-sql-type } throw ;
+
 HOOK: sql-modifiers* db ( modifiers -- str )
 HOOK: >sql-type db ( obj -- str )
 
+! HOOK: >factor-type db ( obj -- obj )
 
-
+: number>string* ( n/str -- str )
+    dup number? [ number>string ] when ;
 
 : maybe-remove-id ( columns -- obj )
     [ +native-id+ swap member? not ] subset ;
@@ -68,3 +53,8 @@ HOOK: >sql-type db ( obj -- str )
 
 : sql-modifiers ( spec -- seq )
     3 tail sql-modifiers* ;
+
+! SQLite Types: http://www.sqlite.org/datatype3.html
+! NULL INTEGER REAL TEXT BLOB
+! PostgreSQL Types:
+! http://developer.postgresql.org/pgdocs/postgres/datatype.html

extra/io/unix/linux/linux.factor

@@ -42,8 +42,8 @@ TUPLE: inotify watches ;
     [ <linux-monitor> dup ] keep watches set-at ;
 
 : remove-watch ( monitor -- )
-    dup linux-monitor-wd watches delete-at
+    dup simple-monitor-handle watches delete-at
-    linux-monitor-wd inotify-fd swap inotify_rm_watch io-error ;
+    simple-monitor-handle inotify-fd swap inotify_rm_watch io-error ;
 
 M: linux-io <monitor> ( path recursive? -- monitor )
     drop IN_CHANGE_EVENTS add-watch ;