diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 3ab489739b..18cdbd3791 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -94,7 +94,9 @@ SYMBOL: +unknown+ : exists? ( path -- ? ) file-modified >boolean ; -: directory? ( path -- ? ) stat 3drop ; +! : directory? ( path -- ? ) stat 3drop ; + +: directory? ( path -- ? ) file-info file-info-type +directory+ = ; ! Current working directory HOOK: cd io-backend ( path -- ) diff --git a/extra/assocs/lib/lib.factor b/extra/assocs/lib/lib.factor index 88095759e6..d2eb42a117 100755 --- a/extra/assocs/lib/lib.factor +++ b/extra/assocs/lib/lib.factor @@ -1,4 +1,4 @@ -USING: assocs kernel vectors sequences namespaces ; +USING: arrays assocs kernel vectors sequences namespaces ; IN: assocs.lib : >set ( seq -- hash ) @@ -35,3 +35,6 @@ IN: assocs.lib [ with each ] curry assoc-each ; inline : insert ( value variable -- ) namespace insert-at ; + +: 2seq>assoc ( keys values exemplar -- assoc ) + >r 2array flip r> assoc-like ; diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 52150b07a8..7d95ce2409 100644 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -134,7 +134,9 @@ SYMBOL: build-status "Did not pass load-everything: " print "load-everything-vocabs" cat "Did not pass test-all: " print "test-all-vocabs" cat - "test-all-vocabs" eval-file test-failures. + "test-failures" cat + +! "test-failures" eval-file test-failures. "help-lint results:" print "help-lint" cat diff --git a/extra/combinators/cleave/cleave.factor b/extra/combinators/cleave/cleave.factor index fd66536c12..049c8bf2a9 100644 --- a/extra/combinators/cleave/cleave.factor +++ b/extra/combinators/cleave/cleave.factor @@ -70,3 +70,29 @@ MACRO: spread ( seq -- ) swap [ [ r> ] swap append ] map concat append ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Cleave into array +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USING: words quotations fry arrays.lib ; + +: >quot ( obj -- quot ) dup word? [ 1quotation ] when ; + +: >quots ( seq -- seq ) [ >quot ] map ; + +MACRO: ( seq -- ) + [ >quots ] [ length ] bi + '[ , cleave , narray ] ; + +MACRO: <2arr> ( seq -- ) + [ >quots ] [ length ] bi + '[ , 2cleave , narray ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Spread into array +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MACRO: ( seq -- ) + [ >quots ] [ length ] bi + '[ , spread , narray ] ; diff --git a/extra/db/sqlite/lib/lib.factor b/extra/db/sqlite/lib/lib.factor index dbada854fb..d630522eb8 100755 --- a/extra/db/sqlite/lib/lib.factor +++ b/extra/db/sqlite/lib/lib.factor @@ -102,17 +102,10 @@ IN: db.sqlite.lib [ no-sql-type ] } case ; -: sqlite-finalize ( handle -- ) - sqlite3_finalize sqlite-check-result ; - -: sqlite-reset ( handle -- ) - sqlite3_reset sqlite-check-result ; - -: sqlite-#columns ( query -- int ) - sqlite3_column_count ; - -: sqlite-column ( handle index -- string ) - sqlite3_column_text ; +: sqlite-finalize ( handle -- ) sqlite3_finalize sqlite-check-result ; +: sqlite-reset ( handle -- ) sqlite3_reset sqlite-check-result ; +: sqlite-#columns ( query -- int ) sqlite3_column_count ; +: sqlite-column ( handle index -- string ) sqlite3_column_text ; : sqlite-column-blob ( handle index -- byte-array/f ) [ sqlite3_column_bytes ] 2keep diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor index b72d788605..9a9db74401 100755 --- a/extra/db/sqlite/sqlite.factor +++ b/extra/db/sqlite/sqlite.factor @@ -17,16 +17,11 @@ M: sqlite-db db-open ( db -- ) dup sqlite-db-path sqlite-open swap set-delegate ; -M: sqlite-db db-close ( handle -- ) - sqlite-close ; - +M: sqlite-db db-close ( handle -- ) sqlite-close ; M: sqlite-db dispose ( db -- ) dispose-db ; - -: with-sqlite ( path quot -- ) - sqlite-db swap with-db ; inline +: with-sqlite ( path quot -- ) sqlite-db swap with-db ; inline TUPLE: sqlite-statement ; - TUPLE: sqlite-result-set has-more? ; M: sqlite-db ( str in out -- obj ) @@ -51,8 +46,7 @@ M: sqlite-result-set dispose ( result-set -- ) : sqlite-bind ( triples handle -- ) swap [ first3 sqlite-bind-type ] with each ; -: reset-statement ( statement -- ) - statement-handle sqlite-reset ; +: reset-statement ( statement -- ) statement-handle sqlite-reset ; M: sqlite-statement bind-statement* ( statement -- ) dup statement-bound? [ dup reset-statement ] when @@ -98,14 +92,9 @@ M: sqlite-statement query-results ( query -- result-set ) dup statement-handle sqlite-result-set dup advance-row ; -M: sqlite-db begin-transaction ( -- ) - "BEGIN" sql-command ; - -M: sqlite-db commit-transaction ( -- ) - "COMMIT" sql-command ; - -M: sqlite-db rollback-transaction ( -- ) - "ROLLBACK" sql-command ; +M: sqlite-db begin-transaction ( -- ) "BEGIN" sql-command ; +M: sqlite-db commit-transaction ( -- ) "COMMIT" sql-command ; +M: sqlite-db rollback-transaction ( -- ) "ROLLBACK" sql-command ; : sqlite-make ( class quot -- ) >r sql-props r> @@ -123,9 +112,7 @@ M: sqlite-db create-sql-statement ( class -- statement ) ] sqlite-make ; M: sqlite-db drop-sql-statement ( class -- statement ) - [ - "drop table " 0% 0% ";" 0% drop - ] sqlite-make ; + [ "drop table " 0% 0% ";" 0% drop ] sqlite-make ; M: sqlite-db ( tuple -- statement ) [ @@ -195,10 +182,9 @@ M: sqlite-db modifier-table ( -- hashtable ) { +not-null+ "not null" } } ; -M: sqlite-db compound-modifier ( str obj -- newstr ) - compound-type ; +M: sqlite-db compound-modifier ( str obj -- str' ) compound-type ; -M: sqlite-db compound-type ( str seq -- newstr ) +M: sqlite-db compound-type ( str seq -- str' ) over { { "default" [ first number>string join-space ] } [ 2drop ] ! "no sqlite compound data type" 3array throw ] @@ -219,5 +205,4 @@ M: sqlite-db type-table ( -- assoc ) { FACTOR-BLOB "blob" } } ; -M: sqlite-db create-type-table - type-table ; +M: sqlite-db create-type-table ( symbol -- str ) type-table ; diff --git a/extra/ldap/libldap/libldap.factor b/extra/ldap/libldap/libldap.factor index ae613bd461..6db6884071 100755 --- a/extra/ldap/libldap/libldap.factor +++ b/extra/ldap/libldap/libldap.factor @@ -10,9 +10,9 @@ USING: alien alien.syntax combinators kernel system ; IN: ldap.libldap << "libldap" { - { [ win32? ] [ "libldap.dll" "stdcall" ] } + { [ win32? ] [ "libldap.dll" "stdcall" ] } { [ macosx? ] [ "libldap.dylib" "cdecl" ] } - { [ unix? ] [ "$LD_LIBRARY_PATH/libldap.so" "cdecl" ] } + { [ unix? ] [ "libldap.so" "cdecl" ] } } cond add-library >> : LDAP_VERSION1 1 ; inline diff --git a/extra/openssl/libcrypto/libcrypto.factor b/extra/openssl/libcrypto/libcrypto.factor index 8378a11956..7b3ad2cf9f 100755 --- a/extra/openssl/libcrypto/libcrypto.factor +++ b/extra/openssl/libcrypto/libcrypto.factor @@ -10,9 +10,9 @@ USING: alien alien.syntax combinators kernel system ; IN: openssl.libcrypto "libcrypto" { - { [ win32? ] [ "libeay32.dll" "stdcall" ] } + { [ win32? ] [ "libeay32.dll" "stdcall" ] } { [ macosx? ] [ "libcrypto.dylib" "cdecl" ] } - { [ unix? ] [ "$LD_LIBRARY_PATH/libcrypto.so" "cdecl" ] } + { [ unix? ] [ "libcrypto.so" "cdecl" ] } } cond add-library C-STRUCT: bio-method diff --git a/extra/openssl/libssl/libssl.factor b/extra/openssl/libssl/libssl.factor index 8d1b3b5247..d8709cbf53 100644 --- a/extra/openssl/libssl/libssl.factor +++ b/extra/openssl/libssl/libssl.factor @@ -10,9 +10,9 @@ USING: alien alien.syntax combinators kernel system ; IN: openssl.libssl << "libssl" { - { [ win32? ] [ "ssleay32.dll" "stdcall" ] } + { [ win32? ] [ "ssleay32.dll" "stdcall" ] } { [ macosx? ] [ "libssl.dylib" "cdecl" ] } - { [ unix? ] [ "$LD_LIBRARY_PATH/libssl.so" "cdecl" ] } + { [ unix? ] [ "libssl.so" "cdecl" ] } } cond add-library >> : X509_FILETYPE_PEM 1 ; inline diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index 050de0ae1c..13e8eb949f 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -3,7 +3,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: combinators.lib kernel sequences math namespaces assocs random sequences.private shuffle math.functions mirrors -arrays math.parser math.private sorting strings ascii macros ; +arrays math.parser math.private sorting strings ascii macros +assocs.lib ; IN: sequences.lib : each-withn ( seq quot n -- ) nwith each ; inline @@ -220,3 +221,6 @@ PRIVATE> : nths ( indices seq -- seq' ) [ swap nth ] with map ; + +: replace ( str oldseq newseq -- str' ) + H{ } 2seq>assoc substitute ;