From 7c596f6b02fe2592fa7af0698b37d4232f5ddc5e Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 24 Sep 2008 00:02:36 -0300 Subject: [PATCH 001/244] irc.client: Make irc-client have its own nick field, profiles shouldn't be mutated --- extra/irc/client/client-tests.factor | 6 +++--- extra/irc/client/client.factor | 18 ++++++++++-------- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index c768c1a82e..3554f6c120 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -42,9 +42,9 @@ M: mb-writer stream-nl ( mb-writer -- ) ! TESTS ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -[ { t } [ irc> profile>> nickname>> me? ] unit-test +[ { t } [ irc> nick>> me? ] unit-test - { "factorbot" } [ irc> profile>> nickname>> ] unit-test + { "factorbot" } [ irc> nick>> ] unit-test { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test @@ -58,7 +58,7 @@ M: mb-writer stream-nl ( mb-writer -- ) ! Test login and nickname set [ { "factorbot2" } [ ":some.where 001 factorbot2 :Welcome factorbot2" %push-line - irc> profile>> nickname>> + irc> nick>> ] unit-test ] with-irc diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 569f6c4bf7..b6eeec9468 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -18,9 +18,9 @@ TUPLE: irc-profile server port nickname password ; C: irc-profile TUPLE: irc-client profile stream in-messages out-messages join-messages - listeners is-running connect reconnect-time ; + listeners is-running nick connect reconnect-time ; : ( profile -- irc-client ) - f H{ } clone f + [ f H{ } clone f ] keep nickname>> [ latin1 ] 15 seconds irc-client boa ; TUPLE: irc-listener in-messages out-messages ; @@ -78,7 +78,9 @@ PRIVATE> : terminate-irc ( irc-client -- ) [ is-running>> ] keep and [ - [ end-loops ] [ [ f ] dip (>>is-running) ] bi + [ end-loops ] + [ [ f ] dip (>>is-running) ] + bi ] when* ; out-messages>> mailbox-put ; : listener> ( name -- listener/f ) irc> listeners>> at ; : channel-mode? ( mode -- ? ) name>> first "#&" member? ; -: me? ( string -- ? ) irc> profile>> nickname>> = ; +: me? ( string -- ? ) irc> nick>> = ; GENERIC: to-listener ( message obj -- ) @@ -122,7 +124,7 @@ M: irc-listener to-listener ( message irc-listener -- ) : listeners-with-participant ( nick -- seq ) irc> listeners>> values - [ dup irc-channel-listener? [ participants>> key? ] [ 2drop f ] if ] + [ [ irc-channel-listener? ] keep and [ participants>> key? ] when* ] with filter ; : to-listeners-with-participant ( message nickname -- ) @@ -218,7 +220,7 @@ M: object process-message ( object -- ) drop ; M: logged-in process-message ( logged-in -- ) - name>> irc> profile>> (>>nickname) ; + name>> irc> (>>nick) ; M: ping process-message ( ping -- ) trailing>> /PONG ; @@ -285,7 +287,7 @@ DEFER: (connect-irc) irc> [ [ irc-disconnected ] dip in-messages>> mailbox-put ] [ dup reconnect-time>> sleep (connect-irc) ] - [ profile>> nickname>> /LOGIN ] + [ nick>> /LOGIN ] tri ; ! FIXME: do something with the exception, store somewhere to help debugging @@ -391,7 +393,7 @@ PRIVATE> : connect-irc ( irc-client -- ) [ irc> - [ (connect-irc) ] [ profile>> nickname>> /LOGIN ] bi + [ (connect-irc) ] [ nick>> /LOGIN ] bi spawn-irc ] with-irc-client ; : add-listener ( irc-listener irc-client -- ) From 6e09d7cb634e7ed2a537e48c8ede4a4541e65cb1 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Thu, 25 Sep 2008 01:05:44 -0300 Subject: [PATCH 002/244] irc.client: Refactor, clean, etc. Stop using a thread for each listener for output messages --- extra/irc/client/client-tests.factor | 73 ++++++---- extra/irc/client/client.factor | 166 +++++++++-------------- extra/irc/messages/messages-tests.factor | 10 ++ extra/irc/messages/messages.factor | 71 +++++----- extra/irc/ui/ui.factor | 14 +- 5 files changed, 159 insertions(+), 175 deletions(-) diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 3554f6c120..acd5a783db 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -28,9 +28,11 @@ M: mb-writer stream-nl ( mb-writer -- ) dup [ spawn-irc yield ] with-irc-client ; ! to be used inside with-irc-client quotations -: %add-named-listener ( listener -- ) [ name>> ] keep set+run-listener ; -: %join ( channel -- ) irc> add-listener ; +: %add-named-listener ( listener -- ) irc> add-listener ; : %push-line ( line -- ) irc> stream>> in>> push-line yield ; +: %join ( channel -- ) + + [ irc> add-listener ] [ join-irc-channel ] bi ; : read-matching-message ( listener quot: ( msg -- ? ) -- irc-message ) [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ; @@ -62,13 +64,28 @@ M: mb-writer stream-nl ( mb-writer -- ) ] unit-test ] with-irc +! Test connect +{ V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [ + "someserver" irc-port "factorbot" f + [ 2drop t ] >>connect + [ connect-irc ] keep stream>> out>> lines>> +] unit-test + +! Test join +[ { "JOIN #factortest" } [ + "#factortest" %join + irc> stream>> out>> lines>> pop + ] unit-test +] with-irc + [ { join_ "#factortest" } [ + "#factortest" [ %add-named-listener ] keep { ":factorbot!n=factorbo@some.where JOIN :#factortest" ":ircserver.net 353 factorbot @ #factortest :@factorbot " ":ircserver.net 366 factorbot #factortest :End of /NAMES list." ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah" } [ %push-line ] each - irc> join-messages>> 0.1 seconds mailbox-get-timeout + in-messages>> 0.1 seconds mailbox-get-timeout [ class ] [ trailing>> ] bi ] unit-test ] with-irc @@ -89,8 +106,8 @@ M: mb-writer stream-nl ( mb-writer -- ) ] with-irc [ { privmsg "factorbot" "hello" } [ - "somedude" [ %add-named-listener ] keep - ":somedude!n=user@isp.net PRIVMSG factorbot :hello" %push-line + "ircuser" [ %add-named-listener ] keep + ":ircuser!n=user@isp.net PRIVMSG factorbot :hello" %push-line [ privmsg? ] read-matching-message [ class ] [ name>> ] [ trailing>> ] tri ] unit-test @@ -104,48 +121,48 @@ M: mb-writer stream-nl ( mb-writer -- ) ] with-irc ! Participant lists tests -[ { H{ { "somedude" +normal+ } } } [ +[ { H{ { "ircuser" +normal+ } } } [ "#factortest" [ %add-named-listener ] keep - ":somedude!n=user@isp.net JOIN :#factortest" %push-line + ":ircuser!n=user@isp.net JOIN :#factortest" %push-line participants>> ] unit-test ] with-irc -[ { H{ { "somedude2" +normal+ } } } [ +[ { H{ { "ircuser2" +normal+ } } } [ "#factortest" - H{ { "somedude2" +normal+ } - { "somedude" +normal+ } } clone >>participants + H{ { "ircuser2" +normal+ } + { "ircuser" +normal+ } } clone >>participants [ %add-named-listener ] keep - ":somedude!n=user@isp.net PART #factortest" %push-line + ":ircuser!n=user@isp.net PART #factortest" %push-line participants>> ] unit-test ] with-irc -[ { H{ { "somedude2" +normal+ } } } [ +[ { H{ { "ircuser2" +normal+ } } } [ "#factortest" - H{ { "somedude2" +normal+ } - { "somedude" +normal+ } } clone >>participants + H{ { "ircuser2" +normal+ } + { "ircuser" +normal+ } } clone >>participants [ %add-named-listener ] keep - ":somedude!n=user@isp.net QUIT" %push-line + ":ircuser!n=user@isp.net QUIT" %push-line participants>> ] unit-test ] with-irc -[ { H{ { "somedude2" +normal+ } } } [ +[ { H{ { "ircuser2" +normal+ } } } [ "#factortest" - H{ { "somedude2" +normal+ } - { "somedude" +normal+ } } clone >>participants + H{ { "ircuser2" +normal+ } + { "ircuser" +normal+ } } clone >>participants [ %add-named-listener ] keep - ":somedude2!n=user2@isp.net KICK #factortest somedude" %push-line + ":ircuser2!n=user2@isp.net KICK #factortest ircuser" %push-line participants>> ] unit-test ] with-irc -[ { H{ { "somedude2" +normal+ } } } [ +[ { H{ { "ircuser2" +normal+ } } } [ "#factortest" - H{ { "somedude" +normal+ } } clone >>participants + H{ { "ircuser" +normal+ } } clone >>participants [ %add-named-listener ] keep - ":somedude!n=user2@isp.net NICK :somedude2" %push-line + ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line participants>> ] unit-test ] with-irc @@ -159,20 +176,20 @@ M: mb-writer stream-nl ( mb-writer -- ) ] unit-test ] with-irc -[ { T{ participant-changed f "somedude" +part+ f } } [ +[ { T{ participant-changed f "ircuser" +part+ f } } [ "#factortest" - H{ { "somedude" +normal+ } } clone >>participants + H{ { "ircuser" +normal+ } } clone >>participants [ %add-named-listener ] keep - ":somedude!n=user@isp.net QUIT" %push-line + ":ircuser!n=user@isp.net QUIT" %push-line [ participant-changed? ] read-matching-message ] unit-test ] with-irc -[ { T{ participant-changed f "somedude" +nick+ "somedude2" } } [ +[ { T{ participant-changed f "ircuser" +nick+ "ircuser2" } } [ "#factortest" - H{ { "somedude" +normal+ } } clone >>participants + H{ { "ircuser" +normal+ } } clone >>participants [ %add-named-listener ] keep - ":somedude!n=user2@isp.net NICK :somedude2" %push-line + ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line [ participant-changed? ] read-matching-message ] unit-test ] with-irc diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index b6eeec9468..ca16ff3b88 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -17,13 +17,13 @@ IN: irc.client TUPLE: irc-profile server port nickname password ; C: irc-profile -TUPLE: irc-client profile stream in-messages out-messages join-messages +TUPLE: irc-client profile stream in-messages out-messages listeners is-running nick connect reconnect-time ; : ( profile -- irc-client ) - [ f H{ } clone f ] keep nickname>> + [ f H{ } clone f ] keep nickname>> [ latin1 ] 15 seconds irc-client boa ; -TUPLE: irc-listener in-messages out-messages ; +TUPLE: irc-listener in-messages client ; TUPLE: irc-server-listener < irc-listener ; TUPLE: irc-channel-listener < irc-listener name password timeout participants ; TUPLE: irc-nick-listener < irc-listener name ; @@ -47,14 +47,14 @@ SYMBOL: +nick+ : ( -- irc-listener ) irc-listener boa ; : ( -- irc-server-listener ) - irc-server-listener boa ; + f irc-server-listener boa ; : ( name -- irc-channel-listener ) - [ ] dip f 60 seconds H{ } clone + [ f ] dip f 60 seconds H{ } clone irc-channel-listener boa ; : ( name -- irc-nick-listener ) - [ ] dip irc-nick-listener boa ; + [ f ] dip irc-nick-listener boa ; ! ====================================== ! Message objects @@ -68,19 +68,11 @@ SINGLETON: irc-end ! sent when the client isn't running anymore SINGLETON: irc-disconnected ! sent when connection is lost SINGLETON: irc-connected ! sent when connection is established -> values [ out-messages>> ] map ] - [ in-messages>> ] - [ out-messages>> ] tri 2array prepend - [ irc-end swap mailbox-put ] each ; -PRIVATE> - : terminate-irc ( irc-client -- ) [ is-running>> ] keep and [ - [ end-loops ] - [ [ f ] dip (>>is-running) ] - bi + f >>is-running + [ in-messages>> ] [ out-messages>> ] bi 2array + [ irc-end swap mailbox-put ] each ] when* ; [ +server-listener+ listener> ] unless* [ to-listener ] [ drop ] if* ; -M: irc-listener to-listener ( message irc-listener -- ) - in-messages>> mailbox-put ; +M: irc-listener to-listener in-messages>> mailbox-put ; : unregister-listener ( name -- ) irc> listeners>> @@ -156,10 +147,6 @@ M: irc-listener to-listener ( message irc-listener -- ) DEFER: me? -: maybe-forward-join ( join -- ) - [ irc-message-sender me? ] keep and - [ irc> join-messages>> mailbox-put ] when* ; - ! ====================================== ! IRC client messages ! ====================================== @@ -187,63 +174,50 @@ DEFER: me? ! ====================================== GENERIC: forward-name ( irc-message -- name ) -M: join forward-name ( join -- name ) trailing>> ; -M: part forward-name ( part -- name ) channel>> ; -M: kick forward-name ( kick -- name ) channel>> ; -M: mode forward-name ( mode -- name ) name>> ; -M: privmsg forward-name ( privmsg -- name ) - dup name>> me? [ irc-message-sender ] [ name>> ] if ; +M: join forward-name trailing>> ; +M: part forward-name channel>> ; +M: kick forward-name channel>> ; +M: mode forward-name name>> ; +M: privmsg forward-name dup name>> me? [ irc-message-sender ] [ name>> ] if ; UNION: single-forward join part kick mode privmsg ; UNION: multiple-forward nick quit ; UNION: broadcast-forward irc-end irc-disconnected irc-connected ; GENERIC: forward-message ( irc-message -- ) -M: irc-message forward-message ( irc-message -- ) +M: irc-message forward-message +server-listener+ listener> [ to-listener ] [ drop ] if* ; -M: single-forward forward-message ( forward-single -- ) - dup forward-name to-listener ; +M: single-forward forward-message dup forward-name to-listener ; -M: multiple-forward forward-message ( multiple-forward -- ) +M: multiple-forward forward-message dup irc-message-sender to-listeners-with-participant ; - -M: join forward-message ( join -- ) - [ maybe-forward-join ] [ call-next-method ] bi ; - -M: broadcast-forward forward-message ( irc-broadcasted-message -- ) + +M: broadcast-forward forward-message irc> listeners>> values [ to-listener ] with each ; GENERIC: process-message ( irc-message -- ) +M: object process-message drop ; +M: logged-in process-message name>> irc> (>>nick) ; +M: ping process-message trailing>> /PONG ; +M: nick-in-use process-message name>> "_" append /NICK ; -M: object process-message ( object -- ) - drop ; - -M: logged-in process-message ( logged-in -- ) - name>> irc> (>>nick) ; - -M: ping process-message ( ping -- ) - trailing>> /PONG ; - -M: nick-in-use process-message ( nick-in-use -- ) - name>> "_" append /NICK ; - -M: join process-message ( join -- ) +M: join process-message [ drop +normal+ ] [ irc-message-sender ] [ trailing>> ] tri dup listener> [ add-participant ] [ 3drop ] if ; -M: part process-message ( part -- ) +M: part process-message [ irc-message-sender ] [ channel>> ] bi remove-participant ; -M: kick process-message ( kick -- ) +M: kick process-message [ [ who>> ] [ channel>> ] bi remove-participant ] [ dup who>> me? [ unregister-listener ] [ drop ] if ] bi ; -M: quit process-message ( quit -- ) +M: quit process-message irc-message-sender remove-participant-from-all ; -M: nick process-message ( nick -- ) +M: nick process-message [ irc-message-sender ] [ trailing>> ] bi rename-participant-in-all ; ! M: mode process-message ( mode -- ) @@ -259,7 +233,7 @@ M: nick process-message ( nick -- ) trailing>> [ blank? ] trim " " split [ >nick/mode 2array ] map >hashtable ; -M: names-reply process-message ( names-reply -- ) +M: names-reply process-message [ names-reply>participants ] [ channel>> listener> ] bi [ [ (>>participants) ] [ [ f f f ] dip name>> to-listener ] bi @@ -270,9 +244,8 @@ M: names-reply process-message ( names-reply -- ) ! ====================================== GENERIC: handle-outgoing-irc ( irc-message -- ? ) -M: irc-end handle-outgoing-irc ( irc-end -- ? ) drop f ; -M: irc-message handle-outgoing-irc ( irc-message -- ? ) - irc-message>client-line irc-print t ; +M: irc-end handle-outgoing-irc drop f ; +M: irc-message handle-outgoing-irc irc-message>client-line irc-print t ; ! ====================================== ! Reader/Writer @@ -326,16 +299,11 @@ DEFER: (connect-irc) [ nip ] } cond ; -GENERIC: handle-listener-out ( irc-message -- ? ) -M: irc-end handle-listener-out ( irc-end -- ? ) drop f ; -M: irc-message handle-listener-out ( irc-message -- ? ) - irc> out-messages>> mailbox-put t ; - -: listener-loop ( name -- ? ) - dup listener> [ - out-messages>> mailbox-get - maybe-annotate-with-name handle-listener-out - ] [ drop f ] if* ; +GENERIC: annotate-message ( listener object -- object ) +M: object annotate-message nip ; +M: part annotate-message swap name>> >>channel ; +M: privmsg annotate-message swap name>> >>name ; +M: string annotate-message [ name>> ] dip strings>privmsg ; : spawn-irc ( -- ) [ reader-loop ] "irc-reader-loop" spawn-server @@ -343,48 +311,33 @@ M: irc-message handle-listener-out ( irc-message -- ? ) [ in-multiplexer-loop ] "in-multiplexer-loop" spawn-server 3drop ; -! ====================================== -! Listener join request handling -! ====================================== - -: set+run-listener ( name irc-listener -- ) - over irc> listeners>> set-at - '[ _ listener-loop ] "irc-listener-loop" spawn-server drop ; - GENERIC: (add-listener) ( irc-listener -- ) -M: irc-channel-listener (add-listener) ( irc-channel-listener -- ) - [ [ name>> ] [ password>> ] bi /JOIN ] - [ [ [ drop irc> join-messages>> ] - [ timeout>> ] - [ name>> '[ trailing>> _ = ] ] - tri mailbox-get-timeout? trailing>> ] keep set+run-listener - ] bi ; +M: irc-listener (add-listener) + [ irc> >>client ] [ name>> ] bi irc> listeners>> set-at ; -M: irc-nick-listener (add-listener) ( irc-nick-listener -- ) - [ name>> ] keep set+run-listener ; - -M: irc-server-listener (add-listener) ( irc-server-listener -- ) - [ +server-listener+ ] dip set+run-listener ; +M: irc-server-listener (add-listener) + irc> >>client +server-listener+ irc> listeners>> set-at ; GENERIC: (remove-listener) ( irc-listener -- ) -M: irc-nick-listener (remove-listener) ( irc-nick-listener -- ) +M: irc-nick-listener (remove-listener) name>> unregister-listener ; -M: irc-channel-listener (remove-listener) ( irc-channel-listener -- ) - [ [ name>> ] [ out-messages>> ] bi - [ [ part new ] dip >>channel ] dip mailbox-put ] keep +M: irc-channel-listener (remove-listener) + [ part new annotate-message irc> out-messages>> mailbox-put ] keep name>> unregister-listener ; -M: irc-server-listener (remove-listener) ( irc-server-listener -- ) +M: irc-server-listener (remove-listener) drop +server-listener+ unregister-listener ; : (connect-irc) ( irc-client -- ) - [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] keep - swap >>stream - t >>is-running - in-messages>> [ irc-connected ] dip mailbox-put ; + { + [ profile>> [ server>> ] [ port>> ] bi /CONNECT ] + [ (>>stream) ] + [ t swap (>>is-running) ] + [ in-messages>> [ irc-connected ] dip mailbox-put ] + } cleave ; : with-irc-client ( irc-client quot: ( -- ) -- ) [ \ current-irc-client ] dip with-variable ; inline @@ -392,15 +345,18 @@ M: irc-server-listener (remove-listener) ( irc-server-listener -- ) PRIVATE> : connect-irc ( irc-client -- ) - [ irc> - [ (connect-irc) ] [ nick>> /LOGIN ] bi - spawn-irc ] with-irc-client ; + dup [ [ (connect-irc) ] [ nick>> /LOGIN ] bi spawn-irc ] with-irc-client ; : add-listener ( irc-listener irc-client -- ) swap '[ _ (add-listener) ] with-irc-client ; -: remove-listener ( irc-listener irc-client -- ) - swap '[ _ (remove-listener) ] with-irc-client ; +: remove-listener ( irc-listener -- ) + [ client>> ] keep '[ _ (remove-listener) ] with-irc-client ; + +: join-irc-channel ( irc-channel-listener -- ) + dup client>> [ [ name>> ] [ password>> ] bi /JOIN ] with-irc-client ; + +: write-message ( message irc-listener -- ) + [ swap annotate-message ] [ client>> out-messages>> mailbox-put ] bi ; -: write-message ( message irc-listener -- ) out-messages>> mailbox-put ; : read-message ( irc-listener -- message ) in-messages>> mailbox-get ; diff --git a/extra/irc/messages/messages-tests.factor b/extra/irc/messages/messages-tests.factor index b61dd16448..41272a43f2 100644 --- a/extra/irc/messages/messages-tests.factor +++ b/extra/irc/messages/messages-tests.factor @@ -62,4 +62,14 @@ IN: irc.messages.tests { parameters { } } { trailing "someuser2" } } } [ ":someuser!n=user@some.where NICK :someuser2" + parse-irc-line f >>timestamp ] unit-test + +{ T{ nick-in-use + { line ":ircserver.net 433 * nickname :Nickname is already in use" } + { prefix "ircserver.net" } + { command "433" } + { parameters { "*" "nickname" } } + { name "nickname" } + { trailing "Nickname is already in use" } } } +[ ":ircserver.net 433 * nickname :Nickname is already in use" parse-irc-line f >>timestamp ] unit-test \ No newline at end of file diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 9201f822da..882cec5c8d 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -17,7 +17,7 @@ TUPLE: nick < irc-message ; TUPLE: privmsg < irc-message name ; TUPLE: kick < irc-message channel who ; TUPLE: roomlist < irc-message channel names ; -TUPLE: nick-in-use < irc-message asterisk name ; +TUPLE: nick-in-use < irc-message name ; TUPLE: notice < irc-message type ; TUPLE: mode < irc-message name mode parameter ; TUPLE: names-reply < irc-message who channel ; @@ -31,45 +31,43 @@ TUPLE: unhandled < irc-message ; GENERIC: command-string>> ( irc-message -- string ) -M: irc-message command-string>> ( irc-message -- string ) command>> ; -M: ping command-string>> ( ping -- string ) drop "PING" ; -M: join command-string>> ( join -- string ) drop "JOIN" ; -M: part command-string>> ( part -- string ) drop "PART" ; -M: quit command-string>> ( quit -- string ) drop "QUIT" ; -M: nick command-string>> ( nick -- string ) drop "NICK" ; -M: privmsg command-string>> ( privmsg -- string ) drop "PRIVMSG" ; -M: notice command-string>> ( notice -- string ) drop "NOTICE" ; -M: mode command-string>> ( mode -- string ) drop "MODE" ; -M: kick command-string>> ( kick -- string ) drop "KICK" ; +M: irc-message command-string>> command>> ; +M: ping command-string>> drop "PING" ; +M: join command-string>> drop "JOIN" ; +M: part command-string>> drop "PART" ; +M: quit command-string>> drop "QUIT" ; +M: nick command-string>> drop "NICK" ; +M: privmsg command-string>> drop "PRIVMSG" ; +M: notice command-string>> drop "NOTICE" ; +M: mode command-string>> drop "MODE" ; +M: kick command-string>> drop "KICK" ; GENERIC: command-parameters>> ( irc-message -- seq ) -M: irc-message command-parameters>> ( irc-message -- seq ) parameters>> ; -M: ping command-parameters>> ( ping -- seq ) drop { } ; -M: join command-parameters>> ( join -- seq ) drop { } ; -M: part command-parameters>> ( part -- seq ) channel>> 1array ; -M: quit command-parameters>> ( quit -- seq ) drop { } ; -M: nick command-parameters>> ( nick -- seq ) drop { } ; -M: privmsg command-parameters>> ( privmsg -- seq ) name>> 1array ; -M: notice command-parameters>> ( norice -- seq ) type>> 1array ; -M: kick command-parameters>> ( kick -- seq ) - [ channel>> ] [ who>> ] bi 2array ; -M: mode command-parameters>> ( mode -- seq ) - [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; +M: irc-message command-parameters>> parameters>> ; +M: ping command-parameters>> drop { } ; +M: join command-parameters>> drop { } ; +M: part command-parameters>> channel>> 1array ; +M: quit command-parameters>> drop { } ; +M: nick command-parameters>> drop { } ; +M: privmsg command-parameters>> name>> 1array ; +M: notice command-parameters>> type>> 1array ; +M: kick command-parameters>> [ channel>> ] [ who>> ] bi 2array ; +M: mode command-parameters>> [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; GENERIC: (>>command-parameters) ( params irc-message -- ) -M: irc-message (>>command-parameters) ( params irc-message -- ) 2drop ; -M: logged-in (>>command-parameters) ( params part -- ) [ first ] dip (>>name) ; -M: privmsg (>>command-parameters) ( params privmsg -- ) [ first ] dip (>>name) ; -M: notice (>>command-parameters) ( params notice -- ) [ first ] dip (>>type) ; -M: part (>>command-parameters) ( params part -- ) - [ first ] dip (>>channel) ; -M: kick (>>command-parameters) ( params kick -- ) +M: irc-message (>>command-parameters) 2drop ; +M: logged-in (>>command-parameters) [ first ] dip (>>name) ; +M: privmsg (>>command-parameters) [ first ] dip (>>name) ; +M: notice (>>command-parameters) [ first ] dip (>>type) ; +M: part (>>command-parameters) [ first ] dip (>>channel) ; +M: nick-in-use (>>command-parameters) [ second ] dip (>>name) ; +M: kick (>>command-parameters) [ first2 ] dip [ (>>who) ] [ (>>channel) ] bi ; -M: names-reply (>>command-parameters) ( params names-reply -- ) +M: names-reply (>>command-parameters) [ [ first ] dip (>>who) ] [ [ third ] dip (>>channel) ] 2bi ; -M: mode (>>command-parameters) ( params mode -- ) +M: mode (>>command-parameters) { { [ >r 2array r> ] [ [ (>>mode) ] [ (>>name) ] bi ] } { [ >r 3array r> ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] } } switch ; @@ -78,16 +76,14 @@ PRIVATE> GENERIC: irc-message>client-line ( irc-message -- string ) -M: irc-message irc-message>client-line ( irc-message -- string ) +M: irc-message irc-message>client-line [ command-string>> ] [ command-parameters>> " " sjoin ] [ trailing>> [ CHAR: : prefix ] [ "" ] if* ] tri 3array " " sjoin ; GENERIC: irc-message>server-line ( irc-message -- string ) - -M: irc-message irc-message>server-line ( irc-message -- string ) - drop "not implemented yet" ; +M: irc-message irc-message>server-line drop "not implemented yet" ; UNION: sender-in-prefix privmsg join part quit kick mode nick ; GENERIC: irc-message-sender ( irc-message -- sender ) -M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender ) - prefix>> parse-name ; +M: sender-in-prefix irc-message-sender prefix>> parse-name ; : string>irc-message ( string -- object ) dup split-prefix split-trailing diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 1e4bcf35f8..c171fef0b6 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -182,11 +182,16 @@ irc-editor "general" f { [ @center grid-add ] keep @bottom grid-add ; +GENERIC: init-listener ( listener -- ) +M: object init-listener drop ; +M: irc-channel-listener init-listener join-irc-channel ; + M: irc-tab graft* - [ listener>> ] [ window>> client>> ] bi add-listener ; + [ listener>> dup ] [ window>> client>> ] bi add-listener + init-listener ; M: irc-tab ungraft* - [ listener>> ] [ window>> client>> ] bi remove-listener ; + listener>> remove-listener ; TUPLE: irc-channel-tab < irc-tab userlist ; @@ -239,8 +244,9 @@ M: irc-tab pref-dim* [ connect-irc ] } cleave ; : server-open ( server port nick password channels -- ) - [ ui-connect [ irc-window ] keep ] dip - [ over join-channel ] each drop ; + [ ui-connect [ irc-window ] keep ] dip 2drop ; +! FIXME: should join channels only after we have been logged in +! [ over join-channel ] each drop ; : main-run ( -- ) run-ircui ; From 177abec11efaca3eec84a0a0df3a5efbf5a5d9b1 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 30 Sep 2008 03:00:48 -0300 Subject: [PATCH 003/244] irc.client: Fix listeners-with-participant --- extra/irc/client/client.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index ca16ff3b88..606a8206da 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -67,6 +67,7 @@ SINGLETON: irc-listener-end ! send to a listener to stop its execution SINGLETON: irc-end ! sent when the client isn't running anymore SINGLETON: irc-disconnected ! sent when connection is lost SINGLETON: irc-connected ! sent when connection is established +SINGLETON: irc-ready ! sent after the client is logged in : terminate-irc ( irc-client -- ) [ is-running>> ] keep and [ @@ -115,7 +116,7 @@ M: irc-listener to-listener in-messages>> mailbox-put ; : listeners-with-participant ( nick -- seq ) irc> listeners>> values - [ [ irc-channel-listener? ] keep and [ participants>> key? ] when* ] + [ [ irc-channel-listener? ] keep and [ participants>> key? ] [ drop f ] if* ] with filter ; : to-listeners-with-participant ( message nickname -- ) From f12357e4e1cf21e11faaf216054b3244f5235394 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 30 Sep 2008 03:11:54 -0300 Subject: [PATCH 004/244] irc.client: Fix docs --- extra/irc/client/client-docs.factor | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/extra/irc/client/client-docs.factor b/extra/irc/client/client-docs.factor index 6bb6a6328e..d150e6d36f 100644 --- a/extra/irc/client/client-docs.factor +++ b/extra/irc/client/client-docs.factor @@ -1,20 +1,15 @@ USING: help.markup help.syntax quotations kernel irc.messages ; IN: irc.client -HELP: irc-client "IRC Client object" -"blah" ; +HELP: irc-client "IRC Client object" ; -HELP: irc-server-listener "Listener for server messages unmanaged by other listeners" -"blah" ; +HELP: irc-server-listener "Listener for server messages unmanaged by other listeners" ; -HELP: irc-channel-listener "Listener for irc channels" -"blah" ; +HELP: irc-channel-listener "Listener for irc channels" ; -HELP: irc-nick-listener "Listener for irc users" -"blah" ; +HELP: irc-nick-listener "Listener for irc users" ; -HELP: irc-profile "IRC Client profile object" -"blah" ; +HELP: irc-profile "IRC Client profile object" ; HELP: connect-irc "Connecting to an irc server" { $values { "irc-client" "an irc client object" } } @@ -24,6 +19,10 @@ HELP: add-listener "Listening to irc channels/users/etc" { $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } } { $description "Registers " { $snippet "irc-listener" } " with " { $snippet "irc-client" } " and starts listening." } ; +HELP: join-irc-channel "Joining channels" +{ $values { "irc-client-listener" "an irc client listener object" } } +{ $description "Joins to the channel being listened by " { $snippet "irc-listener" } "." } ; + HELP: remove-listener "Stop an unregister listener" { $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } } { $description "Unregisters " { $snippet "irc-listener" } " from " { $snippet "irc-client" } " and stops listening. This is how you part from a channel." } ; @@ -55,6 +54,7 @@ ARTICLE: "irc.client" "IRC Client" { $subsection terminate-irc } { $subsection add-listener } { $subsection remove-listener } +{ $subsection join-irc-channel } { $subsection read-message } { $subsection write-message } { $heading "IRC messages" } @@ -77,13 +77,14 @@ ARTICLE: "irc.client" "IRC Client" { $heading "Special messages" } "Some special messages that are created by the library and not by the irc server." { $table - { { $link irc-end } " sent when the client isn't running anymore, listeners should stop after this." } + { { $link irc-listener-end } "sent to a listener when it has been dettached from the client, the listener should stop after it receives this message. " } + { { $link irc-end } " sent when the client isn't running anymore, listeners should stop after it receives this message." } { { $link irc-disconnected } " sent to notify listeners that connection was lost." } { { $link irc-connected } " sent to notify listeners that a connection with the irc server was established." } } { $heading "Example:" } { $code - "USING: irc.client concurrency.mailboxes ;" + "USING: irc.client ;" "SYMBOL: bot" "SYMBOL: mychannel" "! Create the profile and client objects" @@ -94,6 +95,8 @@ ARTICLE: "irc.client" "IRC Client" "\"#mychannel123\" mychannel set" "! Register and start listener (this joins the channel)" "mychannel get bot get add-listener" + "! Join to the channel" + "mychannel get join-irc-channel" "! Send a message to the channel" "\"what's up?\" mychannel get write-message" "! Read a message from the channel" From 1ff9d3f304688d917967199e03720116a5634701 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Sep 2008 12:47:46 -0500 Subject: [PATCH 005/244] fixed taxes --- extra/taxes/usa/federal/federal.factor | 47 +++++++++ extra/taxes/usa/fica/fica.factor | 17 ++++ extra/taxes/usa/futa/futa.factor | 15 +++ extra/taxes/usa/medicare/medicare.factor | 8 ++ extra/taxes/usa/mn/mn.factor | 33 +++++++ extra/taxes/usa/usa-tests.factor | 118 +++++++++++++++++++++++ extra/taxes/usa/usa.factor | 41 ++++++++ extra/taxes/usa/w4/w4.factor | 13 +++ extra/taxes/utils/utils.factor | 10 ++ 9 files changed, 302 insertions(+) create mode 100644 extra/taxes/usa/federal/federal.factor create mode 100644 extra/taxes/usa/fica/fica.factor create mode 100644 extra/taxes/usa/futa/futa.factor create mode 100644 extra/taxes/usa/medicare/medicare.factor create mode 100644 extra/taxes/usa/mn/mn.factor create mode 100644 extra/taxes/usa/usa-tests.factor create mode 100644 extra/taxes/usa/usa.factor create mode 100644 extra/taxes/usa/w4/w4.factor create mode 100644 extra/taxes/utils/utils.factor diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor new file mode 100644 index 0000000000..91d22ee828 --- /dev/null +++ b/extra/taxes/usa/federal/federal.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences combinators.lib money math.order +taxes.usa.fica taxes.usa.medicare taxes.usa taxes.usa.w4 ; +IN: taxes.usa.federal + +! http://www.irs.gov/pub/irs-pdf/p15.pdf +! Table 7 ANNUAL Payroll Period + +: federal-single ( -- triples ) + { + { 0 2650 DECIMAL: 0 } + { 2650 10300 DECIMAL: .10 } + { 10300 33960 DECIMAL: .15 } + { 33960 79725 DECIMAL: .25 } + { 79725 166500 DECIMAL: .28 } + { 166500 359650 DECIMAL: .33 } + { 359650 1/0. DECIMAL: .35 } + } ; + +: federal-married ( -- triples ) + { + { 0 8000 DECIMAL: 0 } + { 8000 23550 DECIMAL: .10 } + { 23550 72150 DECIMAL: .15 } + { 72150 137850 DECIMAL: .25 } + { 137850 207700 DECIMAL: .28 } + { 207700 365100 DECIMAL: .33 } + { 365100 1/0. DECIMAL: .35 } + } ; + +SINGLETON: federal +: ( -- obj ) + federal federal-single federal-married ; + +: federal-tax ( salary w4 tax-table -- n ) + [ adjust-allowances ] 2keep marriage-table tax ; + +M: federal adjust-allowances* ( salary w4 collector entity -- newsalary ) + 2drop calculate-w4-allowances - ; + +M: federal withholding* ( salary w4 tax-table entity -- x ) + drop + [ federal-tax ] 3keep drop + [ fica-tax ] 2keep + medicare-tax + + ; diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor new file mode 100644 index 0000000000..69a62753f2 --- /dev/null +++ b/extra/taxes/usa/fica/fica.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors math math.order assocs.lib money ; +IN: taxes.usa.fica + +: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline + +ERROR: fica-base-unknown year ; + +: fica-base-rate ( year -- x ) + H{ + { 2008 102000 } + { 2007 97500 } + } [ fica-base-unknown ] unless-at ; + +: fica-tax ( salary w4 -- x ) + year>> fica-base-rate min fica-tax-rate * ; diff --git a/extra/taxes/usa/futa/futa.factor b/extra/taxes/usa/futa/futa.factor new file mode 100644 index 0000000000..36d3097007 --- /dev/null +++ b/extra/taxes/usa/futa/futa.factor @@ -0,0 +1,15 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences combinators.lib money math.order ; +IN: taxes.usa.futa + +! Employer tax only, not withheld +: futa-tax-rate ( -- x ) DECIMAL: .062 ; inline +: futa-base-rate ( -- x ) 7000 ; inline +: futa-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline + +: futa-tax ( salary w4 -- x ) + drop futa-base-rate min + futa-tax-rate futa-tax-offset-credit - + * ; diff --git a/extra/taxes/usa/medicare/medicare.factor b/extra/taxes/usa/medicare/medicare.factor new file mode 100644 index 0000000000..ea95224456 --- /dev/null +++ b/extra/taxes/usa/medicare/medicare.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math money ; +IN: taxes.usa.medicare + +! No base rate for medicare; all wages subject +: medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline +: medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ; diff --git a/extra/taxes/usa/mn/mn.factor b/extra/taxes/usa/mn/mn.factor new file mode 100644 index 0000000000..8bb629efcd --- /dev/null +++ b/extra/taxes/usa/mn/mn.factor @@ -0,0 +1,33 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences money math.order usa-cities +taxes.usa taxes.usa.w4 ; +IN: taxes.usa.mn + +! Minnesota +: mn-single ( -- triples ) + { + { 0 1950 DECIMAL: 0 } + { 1950 23750 DECIMAL: .0535 } + { 23750 73540 DECIMAL: .0705 } + { 73540 1/0. DECIMAL: .0785 } + } ; + +: mn-married ( -- triples ) + { + { 0 7400 DECIMAL: 0 } + { 7400 39260 DECIMAL: .0535 } + { 39260 133980 DECIMAL: .0705 } + { 133980 1/0. DECIMAL: .0785 } + } ; + +: ( -- obj ) + MN mn-single mn-married ; + +M: MN adjust-allowances* ( salary w4 collector entity -- newsalary ) + 2drop calculate-w4-allowances - ; + +M: MN withholding* ( salary w4 collector entity -- x ) + drop + [ adjust-allowances ] 2keep marriage-table tax ; diff --git a/extra/taxes/usa/usa-tests.factor b/extra/taxes/usa/usa-tests.factor new file mode 100644 index 0000000000..6aac4b928c --- /dev/null +++ b/extra/taxes/usa/usa-tests.factor @@ -0,0 +1,118 @@ +USING: kernel money tools.test +taxes.usa taxes.usa.federal taxes.usa.mn +taxes.utils taxes.usa.w4 usa-cities ; +IN: taxes.usa.tests + +[ + 426 23 +] [ + 12000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 426 23 +] [ + 12000 2008 3 t net biweekly + dollars/cents +] unit-test + +[ + 684 4 +] [ + 20000 2008 3 f net biweekly + dollars/cents +] unit-test + + + +[ + 804 58 +] [ + 24000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 831 31 +] [ + 24000 2008 3 t net biweekly + dollars/cents +] unit-test + + +[ + 780 81 +] [ + 24000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 818 76 +] [ + 24000 2008 3 t net biweekly + dollars/cents +] unit-test + + +[ + 2124 39 +] [ + 78250 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 2321 76 +] [ + 78250 2008 3 t net biweekly + dollars/cents +] unit-test + + +[ + 2612 63 +] [ + 100000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 22244 52 +] [ + 1000000 2008 3 f net biweekly + dollars/cents +] unit-test + +[ + 578357 40 +] [ + 1000000 2008 3 f net + dollars/cents +] unit-test + +[ + 588325 41 +] [ + 1000000 2008 3 t net + dollars/cents +] unit-test + + +[ 30 97 ] [ + 24000 2008 2 f MN withholding* biweekly dollars/cents +] unit-test + +[ 173 66 ] [ + 78250 2008 2 f MN withholding* biweekly dollars/cents +] unit-test + + +[ 138 69 ] [ + 24000 2008 2 f withholding biweekly dollars/cents +] unit-test + +[ 754 72 ] [ + 78250 2008 2 f withholding biweekly dollars/cents +] unit-test diff --git a/extra/taxes/usa/usa.factor b/extra/taxes/usa/usa.factor new file mode 100644 index 0000000000..1d21524b45 --- /dev/null +++ b/extra/taxes/usa/usa.factor @@ -0,0 +1,41 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays assocs kernel math math.intervals +namespaces sequences money math.order taxes.usa.w4 +taxes.usa.federal ; +IN: taxes.usa + +! Withhold: FICA, Medicare, Federal (FICA is social security) + +TUPLE: tax-table entity single married ; +C: tax-table + +GENERIC: adjust-allowances* ( salary w4 tax-table entity -- newsalary ) +GENERIC: withholding* ( salary w4 tax-table entity -- x ) + +: adjust-allowances ( salary w4 tax-table -- newsalary ) + dup entity>> adjust-allowances* ; + +: withholding ( salary w4 tax-table -- x ) + dup entity>> federal = [ + dup entity>> withholding* + ] [ + [ dup entity>> withholding* ] + [ drop federal withholding* ] 3bi + + ] if ; + +: tax-bracket-range ( pair -- n ) first2 swap - ; + +: tax-bracket ( tax salary triples -- tax salary ) + [ [ tax-bracket-range min ] keep third * + ] 2keep + tax-bracket-range [-] ; + +: tax ( salary triples -- x ) + 0 -rot [ tax-bracket ] each drop ; + +: marriage-table ( w4 tax-table -- triples ) + swap married?>> + [ married>> ] [ single>> ] if ; + +: net ( salary w4 collector -- x ) + >r dupd r> withholding - ; diff --git a/extra/taxes/usa/w4/w4.factor b/extra/taxes/usa/w4/w4.factor new file mode 100644 index 0000000000..aad3773220 --- /dev/null +++ b/extra/taxes/usa/w4/w4.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors kernel math ; +IN: taxes.usa.w4 + +! Each employee fills out a w4 +TUPLE: w4 year allowances married? ; +C: w4 + +: allowance ( -- x ) 3500 ; inline + +: calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ; + diff --git a/extra/taxes/utils/utils.factor b/extra/taxes/utils/utils.factor new file mode 100644 index 0000000000..a5c2240625 --- /dev/null +++ b/extra/taxes/utils/utils.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: math ; +IN: taxes.utils + +: monthly ( x -- y ) 12 / ; +: semimonthly ( x -- y ) 24 / ; +: biweekly ( x -- y ) 26 / ; +: weekly ( x -- y ) 52 / ; +: daily ( x -- y ) 360 / ; From cb8e58ba0d7c39869e9373010439b5075a5480f0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Sep 2008 12:48:22 -0500 Subject: [PATCH 006/244] remove old taxes --- unmaintained/taxes/authors.txt | 1 - unmaintained/taxes/summary.txt | 1 - unmaintained/taxes/tags.txt | 1 - unmaintained/taxes/taxes-tests.factor | 116 --------------------- unmaintained/taxes/taxes.factor | 145 -------------------------- 5 files changed, 264 deletions(-) delete mode 100644 unmaintained/taxes/authors.txt delete mode 100644 unmaintained/taxes/summary.txt delete mode 100644 unmaintained/taxes/tags.txt delete mode 100644 unmaintained/taxes/taxes-tests.factor delete mode 100644 unmaintained/taxes/taxes.factor diff --git a/unmaintained/taxes/authors.txt b/unmaintained/taxes/authors.txt deleted file mode 100644 index 7c1b2f2279..0000000000 --- a/unmaintained/taxes/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/taxes/summary.txt b/unmaintained/taxes/summary.txt deleted file mode 100644 index e983139ccb..0000000000 --- a/unmaintained/taxes/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Calculate federal and state tax withholdings diff --git a/unmaintained/taxes/tags.txt b/unmaintained/taxes/tags.txt deleted file mode 100644 index 2964ef21b1..0000000000 --- a/unmaintained/taxes/tags.txt +++ /dev/null @@ -1 +0,0 @@ -taxes diff --git a/unmaintained/taxes/taxes-tests.factor b/unmaintained/taxes/taxes-tests.factor deleted file mode 100644 index 17d1998f67..0000000000 --- a/unmaintained/taxes/taxes-tests.factor +++ /dev/null @@ -1,116 +0,0 @@ -USING: kernel money taxes tools.test ; -IN: taxes.tests - -[ - 426 23 -] [ - 12000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 426 23 -] [ - 12000 2008 3 t net biweekly - dollars/cents -] unit-test - -[ - 684 4 -] [ - 20000 2008 3 f net biweekly - dollars/cents -] unit-test - - - -[ - 804 58 -] [ - 24000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 831 31 -] [ - 24000 2008 3 t net biweekly - dollars/cents -] unit-test - - -[ - 780 81 -] [ - 24000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 818 76 -] [ - 24000 2008 3 t net biweekly - dollars/cents -] unit-test - - -[ - 2124 39 -] [ - 78250 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 2321 76 -] [ - 78250 2008 3 t net biweekly - dollars/cents -] unit-test - - -[ - 2612 63 -] [ - 100000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 22244 52 -] [ - 1000000 2008 3 f net biweekly - dollars/cents -] unit-test - -[ - 578357 40 -] [ - 1000000 2008 3 f net - dollars/cents -] unit-test - -[ - 588325 41 -] [ - 1000000 2008 3 t net - dollars/cents -] unit-test - - -[ 30 97 ] [ - 24000 2008 2 f withholding biweekly dollars/cents -] unit-test - -[ 173 66 ] [ - 78250 2008 2 f withholding biweekly dollars/cents -] unit-test - - -[ 138 69 ] [ - 24000 2008 2 f withholding biweekly dollars/cents -] unit-test - -[ 754 72 ] [ - 78250 2008 2 f withholding biweekly dollars/cents -] unit-test diff --git a/unmaintained/taxes/taxes.factor b/unmaintained/taxes/taxes.factor deleted file mode 100644 index 5e2a395c40..0000000000 --- a/unmaintained/taxes/taxes.factor +++ /dev/null @@ -1,145 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs kernel math math.intervals -namespaces sequences combinators.lib money math.order ; -IN: taxes - -: monthly ( x -- y ) 12 / ; -: semimonthly ( x -- y ) 24 / ; -: biweekly ( x -- y ) 26 / ; -: weekly ( x -- y ) 52 / ; -: daily ( x -- y ) 360 / ; - -! Each employee fills out a w4 -TUPLE: w4 year allowances married? ; -C: w4 - -: allowance ( -- x ) 3500 ; inline - -: calculate-w4-allowances ( w4 -- x ) allowances>> allowance * ; - -! Withhold: FICA, Medicare, Federal (FICA is social security) -: fica-tax-rate ( -- x ) DECIMAL: .062 ; inline - -! Base rate -- income over this rate is not taxed -ERROR: fica-base-unknown ; -: fica-base-rate ( year -- x ) - H{ - { 2008 102000 } - { 2007 97500 } - } at* [ fica-base-unknown ] unless ; - -: fica-tax ( salary w4 -- x ) - year>> fica-base-rate min fica-tax-rate * ; - -! Employer tax only, not withheld -: futa-tax-rate ( -- x ) DECIMAL: .062 ; inline -: futa-base-rate ( -- x ) 7000 ; inline -: futa-tax-offset-credit ( -- x ) DECIMAL: .054 ; inline - -: futa-tax ( salary w4 -- x ) - drop futa-base-rate min - futa-tax-rate futa-tax-offset-credit - - * ; - -! No base rate for medicare; all wages subject -: medicare-tax-rate ( -- x ) DECIMAL: .0145 ; inline -: medicare-tax ( salary w4 -- x ) drop medicare-tax-rate * ; - -MIXIN: collector -GENERIC: adjust-allowances ( salary w4 collector -- newsalary ) -GENERIC: withholding ( salary w4 collector -- x ) - -TUPLE: tax-table single married ; - -: ( single married class -- obj ) - >r tax-table boa r> construct-delegate ; - -: tax-bracket-range ( pair -- n ) dup second swap first - ; - -: tax-bracket ( tax salary triples -- tax salary ) - [ [ tax-bracket-range min ] keep third * + ] 2keep - tax-bracket-range [-] ; - -: tax ( salary triples -- x ) - 0 -rot [ tax-bracket ] each drop ; - -: marriage-table ( w4 tax-table -- triples ) - swap married?>> [ married>> ] [ single>> ] if ; - -: federal-tax ( salary w4 tax-table -- n ) - [ adjust-allowances ] 2keep marriage-table tax ; - -! http://www.irs.gov/pub/irs-pdf/p15.pdf -! Table 7 ANNUAL Payroll Period - -: federal-single ( -- triples ) - { - { 0 2650 DECIMAL: 0 } - { 2650 10300 DECIMAL: .10 } - { 10300 33960 DECIMAL: .15 } - { 33960 79725 DECIMAL: .25 } - { 79725 166500 DECIMAL: .28 } - { 166500 359650 DECIMAL: .33 } - { 359650 1/0. DECIMAL: .35 } - } ; - -: federal-married ( -- triples ) - { - { 0 8000 DECIMAL: 0 } - { 8000 23550 DECIMAL: .10 } - { 23550 72150 DECIMAL: .15 } - { 72150 137850 DECIMAL: .25 } - { 137850 207700 DECIMAL: .28 } - { 207700 365100 DECIMAL: .33 } - { 365100 1/0. DECIMAL: .35 } - } ; - -TUPLE: federal ; -INSTANCE: federal collector -: ( -- obj ) - federal-single federal-married federal ; - -M: federal adjust-allowances ( salary w4 collector -- newsalary ) - drop calculate-w4-allowances - ; - -M: federal withholding ( salary w4 tax-table -- x ) - [ federal-tax ] 3keep drop - [ fica-tax ] 2keep - medicare-tax + + ; - - -! Minnesota -: minnesota-single ( -- triples ) - { - { 0 1950 DECIMAL: 0 } - { 1950 23750 DECIMAL: .0535 } - { 23750 73540 DECIMAL: .0705 } - { 73540 1/0. DECIMAL: .0785 } - } ; - -: minnesota-married ( -- triples ) - { - { 0 7400 DECIMAL: 0 } - { 7400 39260 DECIMAL: .0535 } - { 39260 133980 DECIMAL: .0705 } - { 133980 1/0. DECIMAL: .0785 } - } ; - -TUPLE: minnesota ; -INSTANCE: minnesota collector -: ( -- obj ) - minnesota-single minnesota-married minnesota ; - -M: minnesota adjust-allowances ( salary w4 collector -- newsalary ) - drop calculate-w4-allowances - ; - -M: minnesota withholding ( salary w4 collector -- x ) - [ adjust-allowances ] 2keep marriage-table tax ; - -: employer-withhold ( salary w4 collector -- x ) - [ withholding ] 3keep - dup federal? [ 3drop ] [ drop withholding + ] if ; - -: net ( salary w4 collector -- x ) - >r dupd r> employer-withhold - ; From 1b7c0b78573feae5b812b9c13df6f2adbc08ec15 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Sep 2008 13:33:32 -0500 Subject: [PATCH 007/244] remove lib usage --- extra/taxes/usa/federal/federal.factor | 4 ++-- extra/taxes/usa/fica/fica.factor | 2 +- extra/taxes/usa/futa/futa.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor index 91d22ee828..5274535f81 100644 --- a/extra/taxes/usa/federal/federal.factor +++ b/extra/taxes/usa/federal/federal.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs kernel math math.intervals -namespaces sequences combinators.lib money math.order -taxes.usa.fica taxes.usa.medicare taxes.usa taxes.usa.w4 ; +namespaces sequences money math.order taxes.usa.fica +taxes.usa.medicare taxes.usa taxes.usa.w4 ; IN: taxes.usa.federal ! http://www.irs.gov/pub/irs-pdf/p15.pdf diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor index 69a62753f2..e71b2723a3 100644 --- a/extra/taxes/usa/fica/fica.factor +++ b/extra/taxes/usa/fica/fica.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors math math.order assocs.lib money ; +USING: accessors math math.order money ; IN: taxes.usa.fica : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline diff --git a/extra/taxes/usa/futa/futa.factor b/extra/taxes/usa/futa/futa.factor index 36d3097007..7368aef825 100644 --- a/extra/taxes/usa/futa/futa.factor +++ b/extra/taxes/usa/futa/futa.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs kernel math math.intervals -namespaces sequences combinators.lib money math.order ; +namespaces sequences money math.order ; IN: taxes.usa.futa ! Employer tax only, not withheld From 1b889d1f1b6b91162bc888d5270352928e74e04f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 23:02:25 -0500 Subject: [PATCH 008/244] Clear our next-method-quot-cache when deploying --- basis/tools/deploy/shaker/shaker.factor | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index f8b0862c9d..b502a4b4a2 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -373,7 +373,8 @@ SYMBOL: deploy-vocab r> strip-words compress-byte-arrays compress-quotations - compress-strings ; + compress-strings + H{ } clone classes:next-method-quot-cache set-global ; : (deploy) ( final-image vocab config -- ) #! Does the actual work of a deployment in the slave From c7f5b0de813fb247fc78be2a6f6bb7aac2857146 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 23:33:57 -0500 Subject: [PATCH 009/244] throw an error when all slots are IGNORE --- basis/db/queries/queries.factor | 3 +++ basis/db/tuples/tuples-tests.factor | 4 +--- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 0b206cea8f..768ec70185 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -145,10 +145,13 @@ M: db ( tuple table -- sql ) where-clause ] query-make ; +ERROR: all-slots-ignored class ; + M: db ( tuple class -- statement ) [ "select " 0% [ dupd filter-ignores ] dip + over empty? [ all-slots-ignored ] when over [ ", " 0% ] [ dup column-name>> 0% 2, ] interleave diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 6114c7ebe1..406d4756a2 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -356,9 +356,7 @@ TUPLE: exam id name score ; [ f ] [ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test - ! FIXME - ! [ f ] - ! [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] unit-test + [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] [ class>> "EXAM" = ] must-fail-with [ { From 47d884cf417675f3f8d129be899128765d82d4fa Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 23:56:20 -0500 Subject: [PATCH 010/244] fix typos in db docs --- basis/db/tuples/tuples-docs.factor | 2 +- basis/db/types/types-docs.factor | 28 +++++++++++++++------------- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor index d7ee3a5ad2..497cc2e8c5 100644 --- a/basis/db/tuples/tuples-docs.factor +++ b/basis/db/tuples/tuples-docs.factor @@ -190,7 +190,7 @@ T{ book { $list "Make a new tuple to represent your data" { "Map the Factor types to the database types with " { $link define-persistent } } - { "Make a " { $link "db-custom-database-combinators" } " to open your database and run a " { $snippet "quotation" } } + { "Make a custom database combinator (see" { $link "db-custom-database-combinators" } ") to open your database and run a " { $link quotation } } { "Create a table with " { $link create-table } ", " { $link ensure-table } ", or " { $link recreate-table } } { "Start making and storing objects with " { $link insert-tuple } ", " { $link update-tuple } ", " { $link delete-tuples } ", and " { $link select-tuples } } } ; diff --git a/basis/db/types/types-docs.factor b/basis/db/types/types-docs.factor index 401bbbc4d7..f1a6ba6c6c 100644 --- a/basis/db/types/types-docs.factor +++ b/basis/db/types/types-docs.factor @@ -8,7 +8,7 @@ HELP: +autoincrement+ { $description "" } ; HELP: +db-assigned-id+ -{ $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ; +{ $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ; HELP: +default+ { $description "" } ; @@ -29,7 +29,7 @@ HELP: +primary-key+ { $description "" } ; HELP: +random-id+ -{ $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ; +{ $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ; HELP: +serial+ { $description "" } ; @@ -38,7 +38,7 @@ HELP: +unique+ { $description "" } ; HELP: +user-assigned-id+ -{ $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ; +{ $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ; HELP: { $description "" } ; @@ -53,7 +53,7 @@ HELP: BIG-INTEGER { $description "A 64-bit integer. Whether this number is signed or unsigned depends on the database backend." } ; HELP: BLOB -{ $description "A serialized Factor object. The database library automatically serializes the object for a SQL insert or update and deserializes it on a tuple query." } ; +{ $description "A byte array." } ; HELP: BOOLEAN { $description "Either true or false." } ; @@ -65,7 +65,7 @@ HELP: DATETIME { $description "A date and a time." } ; HELP: DOUBLE -{ $description "Corresponds to Factor's 64bit floating-point numbers." } ; +{ $description "Corresponds to Factor's 64-bit floating-point numbers." } ; HELP: FACTOR-BLOB { $description "A serialized Factor object." } ; @@ -77,30 +77,31 @@ HELP: NULL { $description "The SQL null type." } ; HELP: REAL -{ $description "" } ; +{ $description "A real number of unlimited precision. May not be supported on all databases." } ; HELP: SIGNED-BIG-INTEGER -{ $description "For portability, if a number is known to be 64bit and signed, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ; +{ $description "For portability, if a number is known to be 64bit and signed, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ; HELP: TEXT -{ $description "" } ; +{ $description "Stores a string that is longer than a " { $link VARCHAR } ". SQLite uses this type for strings; it does not handle " { $link VARCHAR } " strings." } ; HELP: TIME -{ $description "" } ; +{ $description "A timestamp without a date component." } ; HELP: TIMESTAMP { $description "A Factor timestamp." } ; HELP: UNSIGNED-BIG-INTEGER -{ $description "For portability, if a number is known to be 64bit, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ; +{ $description "For portability, if a number is known to be 64bit, then this datatype may be used. Some databases, like SQLite, cannot store arbitrary bignums as BIGINT types. If storing arbitrary bignums, use " { $link FACTOR-BLOB } "." } ; { INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER } related-words HELP: URL -{ $description "A Factor " { $link "urls" } " object." } ; +{ $description "A Factor " { $link "urls" } " object." } ; HELP: VARCHAR -{ $description "The SQL varchar type. This type can take an integer as an argument." } ; +{ $description "The SQL varchar type. This type can take an integer as an argument." } +{ $examples { $unchecked-example "{ VARCHAR 256 }" "" } } ; HELP: user-assigned-id-spec? { $values @@ -279,8 +280,9 @@ ARTICLE: "db.types" "Database types" { $subsection DATETIME } { $subsection TIME } { $subsection TIMESTAMP } -"Arbitrary Factor objects:" +"Factor byte-arrays:" { $subsection BLOB } +"Arbitrary Factor objects:" { $subsection FACTOR-BLOB } "Factor URLs:" { $subsection URL } ; From d4134a2ca1555b3554537231515c8111a8fd256a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 01:17:45 -0500 Subject: [PATCH 011/244] Fix loop detection bug --- basis/compiler/tests/optimizer.factor | 15 ++++++++++++ .../tree/recursive/recursive-tests.factor | 24 +++++++++++++++++++ .../compiler/tree/recursive/recursive.factor | 12 ++++++---- 3 files changed, 46 insertions(+), 5 deletions(-) diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor index 4c39da0479..f1b3e32eed 100755 --- a/basis/compiler/tests/optimizer.factor +++ b/basis/compiler/tests/optimizer.factor @@ -362,3 +362,18 @@ TUPLE: some-tuple x ; [ B{ 0 1 2 3 4 5 6 7 } ] [ [ 8 [ ] B{ } map-as ] compile-call ] unit-test [ 0 ] [ 1234 [ { fixnum } declare -64 shift ] compile-call ] unit-test + +! Loop detection problem found by doublec +SYMBOL: counter + +DEFER: loop-bbb + +: loop-aaa ( -- ) + counter inc counter get 2 < [ loop-bbb ] when ; inline recursive + +: loop-bbb ( -- ) + [ loop-aaa ] with-scope ; inline recursive + +: loop-ccc ( -- ) loop-bbb ; + +[ 0 ] [ 0 counter set loop-ccc counter get ] unit-test diff --git a/basis/compiler/tree/recursive/recursive-tests.factor b/basis/compiler/tree/recursive/recursive-tests.factor index c66c182869..b1f9406092 100644 --- a/basis/compiler/tree/recursive/recursive-tests.factor +++ b/basis/compiler/tree/recursive/recursive-tests.factor @@ -148,3 +148,27 @@ DEFER: a' [ a' ] build-tree analyze-recursive \ b' label-is-loop? ] unit-test + +DEFER: a'' + +: b'' ( -- ) + a'' ; inline recursive + +: a'' ( -- ) + b'' a'' ; inline recursive + +[ t ] [ + [ a'' ] build-tree analyze-recursive + \ a'' label-is-not-loop? +] unit-test + +: loop-in-non-loop ( x quot: ( i -- ) -- ) + over 0 > [ + [ [ 1 - ] dip loop-in-non-loop ] [ call ] 2bi + ] [ 2drop ] if ; inline recursive + +[ t ] [ + [ 10 [ [ drop ] each-integer ] loop-in-non-loop ] + build-tree analyze-recursive + \ (each-integer) label-is-loop? +] unit-test diff --git a/basis/compiler/tree/recursive/recursive.factor b/basis/compiler/tree/recursive/recursive.factor index d1e4c7c70e..d257cd6600 100644 --- a/basis/compiler/tree/recursive/recursive.factor +++ b/basis/compiler/tree/recursive/recursive.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel assocs namespaces accessors sequences deques +USING: kernel assocs arrays namespaces accessors sequences deques search-deques compiler.tree compiler.tree.combinators ; IN: compiler.tree.recursive @@ -50,11 +50,10 @@ GENERIC: collect-loop-info* ( tail? node -- ) loop-stack get length swap loop-heights get set-at ; M: #recursive collect-loop-info* - nip [ [ label>> - [ loop-stack [ swap suffix ] change ] + [ swap 2array loop-stack [ swap suffix ] change ] [ remember-loop-info ] [ t >>loop? drop ] tri @@ -62,7 +61,7 @@ M: #recursive collect-loop-info* [ t swap child>> (collect-loop-info) ] bi ] with-scope ; -: current-loop-nesting ( label -- labels ) +: current-loop-nesting ( label -- alist ) loop-stack get swap loop-heights get at tail ; : disqualify-loop ( label -- ) @@ -71,7 +70,10 @@ M: #recursive collect-loop-info* M: #call-recursive collect-loop-info* label>> swap [ dup disqualify-loop ] unless - dup current-loop-nesting [ loop-calls get push-at ] with each ; + dup current-loop-nesting + [ keys [ loop-calls get push-at ] with each ] + [ [ nip not ] assoc-filter keys [ disqualify-loop ] each ] + bi ; M: #if collect-loop-info* children>> [ (collect-loop-info) ] with each ; From 87c71ee3769896fafb8af3b9ced6902be45ee746 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 01:17:54 -0500 Subject: [PATCH 012/244] Rice --- basis/http/client/client.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index aa1e0771ba..9260f15a7b 100755 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -120,7 +120,7 @@ SYMBOL: redirects ] if ; inline recursive : read-unchunked ( quot: ( chunk -- ) -- ) - 8192 read dup [ + 8192 read-partial dup [ [ swap call ] [ drop read-unchunked ] 2bi ] [ 2drop ] if ; inline recursive From 1ef5dbe3fb601e049d268a7f21915e5511c9b3ee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 03:37:53 -0500 Subject: [PATCH 013/244] Move hsva to colors.hsv --- basis/colors/colors.factor | 49 ++++++---------- basis/colors/gray/gray.factor | 11 ++++ basis/colors/hsv/hsv-tests.factor | 26 +++++++++ basis/colors/hsv/hsv.factor | 65 ++++++++++----------- extra/benchmark/mandel/colors/colors.factor | 7 ++- extra/color-picker/color-picker.factor | 2 +- 6 files changed, 90 insertions(+), 70 deletions(-) create mode 100644 basis/colors/gray/gray.factor create mode 100644 basis/colors/hsv/hsv-tests.factor diff --git a/basis/colors/colors.factor b/basis/colors/colors.factor index 77a1f46c87..1183c2e46c 100644 --- a/basis/colors/colors.factor +++ b/basis/colors/colors.factor @@ -1,48 +1,33 @@ -! Copyright (C) 2003, 2007, 2008 Slava Pestov. +! Copyright (C) 2003, 2008 Slava Pestov. +! Copyright (C) 2008 Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. - -USING: kernel combinators sequences arrays classes.tuple accessors colors.hsv ; - +USING: kernel accessors ; IN: colors -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - TUPLE: color ; TUPLE: rgba < color red green blue alpha ; -TUPLE: hsva < color hue saturation value alpha ; - -TUPLE: gray < color gray alpha ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +C: rgba GENERIC: >rgba ( object -- rgba ) M: rgba >rgba ( rgba -- rgba ) ; -M: hsva >rgba ( hsva -- rgba ) - { [ hue>> ] [ saturation>> ] [ value>> ] [ alpha>> ] } cleave 4array - [ hsv>rgb ] [ peek ] bi suffix first4 rgba boa ; - -M: gray >rgba ( gray -- rgba ) [ gray>> dup dup ] [ alpha>> ] bi rgba boa ; - M: color red>> ( color -- red ) >rgba red>> ; M: color green>> ( color -- green ) >rgba green>> ; M: color blue>> ( color -- blue ) >rgba blue>> ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: black T{ rgba f 0.0 0.0 0.0 1.0 } ; -: blue T{ rgba f 0.0 0.0 1.0 1.0 } ; -: cyan T{ rgba f 0 0.941 0.941 1 } ; -: gray T{ rgba f 0.6 0.6 0.6 1.0 } ; -: green T{ rgba f 0.0 1.0 0.0 1.0 } ; -: light-gray T{ rgba f 0.95 0.95 0.95 0.95 } ; -: light-purple T{ rgba f 0.8 0.8 1.0 1.0 } ; -: magenta T{ rgba f 0.941 0 0.941 1 } ; -: orange T{ rgba f 0.941 0.627 0 1 } ; -: purple T{ rgba f 0.627 0 0.941 1 } ; -: red T{ rgba f 1.0 0.0 0.0 1.0 } ; -: white T{ rgba f 1.0 1.0 1.0 1.0 } ; -: yellow T{ rgba f 1.0 1.0 0.0 1.0 } ; +: black T{ rgba f 0.0 0.0 0.0 1.0 } ; inline +: blue T{ rgba f 0.0 0.0 1.0 1.0 } ; inline +: cyan T{ rgba f 0 0.941 0.941 1 } ; inline +: gray T{ rgba f 0.6 0.6 0.6 1.0 } ; inline +: green T{ rgba f 0.0 1.0 0.0 1.0 } ; inline +: light-gray T{ rgba f 0.95 0.95 0.95 0.95 } ; inline +: light-purple T{ rgba f 0.8 0.8 1.0 1.0 } ; inline +: magenta T{ rgba f 0.941 0 0.941 1 } ; inline +: orange T{ rgba f 0.941 0.627 0 1 } ; inline +: purple T{ rgba f 0.627 0 0.941 1 } ; inline +: red T{ rgba f 1.0 0.0 0.0 1.0 } ; inline +: white T{ rgba f 1.0 1.0 1.0 1.0 } ; inline +: yellow T{ rgba f 1.0 1.0 0.0 1.0 } ; inline diff --git a/basis/colors/gray/gray.factor b/basis/colors/gray/gray.factor new file mode 100644 index 0000000000..26ec1177b6 --- /dev/null +++ b/basis/colors/gray/gray.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Eduardo Cavazos. +! See http://factorcode.org/license.txt for BSD license. +USING: colors kernel accessors ; +IN: colors.gray + +TUPLE: gray < color gray alpha ; + +C: gray + +M: gray >rgba ( gray -- rgba ) + [ gray>> dup dup ] [ alpha>> ] bi ; diff --git a/basis/colors/hsv/hsv-tests.factor b/basis/colors/hsv/hsv-tests.factor new file mode 100644 index 0000000000..8a736553bb --- /dev/null +++ b/basis/colors/hsv/hsv-tests.factor @@ -0,0 +1,26 @@ +IN: colors.hsv.tests +USING: accessors kernel colors colors.hsv tools.test math ; + +: hsv>rgb ( h s v -- r g b ) + [ 360 * ] 2dip + 1 >rgba [ red>> ] [ green>> ] [ blue>> ] tri ; + +[ 1/2 1/2 1/2 ] [ 0 0 1/2 hsv>rgb ] unit-test + +[ 1/2 1/4 1/4 ] [ 0 1/2 1/2 hsv>rgb ] unit-test +[ 1/3 2/9 2/9 ] [ 0 1/3 1/3 hsv>rgb ] unit-test + +[ 24/125 1/5 4/25 ] [ 1/5 1/5 1/5 hsv>rgb ] unit-test +[ 29/180 1/6 5/36 ] [ 1/5 1/6 1/6 hsv>rgb ] unit-test + +[ 6/25 2/5 38/125 ] [ 2/5 2/5 2/5 hsv>rgb ] unit-test +[ 8/25 4/5 64/125 ] [ 2/5 3/5 4/5 hsv>rgb ] unit-test + +[ 6/25 48/125 3/5 ] [ 3/5 3/5 3/5 hsv>rgb ] unit-test +[ 0 0 0 ] [ 3/5 1/5 0 hsv>rgb ] unit-test + +[ 84/125 4/25 4/5 ] [ 4/5 4/5 4/5 hsv>rgb ] unit-test +[ 7/15 1/3 1/2 ] [ 4/5 1/3 1/2 hsv>rgb ] unit-test + +[ 5/6 5/36 5/6 ] [ 5/6 5/6 5/6 hsv>rgb ] unit-test +[ 1/6 0 1/6 ] [ 5/6 1 1/6 hsv>rgb ] unit-test diff --git a/basis/colors/hsv/hsv.factor b/basis/colors/hsv/hsv.factor index dd2811822b..6f658818a1 100644 --- a/basis/colors/hsv/hsv.factor +++ b/basis/colors/hsv/hsv.factor @@ -1,41 +1,38 @@ -! Copyright (C) 2007 Eduardo Cavazos +! Copyright (C) 2008 Eduardo Cavazos. ! See http://factorcode.org/license.txt for BSD license. - -USING: kernel combinators arrays sequences math math.functions ; - +USING: colors kernel combinators math math.functions accessors ; IN: colors.hsv - - ! h [0,360) ! s [0,1] ! v [0,1] +TUPLE: hsva < color hue saturation value alpha ; -: hsv>rgb ( hsv -- rgb ) -dup Hi -{ { 0 [ [ V ] [ t ] [ p ] tri ] } - { 1 [ [ q ] [ V ] [ p ] tri ] } - { 2 [ [ p ] [ V ] [ t ] tri ] } - { 3 [ [ p ] [ q ] [ V ] tri ] } - { 4 [ [ t ] [ p ] [ V ] tri ] } - { 5 [ [ V ] [ p ] [ q ] tri ] } } case 3array ; +C: hsva + +> 60 / floor 6 mod ; inline + +: f ( hsv -- f ) [ hue>> 60 / ] [ Hi ] bi - ; inline + +: p ( hsv -- p ) [ saturation>> 1 swap - ] [ value>> ] bi * ; inline + +: q ( hsv -- q ) [ [ f ] [ saturation>> ] bi * 1 swap - ] [ value>> ] bi * ; inline + +: t ( hsv -- t ) [ [ f 1 swap - ] [ saturation>> ] bi * 1 swap - ] [ value>> ] bi * ; inline + +PRIVATE> + +M: hsva >rgba ( hsva -- rgba ) + [ + dup Hi + { + { 0 [ [ value>> ] [ t ] [ p ] tri ] } + { 1 [ [ q ] [ value>> ] [ p ] tri ] } + { 2 [ [ p ] [ value>> ] [ t ] tri ] } + { 3 [ [ p ] [ q ] [ value>> ] tri ] } + { 4 [ [ t ] [ p ] [ value>> ] tri ] } + { 5 [ [ value>> ] [ p ] [ q ] tri ] } + } case + ] [ alpha>> ] bi ; diff --git a/extra/benchmark/mandel/colors/colors.factor b/extra/benchmark/mandel/colors/colors.factor index 7bbb25a47d..218f566eda 100644 --- a/extra/benchmark/mandel/colors/colors.factor +++ b/extra/benchmark/mandel/colors/colors.factor @@ -1,10 +1,11 @@ USING: math math.order kernel arrays byte-arrays sequences -colors.hsv benchmark.mandel.params ; +colors.hsv benchmark.mandel.params accessors colors ; IN: benchmark.mandel.colors : scale 255 * >fixnum ; inline -: scale-rgb ( r g b -- n ) [ scale ] tri@ 3byte-array ; +: scale-rgb ( rgba -- n ) + [ red>> scale ] [ green>> scale ] [ blue>> scale ] tri 3byte-array ; : sat 0.85 ; inline : val 0.85 ; inline @@ -12,7 +13,7 @@ IN: benchmark.mandel.colors : ( nb-cols -- map ) dup [ 360 * swap 1+ / sat val - 3array hsv>rgb first3 scale-rgb + 1 >rgba scale-rgb ] with map ; : color-map ( -- map ) diff --git a/extra/color-picker/color-picker.factor b/extra/color-picker/color-picker.factor index 4a0c148145..6ed8c1220c 100755 --- a/extra/color-picker/color-picker.factor +++ b/extra/color-picker/color-picker.factor @@ -23,7 +23,7 @@ M: color-preview model-changed swap value>> >>interior relayout-1 ; : ( model -- model ) - [ [ 256 /f ] map 1 suffix first4 rgba boa ] ; + [ first3 [ 256 /f ] tri@ 1 ] ; : ( -- model gadget ) 3 [ 0 0 0 255 ] replicate From 15eaf33ee83bd2e6a3b923edc4338341c10c703c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 03:38:09 -0500 Subject: [PATCH 014/244] Remove http.client => logging dependency --- basis/http/http.factor | 4 +--- basis/http/parsers/parsers.factor | 4 +--- basis/http/server/server.factor | 2 ++ 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/basis/http/http.factor b/basis/http/http.factor index cfc205dbb5..c90a1872ce 100755 --- a/basis/http/http.factor +++ b/basis/http/http.factor @@ -3,7 +3,7 @@ USING: accessors kernel combinators math namespaces make assocs sequences splitting sorting sets debugger strings vectors hashtables quotations arrays byte-arrays -math.parser calendar calendar.format present urls logging +math.parser calendar calendar.format present urls io io.encodings io.encodings.iana io.encodings.binary io.encodings.8-bit @@ -96,8 +96,6 @@ TUPLE: cookie name value version comment path domain expires max-age http-only s drop ] { } make ; -\ parse-cookie DEBUG add-input-logging - : check-cookie-string ( string -- string' ) dup "=;'\"\r\n" intersect empty? [ "Bad cookie name or value" throw ] unless ; diff --git a/basis/http/parsers/parsers.factor b/basis/http/parsers/parsers.factor index ce8257dec5..8e8e7358d1 100644 --- a/basis/http/parsers/parsers.factor +++ b/basis/http/parsers/parsers.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: combinators.short-circuit math math.order math.parser kernel sequences sequences.deep peg peg.parsers assocs arrays -hashtables strings unicode.case namespaces make ascii logging ; +hashtables strings unicode.case namespaces make ascii ; IN: http.parsers : except ( quot -- parser ) @@ -61,8 +61,6 @@ PEG: parse-request-line ( string -- triple ) 'space' , ] seq* just ; -\ parse-request-line DEBUG add-input-logging - : 'text' ( -- parser ) [ ctl? ] except ; diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 547e1b69fb..697dec24ce 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -24,6 +24,8 @@ html.elements html.streams ; IN: http.server +\ parse-cookie DEBUG add-input-logging + : check-absolute ( url -- url ) dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline From 2e48915f9c566ca1e2593432484134f4bac5dd26 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 03:38:36 -0500 Subject: [PATCH 015/244] Strip out C I/O if native I/O enabled --- basis/io/sockets/sockets.factor | 16 +++++++--- basis/io/unix/sockets/sockets.factor | 4 ++- basis/io/windows/nt/backend/backend.factor | 10 +++--- basis/io/windows/nt/sockets/sockets.factor | 4 +-- basis/tools/deploy/shaker/shaker.factor | 36 ++++++++++++---------- core/io/backend/backend.factor | 4 +++ core/io/streams/c/c.factor | 14 +++++---- 7 files changed, 53 insertions(+), 35 deletions(-) diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 9bfcc7e310..c704382dd4 100755 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -17,10 +17,12 @@ IN: io.sockets ! Addressing GENERIC: protocol-family ( addrspec -- af ) -GENERIC: sockaddr-type ( addrspec -- type ) +GENERIC: sockaddr-size ( addrspec -- n ) GENERIC: make-sockaddr ( addrspec -- sockaddr ) +GENERIC: empty-sockaddr ( addrspec -- sockaddr ) + GENERIC: address-size ( addrspec -- n ) GENERIC: inet-ntop ( data addrspec -- str ) @@ -28,10 +30,10 @@ GENERIC: inet-ntop ( data addrspec -- str ) GENERIC: inet-pton ( str addrspec -- data ) : make-sockaddr/size ( addrspec -- sockaddr size ) - [ make-sockaddr ] [ sockaddr-type heap-size ] bi ; + [ make-sockaddr ] [ sockaddr-size ] bi ; : empty-sockaddr/size ( addrspec -- sockaddr size ) - sockaddr-type [ ] [ heap-size ] bi ; + [ empty-sockaddr ] [ sockaddr-size ] bi ; GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec ) @@ -74,7 +76,9 @@ M: inet4 address-size drop 4 ; M: inet4 protocol-family drop PF_INET ; -M: inet4 sockaddr-type drop "sockaddr-in" c-type ; +M: inet4 sockaddr-size drop "sockaddr-in" heap-size ; + +M: inet4 empty-sockaddr drop "sockaddr-in" ; M: inet4 make-sockaddr ( inet -- sockaddr ) "sockaddr-in" @@ -128,7 +132,9 @@ M: inet6 address-size drop 16 ; M: inet6 protocol-family drop PF_INET6 ; -M: inet6 sockaddr-type drop "sockaddr-in6" c-type ; +M: inet6 sockaddr-size drop "sockaddr-in6" heap-size ; + +M: inet6 empty-sockaddr drop "sockaddr-in6" ; M: inet6 make-sockaddr ( inet -- sockaddr ) "sockaddr-in6" diff --git a/basis/io/unix/sockets/sockets.factor b/basis/io/unix/sockets/sockets.factor index 50952dd217..8f9ff4f066 100755 --- a/basis/io/unix/sockets/sockets.factor +++ b/basis/io/unix/sockets/sockets.factor @@ -139,7 +139,9 @@ M: unix (send) ( packet addrspec datagram -- ) ! Unix domain sockets M: local protocol-family drop PF_UNIX ; -M: local sockaddr-type drop "sockaddr-un" c-type ; +M: local sockaddr-size drop "sockaddr-un" heap-size ; + +M: local empty-sockaddr drop "sockaddr-un" ; M: local make-sockaddr path>> (normalize-path) diff --git a/basis/io/windows/nt/backend/backend.factor b/basis/io/windows/nt/backend/backend.factor index 7fbc1dbcf9..73b77508b7 100755 --- a/basis/io/windows/nt/backend/backend.factor +++ b/basis/io/windows/nt/backend/backend.factor @@ -1,9 +1,9 @@ USING: alien alien.c-types arrays assocs combinators continuations destructors io io.backend io.ports io.timeouts -io.windows io.windows.files libc kernel math namespaces -sequences threads windows windows.errors windows.kernel32 -strings splitting io.files io.buffers qualified ascii system -accessors locals ; +io.windows io.windows.files io.files io.buffers io.streams.c +libc kernel math namespaces sequences threads windows +windows.errors windows.kernel32 strings splitting qualified +ascii system accessors locals ; QUALIFIED: windows.winsock IN: io.windows.nt.backend @@ -120,3 +120,5 @@ M: winnt (wait-to-read) ( port -- ) [ finish-read ] tri ] with-destructors ; + +M: winnt (init-stdio) init-c-stdio ; diff --git a/basis/io/windows/nt/sockets/sockets.factor b/basis/io/windows/nt/sockets/sockets.factor index 41c5e88f5f..5d94cf2d4a 100755 --- a/basis/io/windows/nt/sockets/sockets.factor +++ b/basis/io/windows/nt/sockets/sockets.factor @@ -71,7 +71,7 @@ TUPLE: AcceptEx-args port dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ; : init-accept-buffer ( addr AcceptEx -- ) - swap sockaddr-type heap-size 16 + + swap sockaddr-size 16 + [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer drop ; inline @@ -135,7 +135,7 @@ TUPLE: WSARecvFrom-args port WSARecvFrom-args new swap >>port dup port>> handle>> handle>> >>s - dup port>> addr>> sockaddr-type heap-size + dup port>> addr>> sockaddr-size [ malloc &free >>lpFrom ] [ malloc-int &free >>lpFromLen ] bi make-receive-buffer >>lpBuffers diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index b502a4b4a2..86393771de 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -1,19 +1,18 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors qualified io.streams.c init fry namespaces make -assocs kernel parser lexer strings.parser tools.deploy.config -vocabs sequences words words.private memory kernel.private -continuations io prettyprint vocabs.loader debugger system -strings sets vectors quotations byte-arrays sorting ; +USING: accessors qualified io.backend io.streams.c init fry +namespaces make assocs kernel parser lexer strings.parser +tools.deploy.config vocabs sequences words words.private memory +kernel.private continuations io prettyprint vocabs.loader +debugger system strings sets vectors quotations byte-arrays +sorting compiler.units definitions ; QUALIFIED: bootstrap.stage2 QUALIFIED: classes QUALIFIED: command-line QUALIFIED: compiler.errors.private -QUALIFIED: compiler.units QUALIFIED: continuations QUALIFIED: definitions QUALIFIED: init -QUALIFIED: io.backend QUALIFIED: io.thread QUALIFIED: layouts QUALIFIED: listener @@ -198,11 +197,6 @@ IN: tools.deploy.shaker strip-word-names? [ dup strip-word-names ] when 2drop ; -: strip-recompile-hook ( -- ) - [ [ f ] { } map>assoc ] - compiler.units:recompile-hook - set-global ; - : strip-vocab-globals ( except names -- words ) [ child-vocabs [ words ] map concat ] map concat swap diff ; @@ -233,7 +227,7 @@ IN: tools.deploy.shaker "initial-thread" "threads" lookup , ] unless - strip-io? [ io.backend:io-backend , ] when + strip-io? [ io-backend , ] when { } { "alarms" @@ -260,9 +254,9 @@ IN: tools.deploy.shaker command-line:main-vocab-hook compiled-crossref compiled-generic-crossref - compiler.units:recompile-hook - compiler.units:update-tuples-hook - compiler.units:definition-observers + recompile-hook + update-tuples-hook + definition-observers definitions:crossref interactive-vocabs layouts:num-tags @@ -326,6 +320,14 @@ IN: tools.deploy.shaker 21 setenv ] [ drop ] if ; +: strip-c-io ( -- ) + deploy-io get 2 = [ + [ + c-io-backend forget + "io.streams.c" forget-vocab + ] with-compilation-unit + ] unless ; + : compress ( pred string -- ) "Compressing " prepend show instances @@ -362,10 +364,10 @@ SYMBOL: deploy-vocab set-boot-quot ; : strip ( -- ) + strip-c-io strip-libc strip-cocoa strip-debugger - strip-recompile-hook strip-init-hooks deploy-vocab get vocab-main set-boot-quot* stripped-word-props >r diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 0760063f0d..0c13277106 100755 --- a/core/io/backend/backend.factor +++ b/core/io/backend/backend.factor @@ -6,6 +6,10 @@ IN: io.backend SYMBOL: io-backend +SINGLETON: c-io-backend + +c-io-backend io-backend set-global + HOOK: init-io io-backend ( -- ) HOOK: (init-stdio) io-backend ( -- stdin stdout stderr ) diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 780d892d2e..1e12d7e956 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -54,26 +54,28 @@ M: c-reader stream-read-until M: c-reader dispose* handle>> fclose ; -M: object init-io ; +M: c-io-backend init-io ; : stdin-handle 11 getenv ; : stdout-handle 12 getenv ; : stderr-handle 61 getenv ; -M: object (init-stdio) +: init-c-stdio ( -- stdin stdout stderr ) stdin-handle stdout-handle stderr-handle ; -M: object io-multiplex 60 60 * 1000 * or (sleep) ; +M: c-io-backend (init-stdio) init-c-stdio ; -M: object (file-reader) +M: c-io-backend io-multiplex 60 60 * 1000 * or (sleep) ; + +M: c-io-backend (file-reader) "rb" fopen ; -M: object (file-writer) +M: c-io-backend (file-writer) "wb" fopen ; -M: object (file-appender) +M: c-io-backend (file-appender) "ab" fopen ; : show ( msg -- ) From f539406ee1092541dfb3accffe924fd656e65187 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 05:12:38 -0500 Subject: [PATCH 016/244] Fold class predicates applied to literals --- .../tree/propagation/propagation-tests.factor | 4 +++- .../compiler/tree/propagation/simple/simple.factor | 14 +++++++++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index d73e8b7db1..19ee051ac6 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -8,7 +8,7 @@ math.functions math.private strings layouts compiler.tree.propagation.info compiler.tree.def-use compiler.tree.debugger compiler.tree.checker slots.private words hashtables classes assocs locals -float-arrays ; +float-arrays system ; IN: compiler.tree.propagation.tests \ propagate must-infer @@ -590,6 +590,8 @@ MIXIN: empty-mixin [ V{ float-array } ] [ [| | F{ } ] final-classes ] unit-test +[ V{ t } ] [ [ netbsd unix? ] final-literals ] unit-test + ! [ V{ string } ] [ ! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes ! ] unit-test diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index 7fc38239f1..d586ff398f 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -76,13 +76,25 @@ M: #declare propagate-before : fold-call ( #call word -- ) [ (fold-call) ] [ drop out-d>> ] 2bi set-value-infos ; -: predicate-output-infos ( info class -- info ) +: predicate-output-infos/literal ( info class -- info ) + [ literal>> ] dip + '[ _ _ instance? ] + [ drop object-info ] + recover ; + +: predicate-output-infos/class ( info class -- info ) [ class>> ] dip { { [ 2dup class<= ] [ t ] } { [ 2dup classes-intersect? not ] [ f ] } [ object-info ] } cond 2nip ; +: predicate-output-infos ( info class -- info ) + over literal?>> + [ predicate-output-infos/literal ] + [ predicate-output-infos/class ] + if ; + : propagate-predicate ( #call word -- infos ) #! We need to force the caller word to recompile when the class #! is redefined, since now we're making assumptions but the From 7a2eb1d7b2397e3ee04437751d1c9ebeb7ea7dfa Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 05:13:22 -0500 Subject: [PATCH 017/244] Split off urls.secure for SSL support; reduces deployed image size --- basis/http/client/client-docs.factor | 2 ++ basis/urls/secure/secure.factor | 6 ++++++ basis/urls/urls.factor | 10 ++++++++-- 3 files changed, 16 insertions(+), 2 deletions(-) create mode 100644 basis/urls/secure/secure.factor diff --git a/basis/http/client/client-docs.factor b/basis/http/client/client-docs.factor index a762d1a5ef..d4f277a7c3 100644 --- a/basis/http/client/client-docs.factor +++ b/basis/http/client/client-docs.factor @@ -95,6 +95,8 @@ ARTICLE: "http.client.errors" "HTTP client errors" ARTICLE: "http.client" "HTTP client" "The " { $vocab-link "http.client" } " vocabulary implements an HTTP and HTTPS client on top of " { $link "http" } "." $nl +"For HTTPS support, you must load the " { $vocab-link "urls.secure" } " vocab first. If you don't load it, HTTPS will not load and images generated by " { $vocab-link "tools.deploy" } " will be smaller as a result." +$nl "There are two primary usage patterns, data retrieval with GET requests and form submission with POST requests:" { $subsection "http.client.get" } { $subsection "http.client.post" } diff --git a/basis/urls/secure/secure.factor b/basis/urls/secure/secure.factor new file mode 100644 index 0000000000..d2fa55f7f3 --- /dev/null +++ b/basis/urls/secure/secure.factor @@ -0,0 +1,6 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: urls urls.private io.sockets io.sockets.secure ; +IN: urls.secure + +M: abstract-inet >secure-addr ; diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 5cc8c9693b..30e8c68f9d 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel ascii combinators combinators.short-circuit sequences splitting fry namespaces make assocs arrays strings -io.sockets io.sockets.secure io.encodings.string +io.sockets io.encodings.string io.encodings.utf8 math math.parser accessors parser strings.parser lexer prettyprint.backend hashtables present peg.ebnf urls.encoding ; @@ -159,6 +159,12 @@ PRIVATE> : secure-protocol? ( protocol -- ? ) "https" = ; +secure-addr ( addrspec -- addrspec' ) + +PRIVATE> + : url-addr ( url -- addr ) [ [ host>> ] @@ -166,7 +172,7 @@ PRIVATE> [ protocol>> protocol-port ] tri or ] [ protocol>> ] bi - secure-protocol? [ ] when ; + secure-protocol? [ >secure-addr ] when ; : ensure-port ( url -- url ) dup protocol>> '[ _ protocol-port or ] change-port ; From 2b420656d6448cee20062f1ab620d376048104b2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 05:14:05 -0500 Subject: [PATCH 018/244] Tree shaker no longer loads threads into threadless images; 77kb improvement on hello-world size --- basis/tools/deploy/shaker/shaker.factor | 4 ++-- basis/tools/deploy/shaker/strip-debugger.factor | 10 ++++++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 86393771de..f3177a76e1 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -13,7 +13,6 @@ QUALIFIED: compiler.errors.private QUALIFIED: continuations QUALIFIED: definitions QUALIFIED: init -QUALIFIED: io.thread QUALIFIED: layouts QUALIFIED: listener QUALIFIED: prettyprint.config @@ -214,13 +213,14 @@ IN: tools.deploy.shaker continuations:restarts listener:error-hook init:init-hooks - io.thread:io-thread source-files:source-files input-stream output-stream error-stream } % + "io-thread" "io.thread" lookup , + "mallocs" "libc.private" lookup , deploy-threads? [ diff --git a/basis/tools/deploy/shaker/strip-debugger.factor b/basis/tools/deploy/shaker/strip-debugger.factor index 2302b61715..bdcc6c237e 100755 --- a/basis/tools/deploy/shaker/strip-debugger.factor +++ b/basis/tools/deploy/shaker/strip-debugger.factor @@ -1,8 +1,14 @@ -USING: kernel threads threads.private ; +USING: compiler.units words vocabs kernel threads.private ; IN: debugger : print-error ( error -- ) die drop ; : error. ( error -- ) die drop ; -M: thread error-in-thread ( error thread -- ) die 2drop ; +"threads" vocab [ + [ + "error-in-thread" "threads" lookup + [ die 2drop ] + define + ] with-compilation-unit +] when From e722698b1bc007c51e4ccd99e5ccd045b4f86318 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 05:15:05 -0500 Subject: [PATCH 019/244] os and cpu words now foldable; reduces deploy image size --- core/system/system.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/system/system.factor b/core/system/system.factor index 3c207c4ab5..6c9d838fa4 100755 --- a/core/system/system.factor +++ b/core/system/system.factor @@ -11,7 +11,7 @@ SINGLETON: ppc UNION: x86 x86.32 x86.64 ; -: cpu ( -- class ) \ cpu get ; +: cpu ( -- class ) \ cpu get-global ; foldable SINGLETON: winnt SINGLETON: wince @@ -29,7 +29,7 @@ UNION: bsd freebsd netbsd openbsd macosx ; UNION: unix bsd solaris linux ; -: os ( -- class ) \ os get ; +: os ( -- class ) \ os get-global ; foldable Date: Thu, 2 Oct 2008 06:41:17 -0500 Subject: [PATCH 020/244] Debugging tree shaker --- basis/tools/deploy/shaker/shaker.factor | 14 ++++++++++---- basis/tools/deploy/shaker/strip-cocoa.factor | 9 ++++++--- 2 files changed, 16 insertions(+), 7 deletions(-) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index f3177a76e1..7c02e87209 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -85,8 +85,8 @@ IN: tools.deploy.shaker ] change-props drop ] each ] [ - "Remaining word properties:" print - [ props>> keys ] gather . + "Remaining word properties:\n" show + [ props>> keys ] gather unparse show ] [ H{ } clone '[ [ [ _ [ ] cache ] map ] change-props drop @@ -360,15 +360,21 @@ SYMBOL: deploy-vocab init-hooks get values concat % , strip-io? [ \ flush , ] unless - ] [ ] make "Boot quotation: " write dup . flush + ] [ ] make "Boot quotation: " show dup unparse show set-boot-quot ; +: init-stripper ( -- ) + t "quiet" set-global + f output-stream set-global ; + : strip ( -- ) - strip-c-io + init-stripper strip-libc strip-cocoa strip-debugger strip-init-hooks + strip-c-io + f 5 setenv ! we can't use the Factor debugger or Factor I/O anymore deploy-vocab get vocab-main set-boot-quot* stripped-word-props >r stripped-globals strip-globals diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor index 2cf803e270..d5249dc20c 100755 --- a/basis/tools/deploy/shaker/strip-cocoa.factor +++ b/basis/tools/deploy/shaker/strip-cocoa.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: cocoa cocoa.messages cocoa.application cocoa.nibs assocs namespaces kernel kernel.private words compiler.units sequences -ui ui.cocoa init ; +init vocabs ; IN: tools.deploy.shaker.cocoa : pool ( obj -- obj' ) \ pool get [ ] cache ; @@ -23,9 +23,12 @@ IN: cocoa.application H{ } clone \ pool [ global [ - stop-after-last-window? set + "stop-after-last-window?" "ui" lookup set - [ "MiniFactor.nib" load-nib ] cocoa-init-hook set-global + "ui.cocoa" vocab [ + [ "MiniFactor.nib" load-nib ] + "cocoa-init-hook" "ui.cocoa" lookup set-global + ] when ! Only keeps those methods that we actually call sent-messages get super-sent-messages get assoc-union From 28d3654f61d1d38bb5d2710dbb6be49e5d3cba53 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 06:47:20 -0500 Subject: [PATCH 021/244] Small ricing --- core/sequences/sequences.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 267238a502..63cc14d1d7 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -27,7 +27,7 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; -: empty? ( seq -- ? ) length zero? ; inline +: empty? ( seq -- ? ) length 0 = ; inline : if-empty ( seq quot1 quot2 -- ) [ dup empty? ] [ [ drop ] prepose ] [ ] tri* if ; inline @@ -362,7 +362,7 @@ PRIVATE> prepose curry ; inline : (interleave) ( n elt between quot -- ) - roll zero? [ nip ] [ swapd 2slip ] if call ; inline + roll 0 = [ nip ] [ swapd 2slip ] if call ; inline PRIVATE> @@ -530,7 +530,7 @@ M: sequence <=> [ -rot 2nth-unsafe <=> ] [ [ length ] compare ] if* ; : sequence= ( seq1 seq2 -- ? ) - 2dup [ length ] bi@ number= + 2dup [ length ] bi@ = [ mismatch not ] [ 2drop f ] if ; inline : sequence-hashcode-step ( oldhash newpart -- newhash ) @@ -547,7 +547,7 @@ M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ; M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : move ( to from seq -- ) - 2over number= + 2over = [ 3drop ] [ [ nth swap ] [ set-nth ] bi ] if ; inline r 2over + pick r> move >r 1+ r> ] keep @@ -590,7 +590,7 @@ PRIVATE> ] if ; : move-forward ( shift from to seq -- ) - 2over number= [ + 2over = [ 2drop 2drop ] [ [ >r pick >r dup dup r> + swap r> move 1- ] keep @@ -607,7 +607,7 @@ PRIVATE> PRIVATE> : open-slice ( shift from seq -- ) - pick zero? [ + pick 0 = [ 3drop ] [ pick over length + over >r >r @@ -680,7 +680,7 @@ PRIVATE> : padding ( seq n elt quot -- newseq ) [ - [ over length [-] dup zero? [ drop ] ] dip + [ over length [-] dup 0 = [ drop ] ] dip [ ] curry ] dip compose if ; inline From b45ee5b8be5ddc1ecfce65c3f6137d83fc3f5963 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 06:47:48 -0500 Subject: [PATCH 022/244] Fix bootstrap --- basis/ui/gadgets/theme/theme.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/ui/gadgets/theme/theme.factor b/basis/ui/gadgets/theme/theme.factor index 46fa0105a3..5e4a2fbf4c 100644 --- a/basis/ui/gadgets/theme/theme.factor +++ b/basis/ui/gadgets/theme/theme.factor @@ -2,7 +2,8 @@ ! Copyright (C) 2006, 2007 Alex Chapman. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel sequences io.styles ui.gadgets ui.render -colors accessors ; +colors colors.gray qualified accessors ; +QUALIFIED: colors IN: ui.gadgets.theme : solid-interior ( gadget color -- gadget ) @@ -12,7 +13,7 @@ IN: ui.gadgets.theme >>boundary ; inline : faint-boundary ( gadget -- gadget ) - gray solid-boundary ; inline + colors:gray solid-boundary ; inline : selection-color ( -- color ) light-purple ; From b4d918caa529470b218d0acec3d644fee2337cac Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 07:10:22 -0500 Subject: [PATCH 023/244] Some minor new features for Cocoa binding --- basis/cocoa/application/application.factor | 2 +- basis/cocoa/cocoa-docs.factor | 9 ++++++++- basis/cocoa/cocoa.factor | 12 +++++++++++- basis/cocoa/messages/messages-docs.factor | 6 +----- basis/cocoa/messages/messages.factor | 3 ++- basis/cocoa/standalone/standalone.factor | 12 ++++++++++++ 6 files changed, 35 insertions(+), 9 deletions(-) create mode 100644 basis/cocoa/standalone/standalone.factor diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index a28952ea33..065a4abc5a 100755 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -30,7 +30,7 @@ IN: cocoa.application FUNCTION: void NSBeep ( ) ; : with-cocoa ( quot -- ) - [ NSApp drop call ] with-autorelease-pool ; + [ NSApp drop call ] with-autorelease-pool ; inline : next-event ( app -- event ) 0 f CFRunLoopDefaultMode 1 diff --git a/basis/cocoa/cocoa-docs.factor b/basis/cocoa/cocoa-docs.factor index a971288251..dd8d331b35 100644 --- a/basis/cocoa/cocoa-docs.factor +++ b/basis/cocoa/cocoa-docs.factor @@ -16,9 +16,16 @@ HELP: SUPER-> { send super-send POSTPONE: -> POSTPONE: SUPER-> } related-words +HELP: IMPORT: +{ $syntax "IMPORT: name" } +{ $description "Makes an Objective C class available for use." } +{ $examples + { $code "IMPORT: QTMovie" "QTMovie \"My Movie.mov\" f -> movieWithFile:error:" } +} ; + ARTICLE: "objc-calling" "Calling Objective C code" "Before an Objective C class can be used, it must be imported; by default, a small set of common classes are imported automatically, but additional classes can be imported as needed." -{ $subsection import-objc-class } +{ $subsection POSTPONE: IMPORT: } "Every imported Objective C class has as corresponding class word in the " { $vocab-link "cocoa.classes" } " vocabulary. Class words push the class object in the stack, allowing class methods to be invoked." $nl "Messages can be sent to classes and instances using a pair of parsing words:" diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor index 744d577c0d..ab86796236 100755 --- a/basis/cocoa/cocoa.factor +++ b/basis/cocoa/cocoa.factor @@ -3,7 +3,7 @@ USING: compiler io kernel cocoa.runtime cocoa.subclassing cocoa.messages cocoa.types sequences words vocabs parser core-foundation namespaces assocs hashtables compiler.units -lexer ; +lexer init ; IN: cocoa : (remember-send) ( selector variable -- ) @@ -27,6 +27,16 @@ SYMBOL: super-sent-messages scan dup remember-super-send parsed \ super-send parsed ; parsing +SYMBOL: frameworks + +frameworks global [ V{ } clone or ] change-at + +[ frameworks get [ load-framework ] each ] "cocoa.messages" add-init-hook + +: FRAMEWORK: scan [ load-framework ] [ frameworks get push ] bi ; parsing + +: IMPORT: scan [ ] import-objc-class ; parsing + "Compiling Objective C bridge..." print "cocoa.classes" create-vocab drop diff --git a/basis/cocoa/messages/messages-docs.factor b/basis/cocoa/messages/messages-docs.factor index f78981c923..9b5e3fdfd9 100644 --- a/basis/cocoa/messages/messages-docs.factor +++ b/basis/cocoa/messages/messages-docs.factor @@ -32,11 +32,7 @@ HELP: alien>objc-types HELP: import-objc-class { $values { "name" string } { "quot" "a quotation with stack effect " { $snippet "( -- )" } } } -{ $description "If a class named " { $snippet "name" } " is already known to the Objective C interface, does nothing. Otherwise, first calls the quotation. The quotation should make the class available to the Objective C runtime if necessary, either by loading a framework or defining it directly. After the quotation returns, this word makes the class available to Factor programs by importing methods and creating a class word the class object in the " { $vocab-link "cocoa.classes" } " vocabulary." } -{ $notes "In most cases, the quotation should be " { $link f } "." } -{ $examples - { $code "\"QTMovie\" f import-objc-class" "QTMovie \"My Movie.mov\" f -> movieWithFile:error:" } -} ; +{ $description "If a class named " { $snippet "name" } " is already known to the Objective C interface, does nothing. Otherwise, first calls the quotation. The quotation should make the class available to the Objective C runtime if necessary, either by loading a framework or defining it directly. After the quotation returns, this word makes the class available to Factor programs by importing methods and creating a class word the class object in the " { $vocab-link "cocoa.classes" } " vocabulary." } ; HELP: root-class { $values { "class" alien } { "root" alien } } diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 7977485b02..09601ef8cc 100755 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -4,7 +4,8 @@ USING: accessors alien alien.c-types alien.strings arrays assocs combinators compiler kernel math namespaces make parser prettyprint prettyprint.sections quotations sequences strings words cocoa.runtime io macros memoize debugger -io.encodings.ascii effects compiler.generator libc libc.private ; +io.encodings.ascii effects compiler.generator libc libc.private +parser lexer init core-foundation ; IN: cocoa.messages : make-sender ( method function -- quot ) diff --git a/basis/cocoa/standalone/standalone.factor b/basis/cocoa/standalone/standalone.factor new file mode 100644 index 0000000000..528736f172 --- /dev/null +++ b/basis/cocoa/standalone/standalone.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel cocoa.nibs cocoa.application cocoa ; +IN: cocoa.standalone + +: cocoa-app ( quot -- ) + [ + "MiniFactor.nib" load-nib + call + finish-launching + NSApp -> run + ] with-cocoa ; inline From 403d5207f06f9dfce922ca578d0a9d21b9155fb5 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 08:30:38 -0500 Subject: [PATCH 024/244] stop-server/stop-this-server split --- basis/concurrency/distributed/distributed.factor | 2 +- basis/http/http-tests.factor | 2 +- basis/io/encodings/ascii/ascii-docs.factor | 4 ++-- basis/io/servers/connection/connection-docs.factor | 13 ++++++++++--- basis/io/servers/connection/connection-tests.factor | 2 +- basis/io/servers/connection/connection.factor | 7 +++++-- basis/io/sockets/sockets-docs.factor | 2 +- basis/tools/deploy/deploy-tests.factor | 2 +- 8 files changed, 22 insertions(+), 12 deletions(-) diff --git a/basis/concurrency/distributed/distributed.factor b/basis/concurrency/distributed/distributed.factor index 5e2f1bb6d1..99ad239011 100755 --- a/basis/concurrency/distributed/distributed.factor +++ b/basis/concurrency/distributed/distributed.factor @@ -10,7 +10,7 @@ SYMBOL: local-node : handle-node-client ( -- ) deserialize - [ first2 get-process send ] [ stop-server ] if* ; + [ first2 get-process send ] [ stop-this-server ] if* ; : ( addrspec -- threaded-server ) diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 9a1421a3ad..49ef03543e 100755 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -179,7 +179,7 @@ http.server.dispatchers db.tuples ; : add-quit-action - [ stop-server "Goodbye" "text/html" ] >>display + [ stop-this-server "Goodbye" "text/html" ] >>display "quit" add-responder ; : test-db "test.db" temp-file sqlite-db ; diff --git a/basis/io/encodings/ascii/ascii-docs.factor b/basis/io/encodings/ascii/ascii-docs.factor index fa496a3526..e0ab11f1a4 100644 --- a/basis/io/encodings/ascii/ascii-docs.factor +++ b/basis/io/encodings/ascii/ascii-docs.factor @@ -4,8 +4,8 @@ IN: io.encodings.ascii HELP: ascii { $class-description "ASCII encoding descriptor." } ; -ARTICLE: "ascii" "ASCII encoding" +ARTICLE: "io.encodings.ascii" "ASCII encoding" "By default, if there's a non-ASCII character in an input stream, it will be replaced with a replacement character (U+FFFD), and if a non-ASCII character is used in output, an exception is thrown." { $subsection ascii } ; -ABOUT: "ascii" +ABOUT: "io.encodings.ascii" diff --git a/basis/io/servers/connection/connection-docs.factor b/basis/io/servers/connection/connection-docs.factor index 839f3d8414..00711ce226 100755 --- a/basis/io/servers/connection/connection-docs.factor +++ b/basis/io/servers/connection/connection-docs.factor @@ -58,9 +58,11 @@ ARTICLE: "io.servers.connection" "Threaded servers" { $subsection start-server } { $subsection start-server* } { $subsection wait-for-server } +"Stopping the server:" +{ $subsection stop-server } "From within the dynamic scope of a client handler, several words can be used to interact with the threaded server:" { $subsection remote-address } -{ $subsection stop-server } +{ $subsection stop-this-server } { $subsection secure-port } { $subsection insecure-port } "Additionally, the " { $link local-address } " variable is set, as in " { $link with-client } "." ; @@ -88,7 +90,8 @@ HELP: handle-client* HELP: start-server { $values { "threaded-server" threaded-server } } -{ $description "Starts a threaded server, returning when a client handler calls " { $link stop-server } "." } ; +{ $description "Starts a threaded server." } +{ $notes "Use " { $link stop-server } " or " { $link stop-this-server } " to stop the server." } ; HELP: wait-for-server { $values { "threaded-server" threaded-server } } @@ -96,9 +99,13 @@ HELP: wait-for-server HELP: start-server* { $values { "threaded-server" threaded-server } } -{ $description "Starts a threaded server, returning as soon as it is accepting connections." } ; +{ $description "Starts a threaded server, returning as soon as it is ready to begin accepting connections." } ; HELP: stop-server +{ $values { "threaded-server" threaded-server } } +{ $description "Stops a threaded server, preventing it from accepting any more connections and returning to the caller of " { $link start-server } ". All client connections which have already been opened continue to be serviced." } ; + +HELP: stop-this-server { $description "Stops the current threaded server, preventing it from accepting any more connections and returning to the caller of " { $link start-server } ". All client connections which have already been opened continue to be serviced." } ; HELP: secure-port diff --git a/basis/io/servers/connection/connection-tests.factor b/basis/io/servers/connection/connection-tests.factor index aa8df0b16c..a3223ed2aa 100755 --- a/basis/io/servers/connection/connection-tests.factor +++ b/basis/io/servers/connection/connection-tests.factor @@ -33,7 +33,7 @@ concurrency.promises io.encodings.ascii io threads calendar ; 5 >>max-connections 1237 >>insecure - [ "Hello world." write stop-server ] >>handler + [ "Hello world." write stop-this-server ] >>handler "server" set ] unit-test diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index bde4e518ac..0516f24402 100755 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -136,8 +136,11 @@ PRIVATE> [ wait-for-server ] bi ; -: stop-server ( -- ) - threaded-server get [ f ] change-sockets drop dispose-each ; +: stop-server ( threaded-server -- ) + [ f ] change-sockets drop dispose-each ; + +: stop-this-server ( -- ) + threaded-server get stop-server ; GENERIC: port ( addrspec -- n ) diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor index 3c77be254c..3454f3384e 100755 --- a/basis/io/sockets/sockets-docs.factor +++ b/basis/io/sockets/sockets-docs.factor @@ -104,7 +104,7 @@ HELP: } ; HELP: with-client -{ $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "quot" quotation } } +{ $values { "remote" "an address specifier" } { "encoding" "an encoding descriptor" } { "quot" quotation } } { $description "Opens a network connection and calls the quotation in a new dynamic scope with " { $link input-stream } " and " { $link output-stream } " rebound to the network streams. The local address the socket is bound to is stored in the " { $link local-address } " variable." } { $errors "Throws an error if the connection cannot be established." } ; diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor index 1d5b59bf0c..db4255cdb1 100755 --- a/basis/tools/deploy/deploy-tests.factor +++ b/basis/tools/deploy/deploy-tests.factor @@ -66,7 +66,7 @@ http.server.responses http.server.static io.servers.connection ; SINGLETON: quit-responder M: quit-responder call-responder* - 2drop stop-server "Goodbye" "text/html" ; + 2drop stop-this-server "Goodbye" "text/html" ; : add-quot-responder ( responder -- responder ) quit-responder "quit" add-responder ; From c8127d1e1b9d9cfe1e9adf5e72ac04d6490d058a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 08:30:49 -0500 Subject: [PATCH 025/244] Fix typo --- basis/present/present-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/present/present-docs.factor b/basis/present/present-docs.factor index f148d96b32..bda7723173 100644 --- a/basis/present/present-docs.factor +++ b/basis/present/present-docs.factor @@ -8,6 +8,6 @@ ARTICLE: "present" "Converting objects to human-readable strings" HELP: present { $values { "object" object } { "string" string } } { $contract "Outputs a human-readable string from an object." } -{ $notes "New methods can be defined by user code. Most often, this is done so that the object can be used with various words in the " { $link "html.components" } " or " { $link "urls" } " vocabularies." } ; +{ $notes "New methods can be defined by user code. Most often, this is done so that the object can be used with various words in the " { $vocab-link "html.components" } " or " { $link "urls" } " vocabularies." } ; ABOUT: "present" From c19f2257f470ca28d6dbed779ee499d8cdfa70ef Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 08:34:49 -0500 Subject: [PATCH 026/244] Fix permission bits --- basis/alarms/alarms-docs.factor | 0 basis/alarms/alarms-tests.factor | 0 basis/alarms/alarms.factor | 0 basis/alias/alias.factor | 0 basis/alien/arrays/arrays-docs.factor | 0 basis/alien/c-types/c-types-docs.factor | 0 basis/alien/c-types/c-types-tests.factor | 0 basis/alien/c-types/c-types.factor | 0 basis/alien/remote-control/remote-control.factor | 0 basis/alien/strings/strings.factor | 0 basis/alien/structs/structs-docs.factor | 0 basis/alien/structs/structs.factor | 0 basis/alien/syntax/syntax-docs.factor | 0 basis/alien/syntax/syntax.factor | 0 basis/ascii/ascii-docs.factor | 0 basis/ascii/ascii.factor | 0 basis/bit-arrays/bit-arrays-tests.factor | 0 basis/bit-arrays/bit-arrays.factor | 0 basis/bit-vectors/bit-vectors-docs.factor | 0 basis/bit-vectors/bit-vectors-tests.factor | 0 basis/bit-vectors/bit-vectors.factor | 0 basis/bootstrap/compiler/compiler.factor | 0 basis/bootstrap/handbook/handbook.factor | 0 basis/bootstrap/help/help.factor | 0 basis/bootstrap/image/image-tests.factor | 0 basis/bootstrap/image/image.factor | 0 basis/bootstrap/image/upload/upload.factor | 0 basis/bootstrap/io/io.factor | 0 basis/bootstrap/random/random.factor | 0 basis/bootstrap/stage2.factor | 0 basis/bootstrap/tools/tools.factor | 0 basis/bootstrap/ui/tools/tools.factor | 0 basis/bootstrap/unicode/unicode.factor | 0 basis/boxes/boxes-docs.factor | 0 basis/boxes/boxes-tests.factor | 0 basis/boxes/boxes.factor | 0 basis/calendar/calendar-tests.factor | 0 basis/calendar/calendar.factor | 0 basis/calendar/format/format-tests.factor | 0 basis/calendar/format/format.factor | 0 basis/calendar/model/model.factor | 0 basis/calendar/windows/windows.factor | 0 basis/channels/channels-tests.factor | 0 basis/channels/channels.factor | 0 basis/channels/examples/examples.factor | 0 basis/channels/remote/remote.factor | 0 basis/checksums/adler-32/adler-32-docs.factor | 0 basis/checksums/md5/md5-docs.factor | 0 basis/checksums/md5/md5-tests.factor | 0 basis/checksums/md5/md5.factor | 0 basis/checksums/sha1/sha1-tests.factor | 0 basis/checksums/sha1/sha1.factor | 0 basis/checksums/sha2/sha2-tests.factor | 0 basis/checksums/sha2/sha2.factor | 0 basis/circular/circular-tests.factor | 0 basis/circular/circular.factor | 0 basis/cocoa/application/application.factor | 0 basis/cocoa/cocoa.factor | 0 basis/cocoa/messages/messages.factor | 0 basis/cocoa/pasteboard/pasteboard.factor | 0 basis/cocoa/subclassing/subclassing.factor | 0 basis/cocoa/windows/windows.factor | 0 basis/combinators/short-circuit/short-circuit.factor | 0 basis/compiler/compiler-docs.factor | 0 basis/compiler/compiler.factor | 0 basis/compiler/constants/constants.factor | 0 basis/compiler/generator/fixup/fixup.factor | 0 basis/compiler/generator/generator-docs.factor | 0 basis/compiler/generator/generator.factor | 0 basis/compiler/generator/registers/registers.factor | 0 basis/compiler/tests/alien.factor | 0 basis/compiler/tests/curry.factor | 0 basis/compiler/tests/float.factor | 0 basis/compiler/tests/intrinsics.factor | 0 basis/compiler/tests/optimizer.factor | 0 basis/compiler/tests/simple.factor | 0 basis/compiler/tests/stack-trace.factor | 0 basis/compiler/tests/templates-early.factor | 0 basis/compiler/tests/templates.factor | 0 basis/compiler/tests/tuples.factor | 0 basis/compiler/tree/dead-code/simple/simple.factor | 0 basis/compiler/tree/def-use/def-use-tests.factor | 0 basis/compiler/tree/def-use/def-use.factor | 0 basis/compiler/tree/propagation/propagation.factor | 0 basis/compiler/tree/tree.factor | 0 basis/concurrency/combinators/combinators-docs.factor | 0 basis/concurrency/combinators/combinators-tests.factor | 0 basis/concurrency/combinators/combinators.factor | 0 basis/concurrency/conditions/conditions.factor | 0 basis/concurrency/count-downs/count-downs-docs.factor | 0 basis/concurrency/count-downs/count-downs-tests.factor | 0 basis/concurrency/count-downs/count-downs.factor | 0 basis/concurrency/distributed/distributed-docs.factor | 0 basis/concurrency/distributed/distributed-tests.factor | 0 basis/concurrency/distributed/distributed.factor | 0 basis/concurrency/exchangers/exchangers-docs.factor | 0 basis/concurrency/exchangers/exchangers-tests.factor | 0 basis/concurrency/exchangers/exchangers.factor | 0 basis/concurrency/flags/flags-tests.factor | 0 basis/concurrency/flags/flags.factor | 0 basis/concurrency/futures/futures-docs.factor | 0 basis/concurrency/futures/futures-tests.factor | 0 basis/concurrency/futures/futures.factor | 0 basis/concurrency/locks/locks-docs.factor | 0 basis/concurrency/locks/locks-tests.factor | 0 basis/concurrency/locks/locks.factor | 0 basis/concurrency/mailboxes/mailboxes-docs.factor | 0 basis/concurrency/mailboxes/mailboxes-tests.factor | 0 basis/concurrency/mailboxes/mailboxes.factor | 0 basis/concurrency/messaging/messaging-docs.factor | 0 basis/concurrency/messaging/messaging-tests.factor | 0 basis/concurrency/messaging/messaging.factor | 0 basis/concurrency/promises/promises-docs.factor | 0 basis/concurrency/promises/promises-tests.factor | 0 basis/concurrency/promises/promises.factor | 0 basis/concurrency/semaphores/semaphores-docs.factor | 0 basis/concurrency/semaphores/semaphores.factor | 0 basis/cpu/architecture/architecture.factor | 0 basis/cpu/ppc/allot/allot.factor | 0 basis/cpu/ppc/architecture/architecture.factor | 0 basis/cpu/ppc/assembler/assembler.factor | 0 basis/cpu/ppc/bootstrap.factor | 0 basis/cpu/ppc/intrinsics/intrinsics.factor | 0 basis/cpu/ppc/linux/bootstrap.factor | 0 basis/cpu/ppc/macosx/bootstrap.factor | 0 basis/cpu/ppc/ppc.factor | 0 basis/cpu/x86/32/32.factor | 0 basis/cpu/x86/32/bootstrap.factor | 0 basis/cpu/x86/64/64.factor | 0 basis/cpu/x86/64/bootstrap.factor | 0 basis/cpu/x86/allot/allot.factor | 0 basis/cpu/x86/architecture/architecture.factor | 0 basis/cpu/x86/assembler/assembler.factor | 0 basis/cpu/x86/bootstrap.factor | 0 basis/cpu/x86/intrinsics/intrinsics.factor | 0 basis/cpu/x86/sse2/sse2.factor | 0 basis/db/db-tests.factor | 0 basis/db/db.factor | 0 basis/db/postgresql/ffi/ffi.factor | 0 basis/db/postgresql/lib/lib.factor | 0 basis/db/postgresql/postgresql-tests.factor | 0 basis/db/postgresql/postgresql.factor | 0 basis/db/sqlite/ffi/ffi.factor | 0 basis/db/sqlite/lib/lib.factor | 0 basis/db/sqlite/sqlite-tests.factor | 0 basis/db/sqlite/sqlite.factor | 0 basis/db/tuples/tuples-tests.factor | 0 basis/db/tuples/tuples.factor | 0 basis/db/types/types.factor | 0 basis/debugger/debugger-docs.factor | 0 basis/debugger/debugger-tests.factor | 0 basis/debugger/debugger.factor | 0 basis/delegate/delegate-tests.factor | 0 basis/delegate/delegate.factor | 0 basis/delegate/protocols/protocols.factor | 0 basis/dlists/dlists-docs.factor | 0 basis/dlists/dlists-tests.factor | 0 basis/dlists/dlists.factor | 0 basis/documents/documents.factor | 0 basis/editors/editors.factor | 0 basis/editors/editpadpro/editpadpro.factor | 0 basis/editors/editplus/editplus.factor | 0 basis/editors/emacs/emacs.factor | 0 basis/editors/emeditor/emeditor.factor | 0 basis/editors/gvim/gvim.factor | 0 basis/editors/gvim/windows/windows.factor | 0 basis/editors/jedit/jedit.factor | 0 basis/editors/macvim/macvim.factor | 0 basis/editors/notepadpp/notepadpp.factor | 0 basis/editors/scite/scite.factor | 0 basis/editors/ted-notepad/ted-notepad.factor | 0 basis/editors/textedit/textedit.factor | 0 basis/editors/textmate/textmate.factor | 0 basis/editors/ultraedit/ultraedit.factor | 0 basis/editors/vim/vim.factor | 0 basis/editors/wordpad/wordpad.factor | 0 basis/float-arrays/float-arrays-tests.factor | 0 basis/float-arrays/float-arrays.factor | 0 basis/float-vectors/float-vectors-docs.factor | 0 basis/float-vectors/float-vectors-tests.factor | 0 basis/float-vectors/float-vectors.factor | 0 basis/freetype/freetype.factor | 0 basis/fry/fry-docs.factor | 0 basis/fry/fry-tests.factor | 0 basis/fry/fry.factor | 0 basis/furnace/actions/actions-tests.factor | 0 basis/furnace/actions/actions.factor | 0 basis/furnace/auth/auth.factor | 0 basis/furnace/auth/basic/basic.factor | 0 basis/furnace/auth/login/login-tests.factor | 0 basis/furnace/auth/login/login.factor | 0 basis/furnace/auth/providers/assoc/assoc-tests.factor | 0 basis/furnace/auth/providers/assoc/assoc.factor | 0 basis/furnace/auth/providers/db/db-tests.factor | 0 basis/furnace/auth/providers/db/db.factor | 0 basis/furnace/auth/providers/null/null.factor | 0 basis/furnace/auth/providers/providers.factor | 0 basis/furnace/db/db.factor | 0 basis/furnace/sessions/sessions-tests.factor | 0 basis/furnace/sessions/sessions.factor | 0 basis/generalizations/generalizations-docs.factor | 0 basis/generalizations/generalizations-tests.factor | 0 basis/generalizations/generalizations.factor | 0 basis/globs/globs.factor | 0 basis/hash2/hash2-tests.factor | 0 basis/heaps/heaps-docs.factor | 0 basis/heaps/heaps-tests.factor | 0 basis/heaps/heaps.factor | 0 basis/help/cookbook/cookbook.factor | 0 basis/help/crossref/crossref-tests.factor | 0 basis/help/definitions/definitions-tests.factor | 0 basis/help/definitions/definitions.factor | 0 basis/help/handbook/handbook.factor | 0 basis/help/help-docs.factor | 0 basis/help/help.factor | 0 basis/help/lint/lint.factor | 0 basis/help/markup/markup.factor | 0 basis/help/stylesheet/stylesheet.factor | 0 basis/help/syntax/syntax-tests.factor | 0 basis/help/syntax/syntax.factor | 0 basis/help/topics/topics.factor | 0 basis/help/tutorial/tutorial.factor | 0 basis/html/streams/streams.factor | 0 basis/html/templates/fhtml/fhtml-tests.factor | 0 basis/html/templates/fhtml/fhtml.factor | 0 basis/http/client/client-tests.factor | 0 basis/http/client/client.factor | 0 basis/http/http-tests.factor | 0 basis/http/http.factor | 0 basis/http/server/cgi/cgi.factor | 0 basis/http/server/server.factor | 0 basis/http/server/static/static.factor | 0 basis/inspector/inspector.factor | 0 basis/interval-maps/interval-maps-docs.factor | 0 basis/interval-maps/interval-maps-tests.factor | 0 basis/interval-maps/interval-maps.factor | 0 basis/io/buffers/buffers-docs.factor | 0 basis/io/buffers/buffers-tests.factor | 0 basis/io/buffers/buffers.factor | 0 basis/io/encodings/8-bit/8-bit.factor | 0 basis/io/encodings/ascii/ascii.factor | 0 basis/io/encodings/iana/iana.factor | 0 basis/io/encodings/utf16/utf16-tests.factor | 0 basis/io/encodings/utf16/utf16.factor | 0 basis/io/launcher/launcher-docs.factor | 0 basis/io/launcher/launcher-tests.factor | 0 basis/io/launcher/launcher.factor | 0 basis/io/mmap/mmap-docs.factor | 0 basis/io/mmap/mmap-tests.factor | 0 basis/io/mmap/mmap.factor | 0 basis/io/monitors/monitors-docs.factor | 0 basis/io/monitors/monitors-tests.factor | 0 basis/io/monitors/monitors.factor | 0 basis/io/pipes/pipes-tests.factor | 0 basis/io/ports/ports-docs.factor | 0 basis/io/ports/ports.factor | 0 basis/io/servers/connection/connection-docs.factor | 0 basis/io/servers/connection/connection-tests.factor | 0 basis/io/servers/connection/connection.factor | 0 basis/io/sockets/secure/secure-tests.factor | 0 basis/io/sockets/secure/secure.factor | 0 basis/io/sockets/sockets-docs.factor | 0 basis/io/sockets/sockets-tests.factor | 0 basis/io/sockets/sockets.factor | 0 basis/io/streams/duplex/duplex-docs.factor | 0 basis/io/streams/duplex/duplex-tests.factor | 0 basis/io/streams/duplex/duplex.factor | 0 basis/io/streams/null/null.factor | 0 basis/io/thread/thread.factor | 0 basis/io/timeouts/timeouts-docs.factor | 0 basis/io/timeouts/timeouts.factor | 0 basis/io/unix/backend/backend.factor | 0 basis/io/unix/bsd/bsd.factor | 0 basis/io/unix/files/files-tests.factor | 0 basis/io/unix/files/files.factor | 0 basis/io/unix/kqueue/kqueue.factor | 0 basis/io/unix/launcher/launcher-tests.factor | 0 basis/io/unix/launcher/launcher.factor | 0 basis/io/unix/launcher/parser/parser-tests.factor | 0 basis/io/unix/launcher/parser/parser.factor | 0 basis/io/unix/linux/linux.factor | 0 basis/io/unix/mmap/mmap.factor | 0 basis/io/unix/select/select.factor | 0 basis/io/unix/sockets/secure/secure.factor | 0 basis/io/unix/sockets/sockets.factor | 0 basis/io/unix/unix-tests.factor | 0 basis/io/unix/unix.factor | 0 basis/io/windows/files/files.factor | 0 basis/io/windows/files/unique/unique.factor | 0 basis/io/windows/launcher/launcher-tests.factor | 0 basis/io/windows/launcher/launcher.factor | 0 basis/io/windows/mmap/mmap.factor | 0 basis/io/windows/nt/backend/backend.factor | 0 basis/io/windows/nt/files/files-tests.factor | 0 basis/io/windows/nt/files/files.factor | 0 basis/io/windows/nt/launcher/launcher-tests.factor | 0 basis/io/windows/nt/launcher/launcher.factor | 0 basis/io/windows/nt/launcher/test/append.factor | 0 basis/io/windows/nt/launcher/test/env.factor | 0 basis/io/windows/nt/launcher/test/stderr.factor | 0 basis/io/windows/nt/monitors/monitors-tests.factor | 0 basis/io/windows/nt/monitors/monitors.factor | 0 basis/io/windows/nt/nt.factor | 0 basis/io/windows/nt/pipes/pipes.factor | 0 basis/io/windows/nt/privileges/privileges.factor | 0 basis/io/windows/nt/sockets/sockets.factor | 0 basis/io/windows/privileges/privileges.factor | 0 basis/io/windows/sockets/sockets.factor | 0 basis/io/windows/windows.factor | 0 basis/json/reader/reader.factor | 0 basis/lcs/lcs-docs.factor | 0 basis/lcs/lcs-tests.factor | 0 basis/lcs/lcs.factor | 0 basis/libc/libc-tests.factor | 0 basis/libc/libc.factor | 0 basis/listener/listener-docs.factor | 0 basis/listener/listener-tests.factor | 0 basis/listener/listener.factor | 0 basis/locals/locals-tests.factor | 0 basis/locals/locals.factor | 0 basis/logging/analysis/analysis.factor | 0 basis/logging/insomniac/insomniac-docs.factor | 0 basis/logging/insomniac/insomniac.factor | 0 basis/logging/logging-docs.factor | 0 basis/logging/logging.factor | 0 basis/logging/parser/parser.factor | 0 basis/logging/server/server.factor | 0 basis/macros/macros.factor | 0 basis/match/match-tests.factor | 0 basis/match/match.factor | 0 basis/math/bitwise/bitwise-tests.factor | 0 basis/math/complex/complex-docs.factor | 0 basis/math/complex/complex-tests.factor | 0 basis/math/complex/complex.factor | 0 basis/math/constants/constants-docs.factor | 0 basis/math/constants/constants.factor | 0 basis/math/functions/functions-docs.factor | 0 basis/math/functions/functions-tests.factor | 0 basis/math/functions/functions.factor | 0 basis/math/intervals/intervals-tests.factor | 0 basis/math/intervals/intervals.factor | 0 basis/math/libm/libm.factor | 0 basis/math/ranges/ranges.factor | 0 basis/math/ratios/ratios-docs.factor | 0 basis/math/ratios/ratios-tests.factor | 0 basis/math/ratios/ratios.factor | 0 basis/math/vectors/vectors-docs.factor | 0 basis/math/vectors/vectors.factor | 0 basis/memoize/memoize-docs.factor | 0 basis/memoize/memoize.factor | 0 basis/mime-types/mime-types.factor | 0 basis/mirrors/mirrors-docs.factor | 0 basis/mirrors/mirrors-tests.factor | 0 basis/mirrors/mirrors.factor | 0 basis/models/compose/compose-docs.factor | 0 basis/models/compose/compose-tests.factor | 0 basis/models/compose/compose.factor | 0 basis/models/delay/delay-docs.factor | 0 basis/models/delay/delay.factor | 0 basis/models/filter/filter-docs.factor | 0 basis/models/filter/filter-tests.factor | 0 basis/models/filter/filter.factor | 0 basis/models/history/history-docs.factor | 0 basis/models/history/history-tests.factor | 0 basis/models/history/history.factor | 0 basis/models/mapping/mapping-tests.factor | 0 basis/models/mapping/mapping.factor | 0 basis/models/models-docs.factor | 0 basis/models/models-tests.factor | 0 basis/models/models.factor | 0 basis/models/range/range-docs.factor | 0 basis/models/range/range-tests.factor | 0 basis/models/range/range.factor | 0 basis/multiline/multiline-tests.factor | 0 basis/multiline/multiline.factor | 0 basis/opengl/gl/windows/windows.factor | 0 basis/opengl/opengl.factor | 0 basis/openssl/libcrypto/libcrypto.factor | 0 basis/openssl/libssl/libssl.factor | 0 basis/openssl/openssl-tests.factor | 0 basis/openssl/openssl.factor | 0 basis/peg/parsers/parsers-docs.factor | 0 basis/peg/parsers/parsers.factor | 0 basis/peg/peg.factor | 0 basis/peg/search/search-docs.factor | 0 basis/peg/search/search-tests.factor | 0 basis/peg/search/search.factor | 0 basis/prettyprint/backend/backend-docs.factor | 0 basis/prettyprint/backend/backend.factor | 0 basis/prettyprint/prettyprint-docs.factor | 0 basis/prettyprint/prettyprint-tests.factor | 0 basis/prettyprint/prettyprint.factor | 0 basis/prettyprint/sections/sections-docs.factor | 0 basis/qualified/qualified-docs.factor | 0 basis/random/dummy/dummy.factor | 0 basis/random/mersenne-twister/mersenne-twister-tests.factor | 0 basis/random/mersenne-twister/mersenne-twister.factor | 0 basis/random/random.factor | 0 basis/sequences/deep/deep-tests.factor | 0 basis/sequences/next/next.factor | 0 basis/serialize/serialize-docs.factor | 0 basis/serialize/serialize-tests.factor | 0 basis/serialize/serialize.factor | 0 basis/shuffle/shuffle-tests.factor | 0 basis/smtp/server/server.factor | 0 basis/smtp/smtp-tests.factor | 0 basis/smtp/smtp.factor | 0 basis/stack-checker/backend/backend.factor | 0 basis/stack-checker/known-words/known-words.factor | 0 basis/stack-checker/stack-checker-docs.factor | 0 basis/stack-checker/stack-checker-tests.factor | 0 basis/stack-checker/stack-checker.factor | 0 basis/stack-checker/state/state.factor | 0 basis/stack-checker/transforms/transforms-docs.factor | 0 basis/stack-checker/transforms/transforms-tests.factor | 0 basis/stack-checker/transforms/transforms.factor | 0 basis/state-parser/state-parser-tests.factor | 0 basis/symbols/symbols-tests.factor | 0 basis/symbols/symbols.factor | 0 basis/syndication/syndication-tests.factor | 0 basis/threads/threads-docs.factor | 0 basis/threads/threads-tests.factor | 0 basis/threads/threads.factor | 0 basis/tools/annotations/annotations-docs.factor | 0 basis/tools/annotations/annotations-tests.factor | 0 basis/tools/annotations/annotations.factor | 0 basis/tools/completion/completion.factor | 0 basis/tools/crossref/crossref-tests.factor | 0 basis/tools/crossref/crossref.factor | 0 basis/tools/crossref/test/foo.factor | 0 basis/tools/deploy/backend/backend.factor | 0 basis/tools/deploy/config/config-docs.factor | 0 basis/tools/deploy/config/config.factor | 0 basis/tools/deploy/deploy-docs.factor | 0 basis/tools/deploy/deploy-tests.factor | 0 basis/tools/deploy/deploy.factor | 0 basis/tools/deploy/macosx/macosx.factor | 0 basis/tools/deploy/shaker/shaker.factor | 0 basis/tools/deploy/shaker/strip-cocoa.factor | 0 basis/tools/deploy/shaker/strip-debugger.factor | 0 basis/tools/deploy/shaker/strip-libc.factor | 0 basis/tools/deploy/test/1/1.factor | 0 basis/tools/deploy/test/1/deploy.factor | 0 basis/tools/deploy/test/2/2.factor | 0 basis/tools/deploy/test/2/deploy.factor | 0 basis/tools/deploy/test/3/3.factor | 0 basis/tools/deploy/test/3/deploy.factor | 0 basis/tools/deploy/windows/windows-tests.factor | 0 basis/tools/deploy/windows/windows.factor | 0 basis/tools/disassembler/disassembler-docs.factor | 0 basis/tools/disassembler/disassembler-tests.factor | 0 basis/tools/disassembler/disassembler.factor | 0 basis/tools/memory/memory-docs.factor | 0 basis/tools/memory/memory.factor | 0 basis/tools/profiler/profiler-docs.factor | 0 basis/tools/profiler/profiler-tests.factor | 0 basis/tools/profiler/profiler.factor | 0 basis/tools/test/test-docs.factor | 0 basis/tools/test/test.factor | 0 basis/tools/test/ui/ui.factor | 0 basis/tools/threads/threads.factor | 0 basis/tools/time/time-docs.factor | 0 basis/tools/vocabs/browser/browser-docs.factor | 0 basis/tools/vocabs/browser/browser-tests.factor | 0 basis/tools/vocabs/browser/browser.factor | 0 basis/tools/vocabs/monitor/monitor.factor | 0 basis/tools/vocabs/vocabs-docs.factor | 0 basis/tools/vocabs/vocabs.factor | 0 basis/tools/walker/debug/debug.factor | 0 basis/tools/walker/walker-tests.factor | 0 basis/tools/walker/walker.factor | 0 basis/tuple-arrays/tuple-arrays-tests.factor | 0 basis/ui/backend/backend.factor | 0 basis/ui/cocoa/cocoa.factor | 0 basis/ui/cocoa/tools/tools.factor | 0 basis/ui/cocoa/views/views.factor | 0 basis/ui/commands/commands.factor | 0 basis/ui/freetype/freetype-docs.factor | 0 basis/ui/freetype/freetype.factor | 0 basis/ui/gadgets/books/books-docs.factor | 0 basis/ui/gadgets/books/books-tests.factor | 0 basis/ui/gadgets/books/books.factor | 0 basis/ui/gadgets/buttons/buttons-docs.factor | 0 basis/ui/gadgets/buttons/buttons-tests.factor | 0 basis/ui/gadgets/buttons/buttons.factor | 0 basis/ui/gadgets/canvas/canvas-tests.factor | 0 basis/ui/gadgets/canvas/canvas.factor | 0 basis/ui/gadgets/editors/editors-docs.factor | 0 basis/ui/gadgets/editors/editors-tests.factor | 0 basis/ui/gadgets/editors/editors.factor | 0 basis/ui/gadgets/frames/frames-docs.factor | 0 basis/ui/gadgets/gadgets-docs.factor | 0 basis/ui/gadgets/gadgets-tests.factor | 0 basis/ui/gadgets/gadgets.factor | 0 basis/ui/gadgets/grid-lines/grid-lines-docs.factor | 0 basis/ui/gadgets/grid-lines/grid-lines.factor | 0 basis/ui/gadgets/grids/grids-docs.factor | 0 basis/ui/gadgets/incremental/incremental-docs.factor | 0 basis/ui/gadgets/incremental/incremental.factor | 0 basis/ui/gadgets/labelled/labelled-docs.factor | 0 basis/ui/gadgets/labelled/labelled.factor | 0 basis/ui/gadgets/labels/labels-docs.factor | 0 basis/ui/gadgets/labels/labels.factor | 0 basis/ui/gadgets/lists/lists-docs.factor | 0 basis/ui/gadgets/lists/lists.factor | 0 basis/ui/gadgets/menus/menus-docs.factor | 0 basis/ui/gadgets/packs/packs-docs.factor | 0 basis/ui/gadgets/packs/packs.factor | 0 basis/ui/gadgets/panes/panes-docs.factor | 0 basis/ui/gadgets/panes/panes-tests.factor | 0 basis/ui/gadgets/panes/panes.factor | 0 basis/ui/gadgets/presentations/presentations-docs.factor | 0 basis/ui/gadgets/scrollers/scrollers-docs.factor | 0 basis/ui/gadgets/scrollers/scrollers-tests.factor | 0 basis/ui/gadgets/scrollers/scrollers.factor | 0 basis/ui/gadgets/sliders/sliders-docs.factor | 0 basis/ui/gadgets/sliders/sliders.factor | 0 basis/ui/gadgets/slots/slots.factor | 0 basis/ui/gadgets/status-bar/status-bar-docs.factor | 0 basis/ui/gadgets/status-bar/status-bar.factor | 0 basis/ui/gadgets/tracks/tracks-docs.factor | 0 basis/ui/gadgets/viewports/viewports-docs.factor | 0 basis/ui/gadgets/viewports/viewports.factor | 0 basis/ui/gadgets/worlds/worlds-docs.factor | 0 basis/ui/gadgets/worlds/worlds.factor | 0 basis/ui/gestures/gestures.factor | 0 basis/ui/operations/operations-tests.factor | 0 basis/ui/operations/operations.factor | 0 basis/ui/render/render-docs.factor | 0 basis/ui/tools/browser/browser-tests.factor | 0 basis/ui/tools/browser/browser.factor | 0 basis/ui/tools/debugger/debugger-docs.factor | 0 basis/ui/tools/deploy/deploy-docs.factor | 0 basis/ui/tools/deploy/deploy.factor | 0 basis/ui/tools/interactor/interactor-docs.factor | 0 basis/ui/tools/interactor/interactor-tests.factor | 0 basis/ui/tools/interactor/interactor.factor | 0 basis/ui/tools/listener/listener-tests.factor | 0 basis/ui/tools/listener/listener.factor | 0 basis/ui/tools/operations/operations.factor | 0 basis/ui/tools/profiler/profiler.factor | 0 basis/ui/tools/search/search-tests.factor | 0 basis/ui/tools/search/search.factor | 0 basis/ui/tools/tools-docs.factor | 0 basis/ui/tools/tools-tests.factor | 0 basis/ui/tools/tools.factor | 0 basis/ui/tools/traceback/traceback.factor | 0 basis/ui/tools/walker/walker-docs.factor | 0 basis/ui/tools/walker/walker-tests.factor | 0 basis/ui/tools/walker/walker.factor | 0 basis/ui/tools/workspace/workspace-tests.factor | 0 basis/ui/tools/workspace/workspace.factor | 0 basis/ui/traverse/traverse-tests.factor | 0 basis/ui/ui-docs.factor | 0 basis/ui/ui.factor | 0 basis/ui/windows/windows.factor | 0 basis/ui/x11/x11.factor | 0 basis/unicode/breaks/breaks-tests.factor | 0 basis/unicode/breaks/breaks.factor | 0 basis/unicode/case/case-tests.factor | 0 basis/unicode/case/case.factor | 0 basis/unicode/collation/collation-tests.factor | 0 basis/unicode/collation/collation.factor | 0 basis/unicode/data/data.factor | 0 basis/unicode/normalize/normalize-tests.factor | 0 basis/unicode/normalize/normalize.factor | 0 basis/unicode/script/script-docs.factor | 0 basis/unicode/script/script-tests.factor | 0 basis/unicode/script/script.factor | 0 basis/unicode/syntax/syntax.factor | 0 basis/unix/bsd/bsd.factor | 0 basis/unix/linux/ifreq/ifreq.factor | 0 basis/unix/linux/linux.factor | 0 basis/unix/process/process.factor | 0 basis/unix/types/freebsd/freebsd.factor | 0 basis/unix/types/netbsd/32/32.factor | 0 basis/unix/types/netbsd/64/64.factor | 0 basis/unix/types/netbsd/netbsd.factor | 0 basis/unix/types/openbsd/openbsd.factor | 0 basis/unix/unix.factor | 0 basis/values/values-docs.factor | 0 basis/values/values-tests.factor | 0 basis/values/values.factor | 0 basis/windows/advapi32/advapi32.factor | 0 basis/windows/com/com-tests.factor | 0 basis/windows/com/com.factor | 0 basis/windows/com/syntax/syntax-docs.factor | 0 basis/windows/com/syntax/syntax.factor | 0 basis/windows/com/wrapper/wrapper-docs.factor | 0 basis/windows/com/wrapper/wrapper.factor | 0 basis/windows/dinput/constants/constants.factor | 0 basis/windows/dinput/dinput.factor | 0 basis/windows/gdi32/gdi32.factor | 0 basis/windows/kernel32/kernel32.factor | 0 basis/windows/messages/messages.factor | 0 basis/windows/ole32/ole32.factor | 0 basis/windows/opengl32/opengl32.factor | 0 basis/windows/user32/user32.factor | 0 basis/windows/winsock/winsock.factor | 0 basis/x11/clipboard/clipboard.factor | 0 basis/x11/windows/windows.factor | 0 basis/x11/xim/xim.factor | 0 basis/x11/xlib/xlib.factor | 0 basis/xml-rpc/xml-rpc.factor | 0 basis/xml/char-classes/char-classes.factor | 0 basis/xml/data/data.factor | 0 basis/xml/errors/errors-tests.factor | 0 basis/xml/tests/soap.factor | 0 basis/xml/utilities/utilities.factor | 0 basis/xmode/catalog/catalog.factor | 0 basis/xmode/code2html/code2html.factor | 0 basis/xmode/code2html/responder/responder.factor | 0 basis/xmode/loader/loader.factor | 0 basis/xmode/marker/marker-tests.factor | 0 basis/xmode/marker/marker.factor | 0 basis/xmode/marker/state/state.factor | 0 basis/xmode/rules/rules.factor | 0 basis/xmode/tokens/tokens.factor | 0 basis/xmode/utilities/utilities-tests.factor | 0 core/alien/alien-docs.factor | 0 core/alien/alien-tests.factor | 0 core/alien/alien.factor | 0 core/arrays/arrays-docs.factor | 0 core/arrays/arrays-tests.factor | 0 core/arrays/arrays.factor | 0 core/assocs/assocs-docs.factor | 0 core/assocs/assocs-tests.factor | 0 core/assocs/assocs.factor | 0 core/bootstrap/layouts/layouts.factor | 0 core/bootstrap/primitives.factor | 0 core/bootstrap/stage1.factor | 0 core/bootstrap/syntax.factor | 0 core/byte-arrays/byte-arrays-docs.factor | 0 core/byte-arrays/byte-arrays-tests.factor | 0 core/byte-arrays/byte-arrays.factor | 0 core/byte-vectors/byte-vectors-docs.factor | 0 core/byte-vectors/byte-vectors-tests.factor | 0 core/byte-vectors/byte-vectors.factor | 0 core/checksums/crc32/crc32.factor | 0 core/classes/algebra/algebra-docs.factor | 0 core/classes/algebra/algebra-tests.factor | 0 core/classes/algebra/algebra.factor | 0 core/classes/classes-docs.factor | 0 core/classes/classes-tests.factor | 0 core/classes/classes.factor | 0 core/classes/mixin/mixin-docs.factor | 0 core/classes/mixin/mixin.factor | 0 core/classes/predicate/predicate-docs.factor | 0 core/classes/predicate/predicate.factor | 0 core/classes/singleton/singleton.factor | 0 core/classes/tuple/tuple-docs.factor | 0 core/classes/tuple/tuple-tests.factor | 0 core/classes/tuple/tuple.factor | 0 core/classes/union/union-docs.factor | 0 core/classes/union/union.factor | 0 core/combinators/combinators-docs.factor | 0 core/combinators/combinators-tests.factor | 0 core/combinators/combinators.factor | 0 core/compiler/errors/errors-docs.factor | 0 core/compiler/errors/errors.factor | 0 core/compiler/units/units-docs.factor | 0 core/compiler/units/units.factor | 0 core/continuations/continuations-docs.factor | 0 core/continuations/continuations-tests.factor | 0 core/continuations/continuations.factor | 0 core/definitions/definitions-docs.factor | 0 core/definitions/definitions-tests.factor | 0 core/definitions/definitions.factor | 0 core/destructors/destructors-docs.factor | 0 core/destructors/destructors-tests.factor | 0 core/destructors/destructors.factor | 0 core/effects/effects.factor | 0 core/generic/generic-docs.factor | 0 core/generic/generic-tests.factor | 0 core/generic/generic.factor | 0 core/generic/math/math-docs.factor | 0 core/generic/math/math.factor | 0 core/growable/growable-docs.factor | 0 core/growable/growable-tests.factor | 0 core/hashtables/hashtables-docs.factor | 0 core/hashtables/hashtables-tests.factor | 0 core/hashtables/hashtables.factor | 0 core/init/init.factor | 0 core/io/backend/backend-tests.factor | 0 core/io/backend/backend.factor | 0 core/io/binary/binary-tests.factor | 0 core/io/binary/binary.factor | 0 core/io/encodings/binary/binary.factor | 0 core/io/encodings/encodings-tests.factor | 0 core/io/encodings/encodings.factor | 0 core/io/encodings/utf8/utf8-docs.factor | 0 core/io/encodings/utf8/utf8-tests.factor | 0 core/io/encodings/utf8/utf8.factor | 0 core/io/files/files-docs.factor | 0 core/io/files/files-tests.factor | 0 core/io/files/files.factor | 0 core/io/io-docs.factor | 0 core/io/io-tests.factor | 0 core/io/io.factor | 0 core/io/streams/c/c-docs.factor | 0 core/io/streams/c/c-tests.factor | 0 core/io/streams/c/c.factor | 0 core/io/streams/nested/nested.factor | 0 core/io/streams/string/string.factor | 0 core/kernel/kernel-docs.factor | 0 core/kernel/kernel-tests.factor | 0 core/kernel/kernel.factor | 0 core/layouts/layouts-docs.factor | 0 core/layouts/layouts-tests.factor | 0 core/layouts/layouts.factor | 0 core/math/floats/floats-tests.factor | 0 core/math/floats/floats.factor | 0 core/math/integers/integers-docs.factor | 0 core/math/integers/integers-tests.factor | 0 core/math/integers/integers.factor | 0 core/math/math-docs.factor | 0 core/math/math.factor | 0 core/math/parser/parser-tests.factor | 0 core/math/parser/parser.factor | 0 core/memory/memory-docs.factor | 0 core/memory/memory-tests.factor | 0 core/namespaces/namespaces-docs.factor | 0 core/parser/parser-docs.factor | 0 core/parser/parser-tests.factor | 0 core/parser/parser.factor | 0 core/parser/test/assert-depth.factor | 0 core/quotations/quotations-docs.factor | 0 core/quotations/quotations-tests.factor | 0 core/quotations/quotations.factor | 0 core/sbufs/sbufs.factor | 0 core/sequences/sequences-docs.factor | 0 core/sequences/sequences-tests.factor | 0 core/sequences/sequences.factor | 0 core/slots/slots-docs.factor | 0 core/slots/slots.factor | 0 core/sorting/sorting-tests.factor | 0 core/sorting/sorting.factor | 0 core/source-files/source-files-docs.factor | 0 core/source-files/source-files.factor | 0 core/splitting/splitting.factor | 0 core/strings/strings-docs.factor | 0 core/strings/strings-tests.factor | 0 core/strings/strings.factor | 0 core/syntax/syntax-docs.factor | 0 core/syntax/syntax.factor | 0 core/system/system-docs.factor | 0 core/system/system-tests.factor | 0 core/system/system.factor | 0 core/vectors/vectors-docs.factor | 0 core/vectors/vectors-tests.factor | 0 core/vectors/vectors.factor | 0 core/vocabs/loader/loader-docs.factor | 0 core/vocabs/loader/loader-tests.factor | 0 core/vocabs/loader/loader.factor | 0 core/vocabs/loader/test/a/a.factor | 0 core/vocabs/loader/test/b/b.factor | 0 core/vocabs/vocabs-docs.factor | 0 core/vocabs/vocabs.factor | 0 core/words/words-docs.factor | 0 core/words/words-tests.factor | 0 core/words/words.factor | 0 761 files changed, 0 insertions(+), 0 deletions(-) mode change 100755 => 100644 basis/alarms/alarms-docs.factor mode change 100755 => 100644 basis/alarms/alarms-tests.factor mode change 100755 => 100644 basis/alarms/alarms.factor mode change 100755 => 100644 basis/alias/alias.factor mode change 100755 => 100644 basis/alien/arrays/arrays-docs.factor mode change 100755 => 100644 basis/alien/c-types/c-types-docs.factor mode change 100755 => 100644 basis/alien/c-types/c-types-tests.factor mode change 100755 => 100644 basis/alien/c-types/c-types.factor mode change 100755 => 100644 basis/alien/remote-control/remote-control.factor mode change 100755 => 100644 basis/alien/strings/strings.factor mode change 100755 => 100644 basis/alien/structs/structs-docs.factor mode change 100755 => 100644 basis/alien/structs/structs.factor mode change 100755 => 100644 basis/alien/syntax/syntax-docs.factor mode change 100755 => 100644 basis/alien/syntax/syntax.factor mode change 100755 => 100644 basis/ascii/ascii-docs.factor mode change 100755 => 100644 basis/ascii/ascii.factor mode change 100755 => 100644 basis/bit-arrays/bit-arrays-tests.factor mode change 100755 => 100644 basis/bit-arrays/bit-arrays.factor mode change 100755 => 100644 basis/bit-vectors/bit-vectors-docs.factor mode change 100755 => 100644 basis/bit-vectors/bit-vectors-tests.factor mode change 100755 => 100644 basis/bit-vectors/bit-vectors.factor mode change 100755 => 100644 basis/bootstrap/compiler/compiler.factor mode change 100755 => 100644 basis/bootstrap/handbook/handbook.factor mode change 100755 => 100644 basis/bootstrap/help/help.factor mode change 100755 => 100644 basis/bootstrap/image/image-tests.factor mode change 100755 => 100644 basis/bootstrap/image/image.factor mode change 100755 => 100644 basis/bootstrap/image/upload/upload.factor mode change 100755 => 100644 basis/bootstrap/io/io.factor mode change 100755 => 100644 basis/bootstrap/random/random.factor mode change 100755 => 100644 basis/bootstrap/stage2.factor mode change 100755 => 100644 basis/bootstrap/tools/tools.factor mode change 100755 => 100644 basis/bootstrap/ui/tools/tools.factor mode change 100755 => 100644 basis/bootstrap/unicode/unicode.factor mode change 100755 => 100644 basis/boxes/boxes-docs.factor mode change 100755 => 100644 basis/boxes/boxes-tests.factor mode change 100755 => 100644 basis/boxes/boxes.factor mode change 100755 => 100644 basis/calendar/calendar-tests.factor mode change 100755 => 100644 basis/calendar/calendar.factor mode change 100755 => 100644 basis/calendar/format/format-tests.factor mode change 100755 => 100644 basis/calendar/format/format.factor mode change 100755 => 100644 basis/calendar/model/model.factor mode change 100755 => 100644 basis/calendar/windows/windows.factor mode change 100755 => 100644 basis/channels/channels-tests.factor mode change 100755 => 100644 basis/channels/channels.factor mode change 100755 => 100644 basis/channels/examples/examples.factor mode change 100755 => 100644 basis/channels/remote/remote.factor mode change 100755 => 100644 basis/checksums/adler-32/adler-32-docs.factor mode change 100755 => 100644 basis/checksums/md5/md5-docs.factor mode change 100755 => 100644 basis/checksums/md5/md5-tests.factor mode change 100755 => 100644 basis/checksums/md5/md5.factor mode change 100755 => 100644 basis/checksums/sha1/sha1-tests.factor mode change 100755 => 100644 basis/checksums/sha1/sha1.factor mode change 100755 => 100644 basis/checksums/sha2/sha2-tests.factor mode change 100755 => 100644 basis/checksums/sha2/sha2.factor mode change 100755 => 100644 basis/circular/circular-tests.factor mode change 100755 => 100644 basis/circular/circular.factor mode change 100755 => 100644 basis/cocoa/application/application.factor mode change 100755 => 100644 basis/cocoa/cocoa.factor mode change 100755 => 100644 basis/cocoa/messages/messages.factor mode change 100755 => 100644 basis/cocoa/pasteboard/pasteboard.factor mode change 100755 => 100644 basis/cocoa/subclassing/subclassing.factor mode change 100755 => 100644 basis/cocoa/windows/windows.factor mode change 100755 => 100644 basis/combinators/short-circuit/short-circuit.factor mode change 100755 => 100644 basis/compiler/compiler-docs.factor mode change 100755 => 100644 basis/compiler/compiler.factor mode change 100755 => 100644 basis/compiler/constants/constants.factor mode change 100755 => 100644 basis/compiler/generator/fixup/fixup.factor mode change 100755 => 100644 basis/compiler/generator/generator-docs.factor mode change 100755 => 100644 basis/compiler/generator/generator.factor mode change 100755 => 100644 basis/compiler/generator/registers/registers.factor mode change 100755 => 100644 basis/compiler/tests/alien.factor mode change 100755 => 100644 basis/compiler/tests/curry.factor mode change 100755 => 100644 basis/compiler/tests/float.factor mode change 100755 => 100644 basis/compiler/tests/intrinsics.factor mode change 100755 => 100644 basis/compiler/tests/optimizer.factor mode change 100755 => 100644 basis/compiler/tests/simple.factor mode change 100755 => 100644 basis/compiler/tests/stack-trace.factor mode change 100755 => 100644 basis/compiler/tests/templates-early.factor mode change 100755 => 100644 basis/compiler/tests/templates.factor mode change 100755 => 100644 basis/compiler/tests/tuples.factor mode change 100755 => 100644 basis/compiler/tree/dead-code/simple/simple.factor mode change 100755 => 100644 basis/compiler/tree/def-use/def-use-tests.factor mode change 100755 => 100644 basis/compiler/tree/def-use/def-use.factor mode change 100755 => 100644 basis/compiler/tree/propagation/propagation.factor mode change 100755 => 100644 basis/compiler/tree/tree.factor mode change 100755 => 100644 basis/concurrency/combinators/combinators-docs.factor mode change 100755 => 100644 basis/concurrency/combinators/combinators-tests.factor mode change 100755 => 100644 basis/concurrency/combinators/combinators.factor mode change 100755 => 100644 basis/concurrency/conditions/conditions.factor mode change 100755 => 100644 basis/concurrency/count-downs/count-downs-docs.factor mode change 100755 => 100644 basis/concurrency/count-downs/count-downs-tests.factor mode change 100755 => 100644 basis/concurrency/count-downs/count-downs.factor mode change 100755 => 100644 basis/concurrency/distributed/distributed-docs.factor mode change 100755 => 100644 basis/concurrency/distributed/distributed-tests.factor mode change 100755 => 100644 basis/concurrency/distributed/distributed.factor mode change 100755 => 100644 basis/concurrency/exchangers/exchangers-docs.factor mode change 100755 => 100644 basis/concurrency/exchangers/exchangers-tests.factor mode change 100755 => 100644 basis/concurrency/exchangers/exchangers.factor mode change 100755 => 100644 basis/concurrency/flags/flags-tests.factor mode change 100755 => 100644 basis/concurrency/flags/flags.factor mode change 100755 => 100644 basis/concurrency/futures/futures-docs.factor mode change 100755 => 100644 basis/concurrency/futures/futures-tests.factor mode change 100755 => 100644 basis/concurrency/futures/futures.factor mode change 100755 => 100644 basis/concurrency/locks/locks-docs.factor mode change 100755 => 100644 basis/concurrency/locks/locks-tests.factor mode change 100755 => 100644 basis/concurrency/locks/locks.factor mode change 100755 => 100644 basis/concurrency/mailboxes/mailboxes-docs.factor mode change 100755 => 100644 basis/concurrency/mailboxes/mailboxes-tests.factor mode change 100755 => 100644 basis/concurrency/mailboxes/mailboxes.factor mode change 100755 => 100644 basis/concurrency/messaging/messaging-docs.factor mode change 100755 => 100644 basis/concurrency/messaging/messaging-tests.factor mode change 100755 => 100644 basis/concurrency/messaging/messaging.factor mode change 100755 => 100644 basis/concurrency/promises/promises-docs.factor mode change 100755 => 100644 basis/concurrency/promises/promises-tests.factor mode change 100755 => 100644 basis/concurrency/promises/promises.factor mode change 100755 => 100644 basis/concurrency/semaphores/semaphores-docs.factor mode change 100755 => 100644 basis/concurrency/semaphores/semaphores.factor mode change 100755 => 100644 basis/cpu/architecture/architecture.factor mode change 100755 => 100644 basis/cpu/ppc/allot/allot.factor mode change 100755 => 100644 basis/cpu/ppc/architecture/architecture.factor mode change 100755 => 100644 basis/cpu/ppc/assembler/assembler.factor mode change 100755 => 100644 basis/cpu/ppc/bootstrap.factor mode change 100755 => 100644 basis/cpu/ppc/intrinsics/intrinsics.factor mode change 100755 => 100644 basis/cpu/ppc/linux/bootstrap.factor mode change 100755 => 100644 basis/cpu/ppc/macosx/bootstrap.factor mode change 100755 => 100644 basis/cpu/ppc/ppc.factor mode change 100755 => 100644 basis/cpu/x86/32/32.factor mode change 100755 => 100644 basis/cpu/x86/32/bootstrap.factor mode change 100755 => 100644 basis/cpu/x86/64/64.factor mode change 100755 => 100644 basis/cpu/x86/64/bootstrap.factor mode change 100755 => 100644 basis/cpu/x86/allot/allot.factor mode change 100755 => 100644 basis/cpu/x86/architecture/architecture.factor mode change 100755 => 100644 basis/cpu/x86/assembler/assembler.factor mode change 100755 => 100644 basis/cpu/x86/bootstrap.factor mode change 100755 => 100644 basis/cpu/x86/intrinsics/intrinsics.factor mode change 100755 => 100644 basis/cpu/x86/sse2/sse2.factor mode change 100755 => 100644 basis/db/db-tests.factor mode change 100755 => 100644 basis/db/db.factor mode change 100755 => 100644 basis/db/postgresql/ffi/ffi.factor mode change 100755 => 100644 basis/db/postgresql/lib/lib.factor mode change 100755 => 100644 basis/db/postgresql/postgresql-tests.factor mode change 100755 => 100644 basis/db/postgresql/postgresql.factor mode change 100755 => 100644 basis/db/sqlite/ffi/ffi.factor mode change 100755 => 100644 basis/db/sqlite/lib/lib.factor mode change 100755 => 100644 basis/db/sqlite/sqlite-tests.factor mode change 100755 => 100644 basis/db/sqlite/sqlite.factor mode change 100755 => 100644 basis/db/tuples/tuples-tests.factor mode change 100755 => 100644 basis/db/tuples/tuples.factor mode change 100755 => 100644 basis/db/types/types.factor mode change 100755 => 100644 basis/debugger/debugger-docs.factor mode change 100755 => 100644 basis/debugger/debugger-tests.factor mode change 100755 => 100644 basis/debugger/debugger.factor mode change 100755 => 100644 basis/delegate/delegate-tests.factor mode change 100755 => 100644 basis/delegate/delegate.factor mode change 100755 => 100644 basis/delegate/protocols/protocols.factor mode change 100755 => 100644 basis/dlists/dlists-docs.factor mode change 100755 => 100644 basis/dlists/dlists-tests.factor mode change 100755 => 100644 basis/dlists/dlists.factor mode change 100755 => 100644 basis/documents/documents.factor mode change 100755 => 100644 basis/editors/editors.factor mode change 100755 => 100644 basis/editors/editpadpro/editpadpro.factor mode change 100755 => 100644 basis/editors/editplus/editplus.factor mode change 100755 => 100644 basis/editors/emacs/emacs.factor mode change 100755 => 100644 basis/editors/emeditor/emeditor.factor mode change 100755 => 100644 basis/editors/gvim/gvim.factor mode change 100755 => 100644 basis/editors/gvim/windows/windows.factor mode change 100755 => 100644 basis/editors/jedit/jedit.factor mode change 100755 => 100644 basis/editors/macvim/macvim.factor mode change 100755 => 100644 basis/editors/notepadpp/notepadpp.factor mode change 100755 => 100644 basis/editors/scite/scite.factor mode change 100755 => 100644 basis/editors/ted-notepad/ted-notepad.factor mode change 100755 => 100644 basis/editors/textedit/textedit.factor mode change 100755 => 100644 basis/editors/textmate/textmate.factor mode change 100755 => 100644 basis/editors/ultraedit/ultraedit.factor mode change 100755 => 100644 basis/editors/vim/vim.factor mode change 100755 => 100644 basis/editors/wordpad/wordpad.factor mode change 100755 => 100644 basis/float-arrays/float-arrays-tests.factor mode change 100755 => 100644 basis/float-arrays/float-arrays.factor mode change 100755 => 100644 basis/float-vectors/float-vectors-docs.factor mode change 100755 => 100644 basis/float-vectors/float-vectors-tests.factor mode change 100755 => 100644 basis/float-vectors/float-vectors.factor mode change 100755 => 100644 basis/freetype/freetype.factor mode change 100755 => 100644 basis/fry/fry-docs.factor mode change 100755 => 100644 basis/fry/fry-tests.factor mode change 100755 => 100644 basis/fry/fry.factor mode change 100755 => 100644 basis/furnace/actions/actions-tests.factor mode change 100755 => 100644 basis/furnace/actions/actions.factor mode change 100755 => 100644 basis/furnace/auth/auth.factor mode change 100755 => 100644 basis/furnace/auth/basic/basic.factor mode change 100755 => 100644 basis/furnace/auth/login/login-tests.factor mode change 100755 => 100644 basis/furnace/auth/login/login.factor mode change 100755 => 100644 basis/furnace/auth/providers/assoc/assoc-tests.factor mode change 100755 => 100644 basis/furnace/auth/providers/assoc/assoc.factor mode change 100755 => 100644 basis/furnace/auth/providers/db/db-tests.factor mode change 100755 => 100644 basis/furnace/auth/providers/db/db.factor mode change 100755 => 100644 basis/furnace/auth/providers/null/null.factor mode change 100755 => 100644 basis/furnace/auth/providers/providers.factor mode change 100755 => 100644 basis/furnace/db/db.factor mode change 100755 => 100644 basis/furnace/sessions/sessions-tests.factor mode change 100755 => 100644 basis/furnace/sessions/sessions.factor mode change 100755 => 100644 basis/generalizations/generalizations-docs.factor mode change 100755 => 100644 basis/generalizations/generalizations-tests.factor mode change 100755 => 100644 basis/generalizations/generalizations.factor mode change 100755 => 100644 basis/globs/globs.factor mode change 100755 => 100644 basis/hash2/hash2-tests.factor mode change 100755 => 100644 basis/heaps/heaps-docs.factor mode change 100755 => 100644 basis/heaps/heaps-tests.factor mode change 100755 => 100644 basis/heaps/heaps.factor mode change 100755 => 100644 basis/help/cookbook/cookbook.factor mode change 100755 => 100644 basis/help/crossref/crossref-tests.factor mode change 100755 => 100644 basis/help/definitions/definitions-tests.factor mode change 100755 => 100644 basis/help/definitions/definitions.factor mode change 100755 => 100644 basis/help/handbook/handbook.factor mode change 100755 => 100644 basis/help/help-docs.factor mode change 100755 => 100644 basis/help/help.factor mode change 100755 => 100644 basis/help/lint/lint.factor mode change 100755 => 100644 basis/help/markup/markup.factor mode change 100755 => 100644 basis/help/stylesheet/stylesheet.factor mode change 100755 => 100644 basis/help/syntax/syntax-tests.factor mode change 100755 => 100644 basis/help/syntax/syntax.factor mode change 100755 => 100644 basis/help/topics/topics.factor mode change 100755 => 100644 basis/help/tutorial/tutorial.factor mode change 100755 => 100644 basis/html/streams/streams.factor mode change 100755 => 100644 basis/html/templates/fhtml/fhtml-tests.factor mode change 100755 => 100644 basis/html/templates/fhtml/fhtml.factor mode change 100755 => 100644 basis/http/client/client-tests.factor mode change 100755 => 100644 basis/http/client/client.factor mode change 100755 => 100644 basis/http/http-tests.factor mode change 100755 => 100644 basis/http/http.factor mode change 100755 => 100644 basis/http/server/cgi/cgi.factor mode change 100755 => 100644 basis/http/server/server.factor mode change 100755 => 100644 basis/http/server/static/static.factor mode change 100755 => 100644 basis/inspector/inspector.factor mode change 100755 => 100644 basis/interval-maps/interval-maps-docs.factor mode change 100755 => 100644 basis/interval-maps/interval-maps-tests.factor mode change 100755 => 100644 basis/interval-maps/interval-maps.factor mode change 100755 => 100644 basis/io/buffers/buffers-docs.factor mode change 100755 => 100644 basis/io/buffers/buffers-tests.factor mode change 100755 => 100644 basis/io/buffers/buffers.factor mode change 100755 => 100644 basis/io/encodings/8-bit/8-bit.factor mode change 100755 => 100644 basis/io/encodings/ascii/ascii.factor mode change 100755 => 100644 basis/io/encodings/iana/iana.factor mode change 100755 => 100644 basis/io/encodings/utf16/utf16-tests.factor mode change 100755 => 100644 basis/io/encodings/utf16/utf16.factor mode change 100755 => 100644 basis/io/launcher/launcher-docs.factor mode change 100755 => 100644 basis/io/launcher/launcher-tests.factor mode change 100755 => 100644 basis/io/launcher/launcher.factor mode change 100755 => 100644 basis/io/mmap/mmap-docs.factor mode change 100755 => 100644 basis/io/mmap/mmap-tests.factor mode change 100755 => 100644 basis/io/mmap/mmap.factor mode change 100755 => 100644 basis/io/monitors/monitors-docs.factor mode change 100755 => 100644 basis/io/monitors/monitors-tests.factor mode change 100755 => 100644 basis/io/monitors/monitors.factor mode change 100755 => 100644 basis/io/pipes/pipes-tests.factor mode change 100755 => 100644 basis/io/ports/ports-docs.factor mode change 100755 => 100644 basis/io/ports/ports.factor mode change 100755 => 100644 basis/io/servers/connection/connection-docs.factor mode change 100755 => 100644 basis/io/servers/connection/connection-tests.factor mode change 100755 => 100644 basis/io/servers/connection/connection.factor mode change 100755 => 100644 basis/io/sockets/secure/secure-tests.factor mode change 100755 => 100644 basis/io/sockets/secure/secure.factor mode change 100755 => 100644 basis/io/sockets/sockets-docs.factor mode change 100755 => 100644 basis/io/sockets/sockets-tests.factor mode change 100755 => 100644 basis/io/sockets/sockets.factor mode change 100755 => 100644 basis/io/streams/duplex/duplex-docs.factor mode change 100755 => 100644 basis/io/streams/duplex/duplex-tests.factor mode change 100755 => 100644 basis/io/streams/duplex/duplex.factor mode change 100755 => 100644 basis/io/streams/null/null.factor mode change 100755 => 100644 basis/io/thread/thread.factor mode change 100755 => 100644 basis/io/timeouts/timeouts-docs.factor mode change 100755 => 100644 basis/io/timeouts/timeouts.factor mode change 100755 => 100644 basis/io/unix/backend/backend.factor mode change 100755 => 100644 basis/io/unix/bsd/bsd.factor mode change 100755 => 100644 basis/io/unix/files/files-tests.factor mode change 100755 => 100644 basis/io/unix/files/files.factor mode change 100755 => 100644 basis/io/unix/kqueue/kqueue.factor mode change 100755 => 100644 basis/io/unix/launcher/launcher-tests.factor mode change 100755 => 100644 basis/io/unix/launcher/launcher.factor mode change 100755 => 100644 basis/io/unix/launcher/parser/parser-tests.factor mode change 100755 => 100644 basis/io/unix/launcher/parser/parser.factor mode change 100755 => 100644 basis/io/unix/linux/linux.factor mode change 100755 => 100644 basis/io/unix/mmap/mmap.factor mode change 100755 => 100644 basis/io/unix/select/select.factor mode change 100755 => 100644 basis/io/unix/sockets/secure/secure.factor mode change 100755 => 100644 basis/io/unix/sockets/sockets.factor mode change 100755 => 100644 basis/io/unix/unix-tests.factor mode change 100755 => 100644 basis/io/unix/unix.factor mode change 100755 => 100644 basis/io/windows/files/files.factor mode change 100755 => 100644 basis/io/windows/files/unique/unique.factor mode change 100755 => 100644 basis/io/windows/launcher/launcher-tests.factor mode change 100755 => 100644 basis/io/windows/launcher/launcher.factor mode change 100755 => 100644 basis/io/windows/mmap/mmap.factor mode change 100755 => 100644 basis/io/windows/nt/backend/backend.factor mode change 100755 => 100644 basis/io/windows/nt/files/files-tests.factor mode change 100755 => 100644 basis/io/windows/nt/files/files.factor mode change 100755 => 100644 basis/io/windows/nt/launcher/launcher-tests.factor mode change 100755 => 100644 basis/io/windows/nt/launcher/launcher.factor mode change 100755 => 100644 basis/io/windows/nt/launcher/test/append.factor mode change 100755 => 100644 basis/io/windows/nt/launcher/test/env.factor mode change 100755 => 100644 basis/io/windows/nt/launcher/test/stderr.factor mode change 100755 => 100644 basis/io/windows/nt/monitors/monitors-tests.factor mode change 100755 => 100644 basis/io/windows/nt/monitors/monitors.factor mode change 100755 => 100644 basis/io/windows/nt/nt.factor mode change 100755 => 100644 basis/io/windows/nt/pipes/pipes.factor mode change 100755 => 100644 basis/io/windows/nt/privileges/privileges.factor mode change 100755 => 100644 basis/io/windows/nt/sockets/sockets.factor mode change 100755 => 100644 basis/io/windows/privileges/privileges.factor mode change 100755 => 100644 basis/io/windows/sockets/sockets.factor mode change 100755 => 100644 basis/io/windows/windows.factor mode change 100755 => 100644 basis/json/reader/reader.factor mode change 100755 => 100644 basis/lcs/lcs-docs.factor mode change 100755 => 100644 basis/lcs/lcs-tests.factor mode change 100755 => 100644 basis/lcs/lcs.factor mode change 100755 => 100644 basis/libc/libc-tests.factor mode change 100755 => 100644 basis/libc/libc.factor mode change 100755 => 100644 basis/listener/listener-docs.factor mode change 100755 => 100644 basis/listener/listener-tests.factor mode change 100755 => 100644 basis/listener/listener.factor mode change 100755 => 100644 basis/locals/locals-tests.factor mode change 100755 => 100644 basis/locals/locals.factor mode change 100755 => 100644 basis/logging/analysis/analysis.factor mode change 100755 => 100644 basis/logging/insomniac/insomniac-docs.factor mode change 100755 => 100644 basis/logging/insomniac/insomniac.factor mode change 100755 => 100644 basis/logging/logging-docs.factor mode change 100755 => 100644 basis/logging/logging.factor mode change 100755 => 100644 basis/logging/parser/parser.factor mode change 100755 => 100644 basis/logging/server/server.factor mode change 100755 => 100644 basis/macros/macros.factor mode change 100755 => 100644 basis/match/match-tests.factor mode change 100755 => 100644 basis/match/match.factor mode change 100755 => 100644 basis/math/bitwise/bitwise-tests.factor mode change 100755 => 100644 basis/math/complex/complex-docs.factor mode change 100755 => 100644 basis/math/complex/complex-tests.factor mode change 100755 => 100644 basis/math/complex/complex.factor mode change 100755 => 100644 basis/math/constants/constants-docs.factor mode change 100755 => 100644 basis/math/constants/constants.factor mode change 100755 => 100644 basis/math/functions/functions-docs.factor mode change 100755 => 100644 basis/math/functions/functions-tests.factor mode change 100755 => 100644 basis/math/functions/functions.factor mode change 100755 => 100644 basis/math/intervals/intervals-tests.factor mode change 100755 => 100644 basis/math/intervals/intervals.factor mode change 100755 => 100644 basis/math/libm/libm.factor mode change 100755 => 100644 basis/math/ranges/ranges.factor mode change 100755 => 100644 basis/math/ratios/ratios-docs.factor mode change 100755 => 100644 basis/math/ratios/ratios-tests.factor mode change 100755 => 100644 basis/math/ratios/ratios.factor mode change 100755 => 100644 basis/math/vectors/vectors-docs.factor mode change 100755 => 100644 basis/math/vectors/vectors.factor mode change 100755 => 100644 basis/memoize/memoize-docs.factor mode change 100755 => 100644 basis/memoize/memoize.factor mode change 100755 => 100644 basis/mime-types/mime-types.factor mode change 100755 => 100644 basis/mirrors/mirrors-docs.factor mode change 100755 => 100644 basis/mirrors/mirrors-tests.factor mode change 100755 => 100644 basis/mirrors/mirrors.factor mode change 100755 => 100644 basis/models/compose/compose-docs.factor mode change 100755 => 100644 basis/models/compose/compose-tests.factor mode change 100755 => 100644 basis/models/compose/compose.factor mode change 100755 => 100644 basis/models/delay/delay-docs.factor mode change 100755 => 100644 basis/models/delay/delay.factor mode change 100755 => 100644 basis/models/filter/filter-docs.factor mode change 100755 => 100644 basis/models/filter/filter-tests.factor mode change 100755 => 100644 basis/models/filter/filter.factor mode change 100755 => 100644 basis/models/history/history-docs.factor mode change 100755 => 100644 basis/models/history/history-tests.factor mode change 100755 => 100644 basis/models/history/history.factor mode change 100755 => 100644 basis/models/mapping/mapping-tests.factor mode change 100755 => 100644 basis/models/mapping/mapping.factor mode change 100755 => 100644 basis/models/models-docs.factor mode change 100755 => 100644 basis/models/models-tests.factor mode change 100755 => 100644 basis/models/models.factor mode change 100755 => 100644 basis/models/range/range-docs.factor mode change 100755 => 100644 basis/models/range/range-tests.factor mode change 100755 => 100644 basis/models/range/range.factor mode change 100755 => 100644 basis/multiline/multiline-tests.factor mode change 100755 => 100644 basis/multiline/multiline.factor mode change 100755 => 100644 basis/opengl/gl/windows/windows.factor mode change 100755 => 100644 basis/opengl/opengl.factor mode change 100755 => 100644 basis/openssl/libcrypto/libcrypto.factor mode change 100755 => 100644 basis/openssl/libssl/libssl.factor mode change 100755 => 100644 basis/openssl/openssl-tests.factor mode change 100755 => 100644 basis/openssl/openssl.factor mode change 100755 => 100644 basis/peg/parsers/parsers-docs.factor mode change 100755 => 100644 basis/peg/parsers/parsers.factor mode change 100755 => 100644 basis/peg/peg.factor mode change 100755 => 100644 basis/peg/search/search-docs.factor mode change 100755 => 100644 basis/peg/search/search-tests.factor mode change 100755 => 100644 basis/peg/search/search.factor mode change 100755 => 100644 basis/prettyprint/backend/backend-docs.factor mode change 100755 => 100644 basis/prettyprint/backend/backend.factor mode change 100755 => 100644 basis/prettyprint/prettyprint-docs.factor mode change 100755 => 100644 basis/prettyprint/prettyprint-tests.factor mode change 100755 => 100644 basis/prettyprint/prettyprint.factor mode change 100755 => 100644 basis/prettyprint/sections/sections-docs.factor mode change 100755 => 100644 basis/qualified/qualified-docs.factor mode change 100755 => 100644 basis/random/dummy/dummy.factor mode change 100755 => 100644 basis/random/mersenne-twister/mersenne-twister-tests.factor mode change 100755 => 100644 basis/random/mersenne-twister/mersenne-twister.factor mode change 100755 => 100644 basis/random/random.factor mode change 100755 => 100644 basis/sequences/deep/deep-tests.factor mode change 100755 => 100644 basis/sequences/next/next.factor mode change 100755 => 100644 basis/serialize/serialize-docs.factor mode change 100755 => 100644 basis/serialize/serialize-tests.factor mode change 100755 => 100644 basis/serialize/serialize.factor mode change 100755 => 100644 basis/shuffle/shuffle-tests.factor mode change 100755 => 100644 basis/smtp/server/server.factor mode change 100755 => 100644 basis/smtp/smtp-tests.factor mode change 100755 => 100644 basis/smtp/smtp.factor mode change 100755 => 100644 basis/stack-checker/backend/backend.factor mode change 100755 => 100644 basis/stack-checker/known-words/known-words.factor mode change 100755 => 100644 basis/stack-checker/stack-checker-docs.factor mode change 100755 => 100644 basis/stack-checker/stack-checker-tests.factor mode change 100755 => 100644 basis/stack-checker/stack-checker.factor mode change 100755 => 100644 basis/stack-checker/state/state.factor mode change 100755 => 100644 basis/stack-checker/transforms/transforms-docs.factor mode change 100755 => 100644 basis/stack-checker/transforms/transforms-tests.factor mode change 100755 => 100644 basis/stack-checker/transforms/transforms.factor mode change 100755 => 100644 basis/state-parser/state-parser-tests.factor mode change 100755 => 100644 basis/symbols/symbols-tests.factor mode change 100755 => 100644 basis/symbols/symbols.factor mode change 100755 => 100644 basis/syndication/syndication-tests.factor mode change 100755 => 100644 basis/threads/threads-docs.factor mode change 100755 => 100644 basis/threads/threads-tests.factor mode change 100755 => 100644 basis/threads/threads.factor mode change 100755 => 100644 basis/tools/annotations/annotations-docs.factor mode change 100755 => 100644 basis/tools/annotations/annotations-tests.factor mode change 100755 => 100644 basis/tools/annotations/annotations.factor mode change 100755 => 100644 basis/tools/completion/completion.factor mode change 100755 => 100644 basis/tools/crossref/crossref-tests.factor mode change 100755 => 100644 basis/tools/crossref/crossref.factor mode change 100755 => 100644 basis/tools/crossref/test/foo.factor mode change 100755 => 100644 basis/tools/deploy/backend/backend.factor mode change 100755 => 100644 basis/tools/deploy/config/config-docs.factor mode change 100755 => 100644 basis/tools/deploy/config/config.factor mode change 100755 => 100644 basis/tools/deploy/deploy-docs.factor mode change 100755 => 100644 basis/tools/deploy/deploy-tests.factor mode change 100755 => 100644 basis/tools/deploy/deploy.factor mode change 100755 => 100644 basis/tools/deploy/macosx/macosx.factor mode change 100755 => 100644 basis/tools/deploy/shaker/shaker.factor mode change 100755 => 100644 basis/tools/deploy/shaker/strip-cocoa.factor mode change 100755 => 100644 basis/tools/deploy/shaker/strip-debugger.factor mode change 100755 => 100644 basis/tools/deploy/shaker/strip-libc.factor mode change 100755 => 100644 basis/tools/deploy/test/1/1.factor mode change 100755 => 100644 basis/tools/deploy/test/1/deploy.factor mode change 100755 => 100644 basis/tools/deploy/test/2/2.factor mode change 100755 => 100644 basis/tools/deploy/test/2/deploy.factor mode change 100755 => 100644 basis/tools/deploy/test/3/3.factor mode change 100755 => 100644 basis/tools/deploy/test/3/deploy.factor mode change 100755 => 100644 basis/tools/deploy/windows/windows-tests.factor mode change 100755 => 100644 basis/tools/deploy/windows/windows.factor mode change 100755 => 100644 basis/tools/disassembler/disassembler-docs.factor mode change 100755 => 100644 basis/tools/disassembler/disassembler-tests.factor mode change 100755 => 100644 basis/tools/disassembler/disassembler.factor mode change 100755 => 100644 basis/tools/memory/memory-docs.factor mode change 100755 => 100644 basis/tools/memory/memory.factor mode change 100755 => 100644 basis/tools/profiler/profiler-docs.factor mode change 100755 => 100644 basis/tools/profiler/profiler-tests.factor mode change 100755 => 100644 basis/tools/profiler/profiler.factor mode change 100755 => 100644 basis/tools/test/test-docs.factor mode change 100755 => 100644 basis/tools/test/test.factor mode change 100755 => 100644 basis/tools/test/ui/ui.factor mode change 100755 => 100644 basis/tools/threads/threads.factor mode change 100755 => 100644 basis/tools/time/time-docs.factor mode change 100755 => 100644 basis/tools/vocabs/browser/browser-docs.factor mode change 100755 => 100644 basis/tools/vocabs/browser/browser-tests.factor mode change 100755 => 100644 basis/tools/vocabs/browser/browser.factor mode change 100755 => 100644 basis/tools/vocabs/monitor/monitor.factor mode change 100755 => 100644 basis/tools/vocabs/vocabs-docs.factor mode change 100755 => 100644 basis/tools/vocabs/vocabs.factor mode change 100755 => 100644 basis/tools/walker/debug/debug.factor mode change 100755 => 100644 basis/tools/walker/walker-tests.factor mode change 100755 => 100644 basis/tools/walker/walker.factor mode change 100755 => 100644 basis/tuple-arrays/tuple-arrays-tests.factor mode change 100755 => 100644 basis/ui/backend/backend.factor mode change 100755 => 100644 basis/ui/cocoa/cocoa.factor mode change 100755 => 100644 basis/ui/cocoa/tools/tools.factor mode change 100755 => 100644 basis/ui/cocoa/views/views.factor mode change 100755 => 100644 basis/ui/commands/commands.factor mode change 100755 => 100644 basis/ui/freetype/freetype-docs.factor mode change 100755 => 100644 basis/ui/freetype/freetype.factor mode change 100755 => 100644 basis/ui/gadgets/books/books-docs.factor mode change 100755 => 100644 basis/ui/gadgets/books/books-tests.factor mode change 100755 => 100644 basis/ui/gadgets/books/books.factor mode change 100755 => 100644 basis/ui/gadgets/buttons/buttons-docs.factor mode change 100755 => 100644 basis/ui/gadgets/buttons/buttons-tests.factor mode change 100755 => 100644 basis/ui/gadgets/buttons/buttons.factor mode change 100755 => 100644 basis/ui/gadgets/canvas/canvas-tests.factor mode change 100755 => 100644 basis/ui/gadgets/canvas/canvas.factor mode change 100755 => 100644 basis/ui/gadgets/editors/editors-docs.factor mode change 100755 => 100644 basis/ui/gadgets/editors/editors-tests.factor mode change 100755 => 100644 basis/ui/gadgets/editors/editors.factor mode change 100755 => 100644 basis/ui/gadgets/frames/frames-docs.factor mode change 100755 => 100644 basis/ui/gadgets/gadgets-docs.factor mode change 100755 => 100644 basis/ui/gadgets/gadgets-tests.factor mode change 100755 => 100644 basis/ui/gadgets/gadgets.factor mode change 100755 => 100644 basis/ui/gadgets/grid-lines/grid-lines-docs.factor mode change 100755 => 100644 basis/ui/gadgets/grid-lines/grid-lines.factor mode change 100755 => 100644 basis/ui/gadgets/grids/grids-docs.factor mode change 100755 => 100644 basis/ui/gadgets/incremental/incremental-docs.factor mode change 100755 => 100644 basis/ui/gadgets/incremental/incremental.factor mode change 100755 => 100644 basis/ui/gadgets/labelled/labelled-docs.factor mode change 100755 => 100644 basis/ui/gadgets/labelled/labelled.factor mode change 100755 => 100644 basis/ui/gadgets/labels/labels-docs.factor mode change 100755 => 100644 basis/ui/gadgets/labels/labels.factor mode change 100755 => 100644 basis/ui/gadgets/lists/lists-docs.factor mode change 100755 => 100644 basis/ui/gadgets/lists/lists.factor mode change 100755 => 100644 basis/ui/gadgets/menus/menus-docs.factor mode change 100755 => 100644 basis/ui/gadgets/packs/packs-docs.factor mode change 100755 => 100644 basis/ui/gadgets/packs/packs.factor mode change 100755 => 100644 basis/ui/gadgets/panes/panes-docs.factor mode change 100755 => 100644 basis/ui/gadgets/panes/panes-tests.factor mode change 100755 => 100644 basis/ui/gadgets/panes/panes.factor mode change 100755 => 100644 basis/ui/gadgets/presentations/presentations-docs.factor mode change 100755 => 100644 basis/ui/gadgets/scrollers/scrollers-docs.factor mode change 100755 => 100644 basis/ui/gadgets/scrollers/scrollers-tests.factor mode change 100755 => 100644 basis/ui/gadgets/scrollers/scrollers.factor mode change 100755 => 100644 basis/ui/gadgets/sliders/sliders-docs.factor mode change 100755 => 100644 basis/ui/gadgets/sliders/sliders.factor mode change 100755 => 100644 basis/ui/gadgets/slots/slots.factor mode change 100755 => 100644 basis/ui/gadgets/status-bar/status-bar-docs.factor mode change 100755 => 100644 basis/ui/gadgets/status-bar/status-bar.factor mode change 100755 => 100644 basis/ui/gadgets/tracks/tracks-docs.factor mode change 100755 => 100644 basis/ui/gadgets/viewports/viewports-docs.factor mode change 100755 => 100644 basis/ui/gadgets/viewports/viewports.factor mode change 100755 => 100644 basis/ui/gadgets/worlds/worlds-docs.factor mode change 100755 => 100644 basis/ui/gadgets/worlds/worlds.factor mode change 100755 => 100644 basis/ui/gestures/gestures.factor mode change 100755 => 100644 basis/ui/operations/operations-tests.factor mode change 100755 => 100644 basis/ui/operations/operations.factor mode change 100755 => 100644 basis/ui/render/render-docs.factor mode change 100755 => 100644 basis/ui/tools/browser/browser-tests.factor mode change 100755 => 100644 basis/ui/tools/browser/browser.factor mode change 100755 => 100644 basis/ui/tools/debugger/debugger-docs.factor mode change 100755 => 100644 basis/ui/tools/deploy/deploy-docs.factor mode change 100755 => 100644 basis/ui/tools/deploy/deploy.factor mode change 100755 => 100644 basis/ui/tools/interactor/interactor-docs.factor mode change 100755 => 100644 basis/ui/tools/interactor/interactor-tests.factor mode change 100755 => 100644 basis/ui/tools/interactor/interactor.factor mode change 100755 => 100644 basis/ui/tools/listener/listener-tests.factor mode change 100755 => 100644 basis/ui/tools/listener/listener.factor mode change 100755 => 100644 basis/ui/tools/operations/operations.factor mode change 100755 => 100644 basis/ui/tools/profiler/profiler.factor mode change 100755 => 100644 basis/ui/tools/search/search-tests.factor mode change 100755 => 100644 basis/ui/tools/search/search.factor mode change 100755 => 100644 basis/ui/tools/tools-docs.factor mode change 100755 => 100644 basis/ui/tools/tools-tests.factor mode change 100755 => 100644 basis/ui/tools/tools.factor mode change 100755 => 100644 basis/ui/tools/traceback/traceback.factor mode change 100755 => 100644 basis/ui/tools/walker/walker-docs.factor mode change 100755 => 100644 basis/ui/tools/walker/walker-tests.factor mode change 100755 => 100644 basis/ui/tools/walker/walker.factor mode change 100755 => 100644 basis/ui/tools/workspace/workspace-tests.factor mode change 100755 => 100644 basis/ui/tools/workspace/workspace.factor mode change 100755 => 100644 basis/ui/traverse/traverse-tests.factor mode change 100755 => 100644 basis/ui/ui-docs.factor mode change 100755 => 100644 basis/ui/ui.factor mode change 100755 => 100644 basis/ui/windows/windows.factor mode change 100755 => 100644 basis/ui/x11/x11.factor mode change 100755 => 100644 basis/unicode/breaks/breaks-tests.factor mode change 100755 => 100644 basis/unicode/breaks/breaks.factor mode change 100755 => 100644 basis/unicode/case/case-tests.factor mode change 100755 => 100644 basis/unicode/case/case.factor mode change 100755 => 100644 basis/unicode/collation/collation-tests.factor mode change 100755 => 100644 basis/unicode/collation/collation.factor mode change 100755 => 100644 basis/unicode/data/data.factor mode change 100755 => 100644 basis/unicode/normalize/normalize-tests.factor mode change 100755 => 100644 basis/unicode/normalize/normalize.factor mode change 100755 => 100644 basis/unicode/script/script-docs.factor mode change 100755 => 100644 basis/unicode/script/script-tests.factor mode change 100755 => 100644 basis/unicode/script/script.factor mode change 100755 => 100644 basis/unicode/syntax/syntax.factor mode change 100755 => 100644 basis/unix/bsd/bsd.factor mode change 100755 => 100644 basis/unix/linux/ifreq/ifreq.factor mode change 100755 => 100644 basis/unix/linux/linux.factor mode change 100755 => 100644 basis/unix/process/process.factor mode change 100755 => 100644 basis/unix/types/freebsd/freebsd.factor mode change 100755 => 100644 basis/unix/types/netbsd/32/32.factor mode change 100755 => 100644 basis/unix/types/netbsd/64/64.factor mode change 100755 => 100644 basis/unix/types/netbsd/netbsd.factor mode change 100755 => 100644 basis/unix/types/openbsd/openbsd.factor mode change 100755 => 100644 basis/unix/unix.factor mode change 100755 => 100644 basis/values/values-docs.factor mode change 100755 => 100644 basis/values/values-tests.factor mode change 100755 => 100644 basis/values/values.factor mode change 100755 => 100644 basis/windows/advapi32/advapi32.factor mode change 100755 => 100644 basis/windows/com/com-tests.factor mode change 100755 => 100644 basis/windows/com/com.factor mode change 100755 => 100644 basis/windows/com/syntax/syntax-docs.factor mode change 100755 => 100644 basis/windows/com/syntax/syntax.factor mode change 100755 => 100644 basis/windows/com/wrapper/wrapper-docs.factor mode change 100755 => 100644 basis/windows/com/wrapper/wrapper.factor mode change 100755 => 100644 basis/windows/dinput/constants/constants.factor mode change 100755 => 100644 basis/windows/dinput/dinput.factor mode change 100755 => 100644 basis/windows/gdi32/gdi32.factor mode change 100755 => 100644 basis/windows/kernel32/kernel32.factor mode change 100755 => 100644 basis/windows/messages/messages.factor mode change 100755 => 100644 basis/windows/ole32/ole32.factor mode change 100755 => 100644 basis/windows/opengl32/opengl32.factor mode change 100755 => 100644 basis/windows/user32/user32.factor mode change 100755 => 100644 basis/windows/winsock/winsock.factor mode change 100755 => 100644 basis/x11/clipboard/clipboard.factor mode change 100755 => 100644 basis/x11/windows/windows.factor mode change 100755 => 100644 basis/x11/xim/xim.factor mode change 100755 => 100644 basis/x11/xlib/xlib.factor mode change 100755 => 100644 basis/xml-rpc/xml-rpc.factor mode change 100755 => 100644 basis/xml/char-classes/char-classes.factor mode change 100755 => 100644 basis/xml/data/data.factor mode change 100755 => 100644 basis/xml/errors/errors-tests.factor mode change 100755 => 100644 basis/xml/tests/soap.factor mode change 100755 => 100644 basis/xml/utilities/utilities.factor mode change 100755 => 100644 basis/xmode/catalog/catalog.factor mode change 100755 => 100644 basis/xmode/code2html/code2html.factor mode change 100755 => 100644 basis/xmode/code2html/responder/responder.factor mode change 100755 => 100644 basis/xmode/loader/loader.factor mode change 100755 => 100644 basis/xmode/marker/marker-tests.factor mode change 100755 => 100644 basis/xmode/marker/marker.factor mode change 100755 => 100644 basis/xmode/marker/state/state.factor mode change 100755 => 100644 basis/xmode/rules/rules.factor mode change 100755 => 100644 basis/xmode/tokens/tokens.factor mode change 100755 => 100644 basis/xmode/utilities/utilities-tests.factor mode change 100755 => 100644 core/alien/alien-docs.factor mode change 100755 => 100644 core/alien/alien-tests.factor mode change 100755 => 100644 core/alien/alien.factor mode change 100755 => 100644 core/arrays/arrays-docs.factor mode change 100755 => 100644 core/arrays/arrays-tests.factor mode change 100755 => 100644 core/arrays/arrays.factor mode change 100755 => 100644 core/assocs/assocs-docs.factor mode change 100755 => 100644 core/assocs/assocs-tests.factor mode change 100755 => 100644 core/assocs/assocs.factor mode change 100755 => 100644 core/bootstrap/layouts/layouts.factor mode change 100755 => 100644 core/bootstrap/primitives.factor mode change 100755 => 100644 core/bootstrap/stage1.factor mode change 100755 => 100644 core/bootstrap/syntax.factor mode change 100755 => 100644 core/byte-arrays/byte-arrays-docs.factor mode change 100755 => 100644 core/byte-arrays/byte-arrays-tests.factor mode change 100755 => 100644 core/byte-arrays/byte-arrays.factor mode change 100755 => 100644 core/byte-vectors/byte-vectors-docs.factor mode change 100755 => 100644 core/byte-vectors/byte-vectors-tests.factor mode change 100755 => 100644 core/byte-vectors/byte-vectors.factor mode change 100755 => 100644 core/checksums/crc32/crc32.factor mode change 100755 => 100644 core/classes/algebra/algebra-docs.factor mode change 100755 => 100644 core/classes/algebra/algebra-tests.factor mode change 100755 => 100644 core/classes/algebra/algebra.factor mode change 100755 => 100644 core/classes/classes-docs.factor mode change 100755 => 100644 core/classes/classes-tests.factor mode change 100755 => 100644 core/classes/classes.factor mode change 100755 => 100644 core/classes/mixin/mixin-docs.factor mode change 100755 => 100644 core/classes/mixin/mixin.factor mode change 100755 => 100644 core/classes/predicate/predicate-docs.factor mode change 100755 => 100644 core/classes/predicate/predicate.factor mode change 100755 => 100644 core/classes/singleton/singleton.factor mode change 100755 => 100644 core/classes/tuple/tuple-docs.factor mode change 100755 => 100644 core/classes/tuple/tuple-tests.factor mode change 100755 => 100644 core/classes/tuple/tuple.factor mode change 100755 => 100644 core/classes/union/union-docs.factor mode change 100755 => 100644 core/classes/union/union.factor mode change 100755 => 100644 core/combinators/combinators-docs.factor mode change 100755 => 100644 core/combinators/combinators-tests.factor mode change 100755 => 100644 core/combinators/combinators.factor mode change 100755 => 100644 core/compiler/errors/errors-docs.factor mode change 100755 => 100644 core/compiler/errors/errors.factor mode change 100755 => 100644 core/compiler/units/units-docs.factor mode change 100755 => 100644 core/compiler/units/units.factor mode change 100755 => 100644 core/continuations/continuations-docs.factor mode change 100755 => 100644 core/continuations/continuations-tests.factor mode change 100755 => 100644 core/continuations/continuations.factor mode change 100755 => 100644 core/definitions/definitions-docs.factor mode change 100755 => 100644 core/definitions/definitions-tests.factor mode change 100755 => 100644 core/definitions/definitions.factor mode change 100755 => 100644 core/destructors/destructors-docs.factor mode change 100755 => 100644 core/destructors/destructors-tests.factor mode change 100755 => 100644 core/destructors/destructors.factor mode change 100755 => 100644 core/effects/effects.factor mode change 100755 => 100644 core/generic/generic-docs.factor mode change 100755 => 100644 core/generic/generic-tests.factor mode change 100755 => 100644 core/generic/generic.factor mode change 100755 => 100644 core/generic/math/math-docs.factor mode change 100755 => 100644 core/generic/math/math.factor mode change 100755 => 100644 core/growable/growable-docs.factor mode change 100755 => 100644 core/growable/growable-tests.factor mode change 100755 => 100644 core/hashtables/hashtables-docs.factor mode change 100755 => 100644 core/hashtables/hashtables-tests.factor mode change 100755 => 100644 core/hashtables/hashtables.factor mode change 100755 => 100644 core/init/init.factor mode change 100755 => 100644 core/io/backend/backend-tests.factor mode change 100755 => 100644 core/io/backend/backend.factor mode change 100755 => 100644 core/io/binary/binary-tests.factor mode change 100755 => 100644 core/io/binary/binary.factor mode change 100755 => 100644 core/io/encodings/binary/binary.factor mode change 100755 => 100644 core/io/encodings/encodings-tests.factor mode change 100755 => 100644 core/io/encodings/encodings.factor mode change 100755 => 100644 core/io/encodings/utf8/utf8-docs.factor mode change 100755 => 100644 core/io/encodings/utf8/utf8-tests.factor mode change 100755 => 100644 core/io/encodings/utf8/utf8.factor mode change 100755 => 100644 core/io/files/files-docs.factor mode change 100755 => 100644 core/io/files/files-tests.factor mode change 100755 => 100644 core/io/files/files.factor mode change 100755 => 100644 core/io/io-docs.factor mode change 100755 => 100644 core/io/io-tests.factor mode change 100755 => 100644 core/io/io.factor mode change 100755 => 100644 core/io/streams/c/c-docs.factor mode change 100755 => 100644 core/io/streams/c/c-tests.factor mode change 100755 => 100644 core/io/streams/c/c.factor mode change 100755 => 100644 core/io/streams/nested/nested.factor mode change 100755 => 100644 core/io/streams/string/string.factor mode change 100755 => 100644 core/kernel/kernel-docs.factor mode change 100755 => 100644 core/kernel/kernel-tests.factor mode change 100755 => 100644 core/kernel/kernel.factor mode change 100755 => 100644 core/layouts/layouts-docs.factor mode change 100755 => 100644 core/layouts/layouts-tests.factor mode change 100755 => 100644 core/layouts/layouts.factor mode change 100755 => 100644 core/math/floats/floats-tests.factor mode change 100755 => 100644 core/math/floats/floats.factor mode change 100755 => 100644 core/math/integers/integers-docs.factor mode change 100755 => 100644 core/math/integers/integers-tests.factor mode change 100755 => 100644 core/math/integers/integers.factor mode change 100755 => 100644 core/math/math-docs.factor mode change 100755 => 100644 core/math/math.factor mode change 100755 => 100644 core/math/parser/parser-tests.factor mode change 100755 => 100644 core/math/parser/parser.factor mode change 100755 => 100644 core/memory/memory-docs.factor mode change 100755 => 100644 core/memory/memory-tests.factor mode change 100755 => 100644 core/namespaces/namespaces-docs.factor mode change 100755 => 100644 core/parser/parser-docs.factor mode change 100755 => 100644 core/parser/parser-tests.factor mode change 100755 => 100644 core/parser/parser.factor mode change 100755 => 100644 core/parser/test/assert-depth.factor mode change 100755 => 100644 core/quotations/quotations-docs.factor mode change 100755 => 100644 core/quotations/quotations-tests.factor mode change 100755 => 100644 core/quotations/quotations.factor mode change 100755 => 100644 core/sbufs/sbufs.factor mode change 100755 => 100644 core/sequences/sequences-docs.factor mode change 100755 => 100644 core/sequences/sequences-tests.factor mode change 100755 => 100644 core/sequences/sequences.factor mode change 100755 => 100644 core/slots/slots-docs.factor mode change 100755 => 100644 core/slots/slots.factor mode change 100755 => 100644 core/sorting/sorting-tests.factor mode change 100755 => 100644 core/sorting/sorting.factor mode change 100755 => 100644 core/source-files/source-files-docs.factor mode change 100755 => 100644 core/source-files/source-files.factor mode change 100755 => 100644 core/splitting/splitting.factor mode change 100755 => 100644 core/strings/strings-docs.factor mode change 100755 => 100644 core/strings/strings-tests.factor mode change 100755 => 100644 core/strings/strings.factor mode change 100755 => 100644 core/syntax/syntax-docs.factor mode change 100755 => 100644 core/syntax/syntax.factor mode change 100755 => 100644 core/system/system-docs.factor mode change 100755 => 100644 core/system/system-tests.factor mode change 100755 => 100644 core/system/system.factor mode change 100755 => 100644 core/vectors/vectors-docs.factor mode change 100755 => 100644 core/vectors/vectors-tests.factor mode change 100755 => 100644 core/vectors/vectors.factor mode change 100755 => 100644 core/vocabs/loader/loader-docs.factor mode change 100755 => 100644 core/vocabs/loader/loader-tests.factor mode change 100755 => 100644 core/vocabs/loader/loader.factor mode change 100755 => 100644 core/vocabs/loader/test/a/a.factor mode change 100755 => 100644 core/vocabs/loader/test/b/b.factor mode change 100755 => 100644 core/vocabs/vocabs-docs.factor mode change 100755 => 100644 core/vocabs/vocabs.factor mode change 100755 => 100644 core/words/words-docs.factor mode change 100755 => 100644 core/words/words-tests.factor mode change 100755 => 100644 core/words/words.factor diff --git a/basis/alarms/alarms-docs.factor b/basis/alarms/alarms-docs.factor old mode 100755 new mode 100644 diff --git a/basis/alarms/alarms-tests.factor b/basis/alarms/alarms-tests.factor old mode 100755 new mode 100644 diff --git a/basis/alarms/alarms.factor b/basis/alarms/alarms.factor old mode 100755 new mode 100644 diff --git a/basis/alias/alias.factor b/basis/alias/alias.factor old mode 100755 new mode 100644 diff --git a/basis/alien/arrays/arrays-docs.factor b/basis/alien/arrays/arrays-docs.factor old mode 100755 new mode 100644 diff --git a/basis/alien/c-types/c-types-docs.factor b/basis/alien/c-types/c-types-docs.factor old mode 100755 new mode 100644 diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor old mode 100755 new mode 100644 diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor old mode 100755 new mode 100644 diff --git a/basis/alien/remote-control/remote-control.factor b/basis/alien/remote-control/remote-control.factor old mode 100755 new mode 100644 diff --git a/basis/alien/strings/strings.factor b/basis/alien/strings/strings.factor old mode 100755 new mode 100644 diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor old mode 100755 new mode 100644 diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor old mode 100755 new mode 100644 diff --git a/basis/alien/syntax/syntax-docs.factor b/basis/alien/syntax/syntax-docs.factor old mode 100755 new mode 100644 diff --git a/basis/alien/syntax/syntax.factor b/basis/alien/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/basis/ascii/ascii-docs.factor b/basis/ascii/ascii-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ascii/ascii.factor b/basis/ascii/ascii.factor old mode 100755 new mode 100644 diff --git a/basis/bit-arrays/bit-arrays-tests.factor b/basis/bit-arrays/bit-arrays-tests.factor old mode 100755 new mode 100644 diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor old mode 100755 new mode 100644 diff --git a/basis/bit-vectors/bit-vectors-docs.factor b/basis/bit-vectors/bit-vectors-docs.factor old mode 100755 new mode 100644 diff --git a/basis/bit-vectors/bit-vectors-tests.factor b/basis/bit-vectors/bit-vectors-tests.factor old mode 100755 new mode 100644 diff --git a/basis/bit-vectors/bit-vectors.factor b/basis/bit-vectors/bit-vectors.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/handbook/handbook.factor b/basis/bootstrap/handbook/handbook.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/help/help.factor b/basis/bootstrap/help/help.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/image/image-tests.factor b/basis/bootstrap/image/image-tests.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/image/upload/upload.factor b/basis/bootstrap/image/upload/upload.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/io/io.factor b/basis/bootstrap/io/io.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/random/random.factor b/basis/bootstrap/random/random.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/tools/tools.factor b/basis/bootstrap/tools/tools.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/ui/tools/tools.factor b/basis/bootstrap/ui/tools/tools.factor old mode 100755 new mode 100644 diff --git a/basis/bootstrap/unicode/unicode.factor b/basis/bootstrap/unicode/unicode.factor old mode 100755 new mode 100644 diff --git a/basis/boxes/boxes-docs.factor b/basis/boxes/boxes-docs.factor old mode 100755 new mode 100644 diff --git a/basis/boxes/boxes-tests.factor b/basis/boxes/boxes-tests.factor old mode 100755 new mode 100644 diff --git a/basis/boxes/boxes.factor b/basis/boxes/boxes.factor old mode 100755 new mode 100644 diff --git a/basis/calendar/calendar-tests.factor b/basis/calendar/calendar-tests.factor old mode 100755 new mode 100644 diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor old mode 100755 new mode 100644 diff --git a/basis/calendar/format/format-tests.factor b/basis/calendar/format/format-tests.factor old mode 100755 new mode 100644 diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor old mode 100755 new mode 100644 diff --git a/basis/calendar/model/model.factor b/basis/calendar/model/model.factor old mode 100755 new mode 100644 diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/channels/channels-tests.factor b/basis/channels/channels-tests.factor old mode 100755 new mode 100644 diff --git a/basis/channels/channels.factor b/basis/channels/channels.factor old mode 100755 new mode 100644 diff --git a/basis/channels/examples/examples.factor b/basis/channels/examples/examples.factor old mode 100755 new mode 100644 diff --git a/basis/channels/remote/remote.factor b/basis/channels/remote/remote.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/adler-32/adler-32-docs.factor b/basis/checksums/adler-32/adler-32-docs.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/md5/md5-docs.factor b/basis/checksums/md5/md5-docs.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/md5/md5-tests.factor b/basis/checksums/md5/md5-tests.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/sha1/sha1-tests.factor b/basis/checksums/sha1/sha1-tests.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/sha1/sha1.factor b/basis/checksums/sha1/sha1.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/sha2/sha2-tests.factor b/basis/checksums/sha2/sha2-tests.factor old mode 100755 new mode 100644 diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha2/sha2.factor old mode 100755 new mode 100644 diff --git a/basis/circular/circular-tests.factor b/basis/circular/circular-tests.factor old mode 100755 new mode 100644 diff --git a/basis/circular/circular.factor b/basis/circular/circular.factor old mode 100755 new mode 100644 diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor old mode 100755 new mode 100644 diff --git a/basis/cocoa/cocoa.factor b/basis/cocoa/cocoa.factor old mode 100755 new mode 100644 diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor old mode 100755 new mode 100644 diff --git a/basis/cocoa/pasteboard/pasteboard.factor b/basis/cocoa/pasteboard/pasteboard.factor old mode 100755 new mode 100644 diff --git a/basis/cocoa/subclassing/subclassing.factor b/basis/cocoa/subclassing/subclassing.factor old mode 100755 new mode 100644 diff --git a/basis/cocoa/windows/windows.factor b/basis/cocoa/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/combinators/short-circuit/short-circuit.factor b/basis/combinators/short-circuit/short-circuit.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/compiler-docs.factor b/basis/compiler/compiler-docs.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/generator/fixup/fixup.factor b/basis/compiler/generator/fixup/fixup.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/generator/generator-docs.factor b/basis/compiler/generator/generator-docs.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/generator/generator.factor b/basis/compiler/generator/generator.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/generator/registers/registers.factor b/basis/compiler/generator/registers/registers.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/curry.factor b/basis/compiler/tests/curry.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/float.factor b/basis/compiler/tests/float.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/simple.factor b/basis/compiler/tests/simple.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/stack-trace.factor b/basis/compiler/tests/stack-trace.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/templates-early.factor b/basis/compiler/tests/templates-early.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/templates.factor b/basis/compiler/tests/templates.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tests/tuples.factor b/basis/compiler/tests/tuples.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tree/def-use/def-use-tests.factor b/basis/compiler/tree/def-use/def-use-tests.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tree/def-use/def-use.factor b/basis/compiler/tree/def-use/def-use.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tree/propagation/propagation.factor b/basis/compiler/tree/propagation/propagation.factor old mode 100755 new mode 100644 diff --git a/basis/compiler/tree/tree.factor b/basis/compiler/tree/tree.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/combinators/combinators-docs.factor b/basis/concurrency/combinators/combinators-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/combinators/combinators-tests.factor b/basis/concurrency/combinators/combinators-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/combinators/combinators.factor b/basis/concurrency/combinators/combinators.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/conditions/conditions.factor b/basis/concurrency/conditions/conditions.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/count-downs/count-downs-docs.factor b/basis/concurrency/count-downs/count-downs-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/count-downs/count-downs-tests.factor b/basis/concurrency/count-downs/count-downs-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/count-downs/count-downs.factor b/basis/concurrency/count-downs/count-downs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/distributed/distributed-docs.factor b/basis/concurrency/distributed/distributed-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/distributed/distributed-tests.factor b/basis/concurrency/distributed/distributed-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/distributed/distributed.factor b/basis/concurrency/distributed/distributed.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/exchangers/exchangers-docs.factor b/basis/concurrency/exchangers/exchangers-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/exchangers/exchangers-tests.factor b/basis/concurrency/exchangers/exchangers-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/exchangers/exchangers.factor b/basis/concurrency/exchangers/exchangers.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/flags/flags-tests.factor b/basis/concurrency/flags/flags-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/flags/flags.factor b/basis/concurrency/flags/flags.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/futures/futures-docs.factor b/basis/concurrency/futures/futures-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/futures/futures-tests.factor b/basis/concurrency/futures/futures-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/futures/futures.factor b/basis/concurrency/futures/futures.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/locks/locks-docs.factor b/basis/concurrency/locks/locks-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/locks/locks-tests.factor b/basis/concurrency/locks/locks-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/locks/locks.factor b/basis/concurrency/locks/locks.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/mailboxes/mailboxes-docs.factor b/basis/concurrency/mailboxes/mailboxes-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/mailboxes/mailboxes-tests.factor b/basis/concurrency/mailboxes/mailboxes-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/messaging/messaging-docs.factor b/basis/concurrency/messaging/messaging-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/messaging/messaging-tests.factor b/basis/concurrency/messaging/messaging-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/promises/promises-docs.factor b/basis/concurrency/promises/promises-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/promises/promises-tests.factor b/basis/concurrency/promises/promises-tests.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/promises/promises.factor b/basis/concurrency/promises/promises.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/semaphores/semaphores-docs.factor b/basis/concurrency/semaphores/semaphores-docs.factor old mode 100755 new mode 100644 diff --git a/basis/concurrency/semaphores/semaphores.factor b/basis/concurrency/semaphores/semaphores.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/allot/allot.factor b/basis/cpu/ppc/allot/allot.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/assembler/assembler.factor b/basis/cpu/ppc/assembler/assembler.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/intrinsics/intrinsics.factor b/basis/cpu/ppc/intrinsics/intrinsics.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/linux/bootstrap.factor b/basis/cpu/ppc/linux/bootstrap.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/macosx/bootstrap.factor b/basis/cpu/ppc/macosx/bootstrap.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/allot/allot.factor b/basis/cpu/x86/allot/allot.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/intrinsics/intrinsics.factor b/basis/cpu/x86/intrinsics/intrinsics.factor old mode 100755 new mode 100644 diff --git a/basis/cpu/x86/sse2/sse2.factor b/basis/cpu/x86/sse2/sse2.factor old mode 100755 new mode 100644 diff --git a/basis/db/db-tests.factor b/basis/db/db-tests.factor old mode 100755 new mode 100644 diff --git a/basis/db/db.factor b/basis/db/db.factor old mode 100755 new mode 100644 diff --git a/basis/db/postgresql/ffi/ffi.factor b/basis/db/postgresql/ffi/ffi.factor old mode 100755 new mode 100644 diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor old mode 100755 new mode 100644 diff --git a/basis/db/postgresql/postgresql-tests.factor b/basis/db/postgresql/postgresql-tests.factor old mode 100755 new mode 100644 diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor old mode 100755 new mode 100644 diff --git a/basis/db/sqlite/ffi/ffi.factor b/basis/db/sqlite/ffi/ffi.factor old mode 100755 new mode 100644 diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor old mode 100755 new mode 100644 diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor old mode 100755 new mode 100644 diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor old mode 100755 new mode 100644 diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor old mode 100755 new mode 100644 diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor old mode 100755 new mode 100644 diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor old mode 100755 new mode 100644 diff --git a/basis/debugger/debugger-docs.factor b/basis/debugger/debugger-docs.factor old mode 100755 new mode 100644 diff --git a/basis/debugger/debugger-tests.factor b/basis/debugger/debugger-tests.factor old mode 100755 new mode 100644 diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor old mode 100755 new mode 100644 diff --git a/basis/delegate/delegate-tests.factor b/basis/delegate/delegate-tests.factor old mode 100755 new mode 100644 diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor old mode 100755 new mode 100644 diff --git a/basis/delegate/protocols/protocols.factor b/basis/delegate/protocols/protocols.factor old mode 100755 new mode 100644 diff --git a/basis/dlists/dlists-docs.factor b/basis/dlists/dlists-docs.factor old mode 100755 new mode 100644 diff --git a/basis/dlists/dlists-tests.factor b/basis/dlists/dlists-tests.factor old mode 100755 new mode 100644 diff --git a/basis/dlists/dlists.factor b/basis/dlists/dlists.factor old mode 100755 new mode 100644 diff --git a/basis/documents/documents.factor b/basis/documents/documents.factor old mode 100755 new mode 100644 diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor old mode 100755 new mode 100644 diff --git a/basis/editors/editpadpro/editpadpro.factor b/basis/editors/editpadpro/editpadpro.factor old mode 100755 new mode 100644 diff --git a/basis/editors/editplus/editplus.factor b/basis/editors/editplus/editplus.factor old mode 100755 new mode 100644 diff --git a/basis/editors/emacs/emacs.factor b/basis/editors/emacs/emacs.factor old mode 100755 new mode 100644 diff --git a/basis/editors/emeditor/emeditor.factor b/basis/editors/emeditor/emeditor.factor old mode 100755 new mode 100644 diff --git a/basis/editors/gvim/gvim.factor b/basis/editors/gvim/gvim.factor old mode 100755 new mode 100644 diff --git a/basis/editors/gvim/windows/windows.factor b/basis/editors/gvim/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/editors/jedit/jedit.factor b/basis/editors/jedit/jedit.factor old mode 100755 new mode 100644 diff --git a/basis/editors/macvim/macvim.factor b/basis/editors/macvim/macvim.factor old mode 100755 new mode 100644 diff --git a/basis/editors/notepadpp/notepadpp.factor b/basis/editors/notepadpp/notepadpp.factor old mode 100755 new mode 100644 diff --git a/basis/editors/scite/scite.factor b/basis/editors/scite/scite.factor old mode 100755 new mode 100644 diff --git a/basis/editors/ted-notepad/ted-notepad.factor b/basis/editors/ted-notepad/ted-notepad.factor old mode 100755 new mode 100644 diff --git a/basis/editors/textedit/textedit.factor b/basis/editors/textedit/textedit.factor old mode 100755 new mode 100644 diff --git a/basis/editors/textmate/textmate.factor b/basis/editors/textmate/textmate.factor old mode 100755 new mode 100644 diff --git a/basis/editors/ultraedit/ultraedit.factor b/basis/editors/ultraedit/ultraedit.factor old mode 100755 new mode 100644 diff --git a/basis/editors/vim/vim.factor b/basis/editors/vim/vim.factor old mode 100755 new mode 100644 diff --git a/basis/editors/wordpad/wordpad.factor b/basis/editors/wordpad/wordpad.factor old mode 100755 new mode 100644 diff --git a/basis/float-arrays/float-arrays-tests.factor b/basis/float-arrays/float-arrays-tests.factor old mode 100755 new mode 100644 diff --git a/basis/float-arrays/float-arrays.factor b/basis/float-arrays/float-arrays.factor old mode 100755 new mode 100644 diff --git a/basis/float-vectors/float-vectors-docs.factor b/basis/float-vectors/float-vectors-docs.factor old mode 100755 new mode 100644 diff --git a/basis/float-vectors/float-vectors-tests.factor b/basis/float-vectors/float-vectors-tests.factor old mode 100755 new mode 100644 diff --git a/basis/float-vectors/float-vectors.factor b/basis/float-vectors/float-vectors.factor old mode 100755 new mode 100644 diff --git a/basis/freetype/freetype.factor b/basis/freetype/freetype.factor old mode 100755 new mode 100644 diff --git a/basis/fry/fry-docs.factor b/basis/fry/fry-docs.factor old mode 100755 new mode 100644 diff --git a/basis/fry/fry-tests.factor b/basis/fry/fry-tests.factor old mode 100755 new mode 100644 diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/actions/actions-tests.factor b/basis/furnace/actions/actions-tests.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/auth.factor b/basis/furnace/auth/auth.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/basic/basic.factor b/basis/furnace/auth/basic/basic.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/login/login-tests.factor b/basis/furnace/auth/login/login-tests.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/login/login.factor b/basis/furnace/auth/login/login.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/providers/assoc/assoc-tests.factor b/basis/furnace/auth/providers/assoc/assoc-tests.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/providers/assoc/assoc.factor b/basis/furnace/auth/providers/assoc/assoc.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/providers/db/db-tests.factor b/basis/furnace/auth/providers/db/db-tests.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/providers/db/db.factor b/basis/furnace/auth/providers/db/db.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/providers/null/null.factor b/basis/furnace/auth/providers/null/null.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/auth/providers/providers.factor b/basis/furnace/auth/providers/providers.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/db/db.factor b/basis/furnace/db/db.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/sessions/sessions-tests.factor b/basis/furnace/sessions/sessions-tests.factor old mode 100755 new mode 100644 diff --git a/basis/furnace/sessions/sessions.factor b/basis/furnace/sessions/sessions.factor old mode 100755 new mode 100644 diff --git a/basis/generalizations/generalizations-docs.factor b/basis/generalizations/generalizations-docs.factor old mode 100755 new mode 100644 diff --git a/basis/generalizations/generalizations-tests.factor b/basis/generalizations/generalizations-tests.factor old mode 100755 new mode 100644 diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor old mode 100755 new mode 100644 diff --git a/basis/globs/globs.factor b/basis/globs/globs.factor old mode 100755 new mode 100644 diff --git a/basis/hash2/hash2-tests.factor b/basis/hash2/hash2-tests.factor old mode 100755 new mode 100644 diff --git a/basis/heaps/heaps-docs.factor b/basis/heaps/heaps-docs.factor old mode 100755 new mode 100644 diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor old mode 100755 new mode 100644 diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor old mode 100755 new mode 100644 diff --git a/basis/help/cookbook/cookbook.factor b/basis/help/cookbook/cookbook.factor old mode 100755 new mode 100644 diff --git a/basis/help/crossref/crossref-tests.factor b/basis/help/crossref/crossref-tests.factor old mode 100755 new mode 100644 diff --git a/basis/help/definitions/definitions-tests.factor b/basis/help/definitions/definitions-tests.factor old mode 100755 new mode 100644 diff --git a/basis/help/definitions/definitions.factor b/basis/help/definitions/definitions.factor old mode 100755 new mode 100644 diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor old mode 100755 new mode 100644 diff --git a/basis/help/help-docs.factor b/basis/help/help-docs.factor old mode 100755 new mode 100644 diff --git a/basis/help/help.factor b/basis/help/help.factor old mode 100755 new mode 100644 diff --git a/basis/help/lint/lint.factor b/basis/help/lint/lint.factor old mode 100755 new mode 100644 diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor old mode 100755 new mode 100644 diff --git a/basis/help/stylesheet/stylesheet.factor b/basis/help/stylesheet/stylesheet.factor old mode 100755 new mode 100644 diff --git a/basis/help/syntax/syntax-tests.factor b/basis/help/syntax/syntax-tests.factor old mode 100755 new mode 100644 diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor old mode 100755 new mode 100644 diff --git a/basis/help/tutorial/tutorial.factor b/basis/help/tutorial/tutorial.factor old mode 100755 new mode 100644 diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor old mode 100755 new mode 100644 diff --git a/basis/html/templates/fhtml/fhtml-tests.factor b/basis/html/templates/fhtml/fhtml-tests.factor old mode 100755 new mode 100644 diff --git a/basis/html/templates/fhtml/fhtml.factor b/basis/html/templates/fhtml/fhtml.factor old mode 100755 new mode 100644 diff --git a/basis/http/client/client-tests.factor b/basis/http/client/client-tests.factor old mode 100755 new mode 100644 diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor old mode 100755 new mode 100644 diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor old mode 100755 new mode 100644 diff --git a/basis/http/http.factor b/basis/http/http.factor old mode 100755 new mode 100644 diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor old mode 100755 new mode 100644 diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor old mode 100755 new mode 100644 diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor old mode 100755 new mode 100644 diff --git a/basis/inspector/inspector.factor b/basis/inspector/inspector.factor old mode 100755 new mode 100644 diff --git a/basis/interval-maps/interval-maps-docs.factor b/basis/interval-maps/interval-maps-docs.factor old mode 100755 new mode 100644 diff --git a/basis/interval-maps/interval-maps-tests.factor b/basis/interval-maps/interval-maps-tests.factor old mode 100755 new mode 100644 diff --git a/basis/interval-maps/interval-maps.factor b/basis/interval-maps/interval-maps.factor old mode 100755 new mode 100644 diff --git a/basis/io/buffers/buffers-docs.factor b/basis/io/buffers/buffers-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor old mode 100755 new mode 100644 diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor old mode 100755 new mode 100644 diff --git a/basis/io/encodings/ascii/ascii.factor b/basis/io/encodings/ascii/ascii.factor old mode 100755 new mode 100644 diff --git a/basis/io/encodings/iana/iana.factor b/basis/io/encodings/iana/iana.factor old mode 100755 new mode 100644 diff --git a/basis/io/encodings/utf16/utf16-tests.factor b/basis/io/encodings/utf16/utf16-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/encodings/utf16/utf16.factor b/basis/io/encodings/utf16/utf16.factor old mode 100755 new mode 100644 diff --git a/basis/io/launcher/launcher-docs.factor b/basis/io/launcher/launcher-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/launcher/launcher-tests.factor b/basis/io/launcher/launcher-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor old mode 100755 new mode 100644 diff --git a/basis/io/mmap/mmap-docs.factor b/basis/io/mmap/mmap-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/mmap/mmap-tests.factor b/basis/io/mmap/mmap-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor old mode 100755 new mode 100644 diff --git a/basis/io/monitors/monitors-docs.factor b/basis/io/monitors/monitors-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/monitors/monitors-tests.factor b/basis/io/monitors/monitors-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor old mode 100755 new mode 100644 diff --git a/basis/io/pipes/pipes-tests.factor b/basis/io/pipes/pipes-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/ports/ports-docs.factor b/basis/io/ports/ports-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor old mode 100755 new mode 100644 diff --git a/basis/io/servers/connection/connection-docs.factor b/basis/io/servers/connection/connection-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/servers/connection/connection-tests.factor b/basis/io/servers/connection/connection-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor old mode 100755 new mode 100644 diff --git a/basis/io/sockets/secure/secure-tests.factor b/basis/io/sockets/secure/secure-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor old mode 100755 new mode 100644 diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor old mode 100755 new mode 100644 diff --git a/basis/io/streams/duplex/duplex-docs.factor b/basis/io/streams/duplex/duplex-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/streams/duplex/duplex-tests.factor b/basis/io/streams/duplex/duplex-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor old mode 100755 new mode 100644 diff --git a/basis/io/streams/null/null.factor b/basis/io/streams/null/null.factor old mode 100755 new mode 100644 diff --git a/basis/io/thread/thread.factor b/basis/io/thread/thread.factor old mode 100755 new mode 100644 diff --git a/basis/io/timeouts/timeouts-docs.factor b/basis/io/timeouts/timeouts-docs.factor old mode 100755 new mode 100644 diff --git a/basis/io/timeouts/timeouts.factor b/basis/io/timeouts/timeouts.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/backend/backend.factor b/basis/io/unix/backend/backend.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/bsd/bsd.factor b/basis/io/unix/bsd/bsd.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/files/files-tests.factor b/basis/io/unix/files/files-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/kqueue/kqueue.factor b/basis/io/unix/kqueue/kqueue.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/launcher/launcher-tests.factor b/basis/io/unix/launcher/launcher-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/launcher/launcher.factor b/basis/io/unix/launcher/launcher.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/launcher/parser/parser-tests.factor b/basis/io/unix/launcher/parser/parser-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/launcher/parser/parser.factor b/basis/io/unix/launcher/parser/parser.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/linux/linux.factor b/basis/io/unix/linux/linux.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/mmap/mmap.factor b/basis/io/unix/mmap/mmap.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/sockets/secure/secure.factor b/basis/io/unix/sockets/secure/secure.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/sockets/sockets.factor b/basis/io/unix/sockets/sockets.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/unix-tests.factor b/basis/io/unix/unix-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/unix/unix.factor b/basis/io/unix/unix.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/files/unique/unique.factor b/basis/io/windows/files/unique/unique.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/launcher/launcher-tests.factor b/basis/io/windows/launcher/launcher-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/launcher/launcher.factor b/basis/io/windows/launcher/launcher.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/mmap/mmap.factor b/basis/io/windows/mmap/mmap.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/backend/backend.factor b/basis/io/windows/nt/backend/backend.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/files/files-tests.factor b/basis/io/windows/nt/files/files-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/files/files.factor b/basis/io/windows/nt/files/files.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/launcher/launcher-tests.factor b/basis/io/windows/nt/launcher/launcher-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/launcher/launcher.factor b/basis/io/windows/nt/launcher/launcher.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/launcher/test/append.factor b/basis/io/windows/nt/launcher/test/append.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/launcher/test/env.factor b/basis/io/windows/nt/launcher/test/env.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/launcher/test/stderr.factor b/basis/io/windows/nt/launcher/test/stderr.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/monitors/monitors-tests.factor b/basis/io/windows/nt/monitors/monitors-tests.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/monitors/monitors.factor b/basis/io/windows/nt/monitors/monitors.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/nt.factor b/basis/io/windows/nt/nt.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/pipes/pipes.factor b/basis/io/windows/nt/pipes/pipes.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/privileges/privileges.factor b/basis/io/windows/nt/privileges/privileges.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/nt/sockets/sockets.factor b/basis/io/windows/nt/sockets/sockets.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/privileges/privileges.factor b/basis/io/windows/privileges/privileges.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/sockets/sockets.factor b/basis/io/windows/sockets/sockets.factor old mode 100755 new mode 100644 diff --git a/basis/io/windows/windows.factor b/basis/io/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor old mode 100755 new mode 100644 diff --git a/basis/lcs/lcs-docs.factor b/basis/lcs/lcs-docs.factor old mode 100755 new mode 100644 diff --git a/basis/lcs/lcs-tests.factor b/basis/lcs/lcs-tests.factor old mode 100755 new mode 100644 diff --git a/basis/lcs/lcs.factor b/basis/lcs/lcs.factor old mode 100755 new mode 100644 diff --git a/basis/libc/libc-tests.factor b/basis/libc/libc-tests.factor old mode 100755 new mode 100644 diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor old mode 100755 new mode 100644 diff --git a/basis/listener/listener-docs.factor b/basis/listener/listener-docs.factor old mode 100755 new mode 100644 diff --git a/basis/listener/listener-tests.factor b/basis/listener/listener-tests.factor old mode 100755 new mode 100644 diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor old mode 100755 new mode 100644 diff --git a/basis/locals/locals-tests.factor b/basis/locals/locals-tests.factor old mode 100755 new mode 100644 diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor old mode 100755 new mode 100644 diff --git a/basis/logging/analysis/analysis.factor b/basis/logging/analysis/analysis.factor old mode 100755 new mode 100644 diff --git a/basis/logging/insomniac/insomniac-docs.factor b/basis/logging/insomniac/insomniac-docs.factor old mode 100755 new mode 100644 diff --git a/basis/logging/insomniac/insomniac.factor b/basis/logging/insomniac/insomniac.factor old mode 100755 new mode 100644 diff --git a/basis/logging/logging-docs.factor b/basis/logging/logging-docs.factor old mode 100755 new mode 100644 diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor old mode 100755 new mode 100644 diff --git a/basis/logging/parser/parser.factor b/basis/logging/parser/parser.factor old mode 100755 new mode 100644 diff --git a/basis/logging/server/server.factor b/basis/logging/server/server.factor old mode 100755 new mode 100644 diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor old mode 100755 new mode 100644 diff --git a/basis/match/match-tests.factor b/basis/match/match-tests.factor old mode 100755 new mode 100644 diff --git a/basis/match/match.factor b/basis/match/match.factor old mode 100755 new mode 100644 diff --git a/basis/math/bitwise/bitwise-tests.factor b/basis/math/bitwise/bitwise-tests.factor old mode 100755 new mode 100644 diff --git a/basis/math/complex/complex-docs.factor b/basis/math/complex/complex-docs.factor old mode 100755 new mode 100644 diff --git a/basis/math/complex/complex-tests.factor b/basis/math/complex/complex-tests.factor old mode 100755 new mode 100644 diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor old mode 100755 new mode 100644 diff --git a/basis/math/constants/constants-docs.factor b/basis/math/constants/constants-docs.factor old mode 100755 new mode 100644 diff --git a/basis/math/constants/constants.factor b/basis/math/constants/constants.factor old mode 100755 new mode 100644 diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor old mode 100755 new mode 100644 diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor old mode 100755 new mode 100644 diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor old mode 100755 new mode 100644 diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor old mode 100755 new mode 100644 diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor old mode 100755 new mode 100644 diff --git a/basis/math/libm/libm.factor b/basis/math/libm/libm.factor old mode 100755 new mode 100644 diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor old mode 100755 new mode 100644 diff --git a/basis/math/ratios/ratios-docs.factor b/basis/math/ratios/ratios-docs.factor old mode 100755 new mode 100644 diff --git a/basis/math/ratios/ratios-tests.factor b/basis/math/ratios/ratios-tests.factor old mode 100755 new mode 100644 diff --git a/basis/math/ratios/ratios.factor b/basis/math/ratios/ratios.factor old mode 100755 new mode 100644 diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor old mode 100755 new mode 100644 diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor old mode 100755 new mode 100644 diff --git a/basis/memoize/memoize-docs.factor b/basis/memoize/memoize-docs.factor old mode 100755 new mode 100644 diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor old mode 100755 new mode 100644 diff --git a/basis/mime-types/mime-types.factor b/basis/mime-types/mime-types.factor old mode 100755 new mode 100644 diff --git a/basis/mirrors/mirrors-docs.factor b/basis/mirrors/mirrors-docs.factor old mode 100755 new mode 100644 diff --git a/basis/mirrors/mirrors-tests.factor b/basis/mirrors/mirrors-tests.factor old mode 100755 new mode 100644 diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor old mode 100755 new mode 100644 diff --git a/basis/models/compose/compose-docs.factor b/basis/models/compose/compose-docs.factor old mode 100755 new mode 100644 diff --git a/basis/models/compose/compose-tests.factor b/basis/models/compose/compose-tests.factor old mode 100755 new mode 100644 diff --git a/basis/models/compose/compose.factor b/basis/models/compose/compose.factor old mode 100755 new mode 100644 diff --git a/basis/models/delay/delay-docs.factor b/basis/models/delay/delay-docs.factor old mode 100755 new mode 100644 diff --git a/basis/models/delay/delay.factor b/basis/models/delay/delay.factor old mode 100755 new mode 100644 diff --git a/basis/models/filter/filter-docs.factor b/basis/models/filter/filter-docs.factor old mode 100755 new mode 100644 diff --git a/basis/models/filter/filter-tests.factor b/basis/models/filter/filter-tests.factor old mode 100755 new mode 100644 diff --git a/basis/models/filter/filter.factor b/basis/models/filter/filter.factor old mode 100755 new mode 100644 diff --git a/basis/models/history/history-docs.factor b/basis/models/history/history-docs.factor old mode 100755 new mode 100644 diff --git a/basis/models/history/history-tests.factor b/basis/models/history/history-tests.factor old mode 100755 new mode 100644 diff --git a/basis/models/history/history.factor b/basis/models/history/history.factor old mode 100755 new mode 100644 diff --git a/basis/models/mapping/mapping-tests.factor b/basis/models/mapping/mapping-tests.factor old mode 100755 new mode 100644 diff --git a/basis/models/mapping/mapping.factor b/basis/models/mapping/mapping.factor old mode 100755 new mode 100644 diff --git a/basis/models/models-docs.factor b/basis/models/models-docs.factor old mode 100755 new mode 100644 diff --git a/basis/models/models-tests.factor b/basis/models/models-tests.factor old mode 100755 new mode 100644 diff --git a/basis/models/models.factor b/basis/models/models.factor old mode 100755 new mode 100644 diff --git a/basis/models/range/range-docs.factor b/basis/models/range/range-docs.factor old mode 100755 new mode 100644 diff --git a/basis/models/range/range-tests.factor b/basis/models/range/range-tests.factor old mode 100755 new mode 100644 diff --git a/basis/models/range/range.factor b/basis/models/range/range.factor old mode 100755 new mode 100644 diff --git a/basis/multiline/multiline-tests.factor b/basis/multiline/multiline-tests.factor old mode 100755 new mode 100644 diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor old mode 100755 new mode 100644 diff --git a/basis/opengl/gl/windows/windows.factor b/basis/opengl/gl/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor old mode 100755 new mode 100644 diff --git a/basis/openssl/libcrypto/libcrypto.factor b/basis/openssl/libcrypto/libcrypto.factor old mode 100755 new mode 100644 diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor old mode 100755 new mode 100644 diff --git a/basis/openssl/openssl-tests.factor b/basis/openssl/openssl-tests.factor old mode 100755 new mode 100644 diff --git a/basis/openssl/openssl.factor b/basis/openssl/openssl.factor old mode 100755 new mode 100644 diff --git a/basis/peg/parsers/parsers-docs.factor b/basis/peg/parsers/parsers-docs.factor old mode 100755 new mode 100644 diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor old mode 100755 new mode 100644 diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor old mode 100755 new mode 100644 diff --git a/basis/peg/search/search-docs.factor b/basis/peg/search/search-docs.factor old mode 100755 new mode 100644 diff --git a/basis/peg/search/search-tests.factor b/basis/peg/search/search-tests.factor old mode 100755 new mode 100644 diff --git a/basis/peg/search/search.factor b/basis/peg/search/search.factor old mode 100755 new mode 100644 diff --git a/basis/prettyprint/backend/backend-docs.factor b/basis/prettyprint/backend/backend-docs.factor old mode 100755 new mode 100644 diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor old mode 100755 new mode 100644 diff --git a/basis/prettyprint/prettyprint-docs.factor b/basis/prettyprint/prettyprint-docs.factor old mode 100755 new mode 100644 diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor old mode 100755 new mode 100644 diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor old mode 100755 new mode 100644 diff --git a/basis/prettyprint/sections/sections-docs.factor b/basis/prettyprint/sections/sections-docs.factor old mode 100755 new mode 100644 diff --git a/basis/qualified/qualified-docs.factor b/basis/qualified/qualified-docs.factor old mode 100755 new mode 100644 diff --git a/basis/random/dummy/dummy.factor b/basis/random/dummy/dummy.factor old mode 100755 new mode 100644 diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor old mode 100755 new mode 100644 diff --git a/basis/random/mersenne-twister/mersenne-twister.factor b/basis/random/mersenne-twister/mersenne-twister.factor old mode 100755 new mode 100644 diff --git a/basis/random/random.factor b/basis/random/random.factor old mode 100755 new mode 100644 diff --git a/basis/sequences/deep/deep-tests.factor b/basis/sequences/deep/deep-tests.factor old mode 100755 new mode 100644 diff --git a/basis/sequences/next/next.factor b/basis/sequences/next/next.factor old mode 100755 new mode 100644 diff --git a/basis/serialize/serialize-docs.factor b/basis/serialize/serialize-docs.factor old mode 100755 new mode 100644 diff --git a/basis/serialize/serialize-tests.factor b/basis/serialize/serialize-tests.factor old mode 100755 new mode 100644 diff --git a/basis/serialize/serialize.factor b/basis/serialize/serialize.factor old mode 100755 new mode 100644 diff --git a/basis/shuffle/shuffle-tests.factor b/basis/shuffle/shuffle-tests.factor old mode 100755 new mode 100644 diff --git a/basis/smtp/server/server.factor b/basis/smtp/server/server.factor old mode 100755 new mode 100644 diff --git a/basis/smtp/smtp-tests.factor b/basis/smtp/smtp-tests.factor old mode 100755 new mode 100644 diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/backend/backend.factor b/basis/stack-checker/backend/backend.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/stack-checker-docs.factor b/basis/stack-checker/stack-checker-docs.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/stack-checker.factor b/basis/stack-checker/stack-checker.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/state/state.factor b/basis/stack-checker/state/state.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/transforms/transforms-docs.factor b/basis/stack-checker/transforms/transforms-docs.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/transforms/transforms-tests.factor b/basis/stack-checker/transforms/transforms-tests.factor old mode 100755 new mode 100644 diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor old mode 100755 new mode 100644 diff --git a/basis/state-parser/state-parser-tests.factor b/basis/state-parser/state-parser-tests.factor old mode 100755 new mode 100644 diff --git a/basis/symbols/symbols-tests.factor b/basis/symbols/symbols-tests.factor old mode 100755 new mode 100644 diff --git a/basis/symbols/symbols.factor b/basis/symbols/symbols.factor old mode 100755 new mode 100644 diff --git a/basis/syndication/syndication-tests.factor b/basis/syndication/syndication-tests.factor old mode 100755 new mode 100644 diff --git a/basis/threads/threads-docs.factor b/basis/threads/threads-docs.factor old mode 100755 new mode 100644 diff --git a/basis/threads/threads-tests.factor b/basis/threads/threads-tests.factor old mode 100755 new mode 100644 diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor old mode 100755 new mode 100644 diff --git a/basis/tools/annotations/annotations-docs.factor b/basis/tools/annotations/annotations-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor old mode 100755 new mode 100644 diff --git a/basis/tools/completion/completion.factor b/basis/tools/completion/completion.factor old mode 100755 new mode 100644 diff --git a/basis/tools/crossref/crossref-tests.factor b/basis/tools/crossref/crossref-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/crossref/crossref.factor b/basis/tools/crossref/crossref.factor old mode 100755 new mode 100644 diff --git a/basis/tools/crossref/test/foo.factor b/basis/tools/crossref/test/foo.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/config/config-docs.factor b/basis/tools/deploy/config/config-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/config/config.factor b/basis/tools/deploy/config/config.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/deploy-docs.factor b/basis/tools/deploy/deploy-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/deploy-tests.factor b/basis/tools/deploy/deploy-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/deploy.factor b/basis/tools/deploy/deploy.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/shaker/strip-cocoa.factor b/basis/tools/deploy/shaker/strip-cocoa.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/shaker/strip-debugger.factor b/basis/tools/deploy/shaker/strip-debugger.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/shaker/strip-libc.factor b/basis/tools/deploy/shaker/strip-libc.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/test/1/1.factor b/basis/tools/deploy/test/1/1.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/test/1/deploy.factor b/basis/tools/deploy/test/1/deploy.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/test/2/2.factor b/basis/tools/deploy/test/2/2.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/test/2/deploy.factor b/basis/tools/deploy/test/2/deploy.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/test/3/3.factor b/basis/tools/deploy/test/3/3.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/test/3/deploy.factor b/basis/tools/deploy/test/3/deploy.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/windows/windows-tests.factor b/basis/tools/deploy/windows/windows-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/tools/disassembler/disassembler-docs.factor b/basis/tools/disassembler/disassembler-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/disassembler/disassembler-tests.factor b/basis/tools/disassembler/disassembler-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor old mode 100755 new mode 100644 diff --git a/basis/tools/memory/memory-docs.factor b/basis/tools/memory/memory-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor old mode 100755 new mode 100644 diff --git a/basis/tools/profiler/profiler-docs.factor b/basis/tools/profiler/profiler-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/profiler/profiler-tests.factor b/basis/tools/profiler/profiler-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/profiler/profiler.factor b/basis/tools/profiler/profiler.factor old mode 100755 new mode 100644 diff --git a/basis/tools/test/test-docs.factor b/basis/tools/test/test-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/test/test.factor b/basis/tools/test/test.factor old mode 100755 new mode 100644 diff --git a/basis/tools/test/ui/ui.factor b/basis/tools/test/ui/ui.factor old mode 100755 new mode 100644 diff --git a/basis/tools/threads/threads.factor b/basis/tools/threads/threads.factor old mode 100755 new mode 100644 diff --git a/basis/tools/time/time-docs.factor b/basis/tools/time/time-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/vocabs/browser/browser-docs.factor b/basis/tools/vocabs/browser/browser-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/vocabs/browser/browser-tests.factor b/basis/tools/vocabs/browser/browser-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/tools/vocabs/browser/browser.factor old mode 100755 new mode 100644 diff --git a/basis/tools/vocabs/monitor/monitor.factor b/basis/tools/vocabs/monitor/monitor.factor old mode 100755 new mode 100644 diff --git a/basis/tools/vocabs/vocabs-docs.factor b/basis/tools/vocabs/vocabs-docs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/vocabs/vocabs.factor b/basis/tools/vocabs/vocabs.factor old mode 100755 new mode 100644 diff --git a/basis/tools/walker/debug/debug.factor b/basis/tools/walker/debug/debug.factor old mode 100755 new mode 100644 diff --git a/basis/tools/walker/walker-tests.factor b/basis/tools/walker/walker-tests.factor old mode 100755 new mode 100644 diff --git a/basis/tools/walker/walker.factor b/basis/tools/walker/walker.factor old mode 100755 new mode 100644 diff --git a/basis/tuple-arrays/tuple-arrays-tests.factor b/basis/tuple-arrays/tuple-arrays-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/backend/backend.factor b/basis/ui/backend/backend.factor old mode 100755 new mode 100644 diff --git a/basis/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor old mode 100755 new mode 100644 diff --git a/basis/ui/cocoa/tools/tools.factor b/basis/ui/cocoa/tools/tools.factor old mode 100755 new mode 100644 diff --git a/basis/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor old mode 100755 new mode 100644 diff --git a/basis/ui/commands/commands.factor b/basis/ui/commands/commands.factor old mode 100755 new mode 100644 diff --git a/basis/ui/freetype/freetype-docs.factor b/basis/ui/freetype/freetype-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/books/books-docs.factor b/basis/ui/gadgets/books/books-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/books/books-tests.factor b/basis/ui/gadgets/books/books-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/books/books.factor b/basis/ui/gadgets/books/books.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/buttons/buttons-docs.factor b/basis/ui/gadgets/buttons/buttons-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/buttons/buttons-tests.factor b/basis/ui/gadgets/buttons/buttons-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/canvas/canvas-tests.factor b/basis/ui/gadgets/canvas/canvas-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/canvas/canvas.factor b/basis/ui/gadgets/canvas/canvas.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/editors/editors-docs.factor b/basis/ui/gadgets/editors/editors-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/editors/editors-tests.factor b/basis/ui/gadgets/editors/editors-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/frames/frames-docs.factor b/basis/ui/gadgets/frames/frames-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/gadgets-docs.factor b/basis/ui/gadgets/gadgets-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/grid-lines/grid-lines-docs.factor b/basis/ui/gadgets/grid-lines/grid-lines-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/grids/grids-docs.factor b/basis/ui/gadgets/grids/grids-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/incremental/incremental-docs.factor b/basis/ui/gadgets/incremental/incremental-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/labelled/labelled-docs.factor b/basis/ui/gadgets/labelled/labelled-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/labels/labels-docs.factor b/basis/ui/gadgets/labels/labels-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/lists/lists-docs.factor b/basis/ui/gadgets/lists/lists-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/lists/lists.factor b/basis/ui/gadgets/lists/lists.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/menus/menus-docs.factor b/basis/ui/gadgets/menus/menus-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/packs/packs-docs.factor b/basis/ui/gadgets/packs/packs-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/panes/panes-docs.factor b/basis/ui/gadgets/panes/panes-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/presentations/presentations-docs.factor b/basis/ui/gadgets/presentations/presentations-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/scrollers/scrollers-docs.factor b/basis/ui/gadgets/scrollers/scrollers-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/scrollers/scrollers-tests.factor b/basis/ui/gadgets/scrollers/scrollers-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/sliders/sliders-docs.factor b/basis/ui/gadgets/sliders/sliders-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/slots/slots.factor b/basis/ui/gadgets/slots/slots.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/status-bar/status-bar-docs.factor b/basis/ui/gadgets/status-bar/status-bar-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/status-bar/status-bar.factor b/basis/ui/gadgets/status-bar/status-bar.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/tracks/tracks-docs.factor b/basis/ui/gadgets/tracks/tracks-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/viewports/viewports-docs.factor b/basis/ui/gadgets/viewports/viewports-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/viewports/viewports.factor b/basis/ui/gadgets/viewports/viewports.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor old mode 100755 new mode 100644 diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor old mode 100755 new mode 100644 diff --git a/basis/ui/operations/operations-tests.factor b/basis/ui/operations/operations-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/operations/operations.factor b/basis/ui/operations/operations.factor old mode 100755 new mode 100644 diff --git a/basis/ui/render/render-docs.factor b/basis/ui/render/render-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/browser/browser-tests.factor b/basis/ui/tools/browser/browser-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/debugger/debugger-docs.factor b/basis/ui/tools/debugger/debugger-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/deploy/deploy-docs.factor b/basis/ui/tools/deploy/deploy-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/interactor/interactor-docs.factor b/basis/ui/tools/interactor/interactor-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/interactor/interactor-tests.factor b/basis/ui/tools/interactor/interactor-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/search/search-tests.factor b/basis/ui/tools/search/search-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/tools-tests.factor b/basis/ui/tools/tools-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/tools.factor b/basis/ui/tools/tools.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/walker/walker-docs.factor b/basis/ui/tools/walker/walker-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/walker/walker-tests.factor b/basis/ui/tools/walker/walker-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/workspace/workspace-tests.factor b/basis/ui/tools/workspace/workspace-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor old mode 100755 new mode 100644 diff --git a/basis/ui/traverse/traverse-tests.factor b/basis/ui/traverse/traverse-tests.factor old mode 100755 new mode 100644 diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor old mode 100755 new mode 100644 diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor old mode 100755 new mode 100644 diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/breaks/breaks-tests.factor b/basis/unicode/breaks/breaks-tests.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/case/case-tests.factor b/basis/unicode/case/case-tests.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/collation/collation-tests.factor b/basis/unicode/collation/collation-tests.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/normalize/normalize-tests.factor b/basis/unicode/normalize/normalize-tests.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/script/script-docs.factor b/basis/unicode/script/script-docs.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/script/script-tests.factor b/basis/unicode/script/script-tests.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/script/script.factor b/basis/unicode/script/script.factor old mode 100755 new mode 100644 diff --git a/basis/unicode/syntax/syntax.factor b/basis/unicode/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/bsd/bsd.factor old mode 100755 new mode 100644 diff --git a/basis/unix/linux/ifreq/ifreq.factor b/basis/unix/linux/ifreq/ifreq.factor old mode 100755 new mode 100644 diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor old mode 100755 new mode 100644 diff --git a/basis/unix/process/process.factor b/basis/unix/process/process.factor old mode 100755 new mode 100644 diff --git a/basis/unix/types/freebsd/freebsd.factor b/basis/unix/types/freebsd/freebsd.factor old mode 100755 new mode 100644 diff --git a/basis/unix/types/netbsd/32/32.factor b/basis/unix/types/netbsd/32/32.factor old mode 100755 new mode 100644 diff --git a/basis/unix/types/netbsd/64/64.factor b/basis/unix/types/netbsd/64/64.factor old mode 100755 new mode 100644 diff --git a/basis/unix/types/netbsd/netbsd.factor b/basis/unix/types/netbsd/netbsd.factor old mode 100755 new mode 100644 diff --git a/basis/unix/types/openbsd/openbsd.factor b/basis/unix/types/openbsd/openbsd.factor old mode 100755 new mode 100644 diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor old mode 100755 new mode 100644 diff --git a/basis/values/values-docs.factor b/basis/values/values-docs.factor old mode 100755 new mode 100644 diff --git a/basis/values/values-tests.factor b/basis/values/values-tests.factor old mode 100755 new mode 100644 diff --git a/basis/values/values.factor b/basis/values/values.factor old mode 100755 new mode 100644 diff --git a/basis/windows/advapi32/advapi32.factor b/basis/windows/advapi32/advapi32.factor old mode 100755 new mode 100644 diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor old mode 100755 new mode 100644 diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor old mode 100755 new mode 100644 diff --git a/basis/windows/com/syntax/syntax-docs.factor b/basis/windows/com/syntax/syntax-docs.factor old mode 100755 new mode 100644 diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/basis/windows/com/wrapper/wrapper-docs.factor b/basis/windows/com/wrapper/wrapper-docs.factor old mode 100755 new mode 100644 diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor old mode 100755 new mode 100644 diff --git a/basis/windows/dinput/constants/constants.factor b/basis/windows/dinput/constants/constants.factor old mode 100755 new mode 100644 diff --git a/basis/windows/dinput/dinput.factor b/basis/windows/dinput/dinput.factor old mode 100755 new mode 100644 diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor old mode 100755 new mode 100644 diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor old mode 100755 new mode 100644 diff --git a/basis/windows/messages/messages.factor b/basis/windows/messages/messages.factor old mode 100755 new mode 100644 diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor old mode 100755 new mode 100644 diff --git a/basis/windows/opengl32/opengl32.factor b/basis/windows/opengl32/opengl32.factor old mode 100755 new mode 100644 diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor old mode 100755 new mode 100644 diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor old mode 100755 new mode 100644 diff --git a/basis/x11/clipboard/clipboard.factor b/basis/x11/clipboard/clipboard.factor old mode 100755 new mode 100644 diff --git a/basis/x11/windows/windows.factor b/basis/x11/windows/windows.factor old mode 100755 new mode 100644 diff --git a/basis/x11/xim/xim.factor b/basis/x11/xim/xim.factor old mode 100755 new mode 100644 diff --git a/basis/x11/xlib/xlib.factor b/basis/x11/xlib/xlib.factor old mode 100755 new mode 100644 diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor old mode 100755 new mode 100644 diff --git a/basis/xml/char-classes/char-classes.factor b/basis/xml/char-classes/char-classes.factor old mode 100755 new mode 100644 diff --git a/basis/xml/data/data.factor b/basis/xml/data/data.factor old mode 100755 new mode 100644 diff --git a/basis/xml/errors/errors-tests.factor b/basis/xml/errors/errors-tests.factor old mode 100755 new mode 100644 diff --git a/basis/xml/tests/soap.factor b/basis/xml/tests/soap.factor old mode 100755 new mode 100644 diff --git a/basis/xml/utilities/utilities.factor b/basis/xml/utilities/utilities.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/catalog/catalog.factor b/basis/xmode/catalog/catalog.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/code2html/code2html.factor b/basis/xmode/code2html/code2html.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/code2html/responder/responder.factor b/basis/xmode/code2html/responder/responder.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/loader/loader.factor b/basis/xmode/loader/loader.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/marker/marker-tests.factor b/basis/xmode/marker/marker-tests.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/marker/marker.factor b/basis/xmode/marker/marker.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/marker/state/state.factor b/basis/xmode/marker/state/state.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/rules/rules.factor b/basis/xmode/rules/rules.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/tokens/tokens.factor b/basis/xmode/tokens/tokens.factor old mode 100755 new mode 100644 diff --git a/basis/xmode/utilities/utilities-tests.factor b/basis/xmode/utilities/utilities-tests.factor old mode 100755 new mode 100644 diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor old mode 100755 new mode 100644 diff --git a/core/alien/alien-tests.factor b/core/alien/alien-tests.factor old mode 100755 new mode 100644 diff --git a/core/alien/alien.factor b/core/alien/alien.factor old mode 100755 new mode 100644 diff --git a/core/arrays/arrays-docs.factor b/core/arrays/arrays-docs.factor old mode 100755 new mode 100644 diff --git a/core/arrays/arrays-tests.factor b/core/arrays/arrays-tests.factor old mode 100755 new mode 100644 diff --git a/core/arrays/arrays.factor b/core/arrays/arrays.factor old mode 100755 new mode 100644 diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor old mode 100755 new mode 100644 diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor old mode 100755 new mode 100644 diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor old mode 100755 new mode 100644 diff --git a/core/bootstrap/layouts/layouts.factor b/core/bootstrap/layouts/layouts.factor old mode 100755 new mode 100644 diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor old mode 100755 new mode 100644 diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor old mode 100755 new mode 100644 diff --git a/core/bootstrap/syntax.factor b/core/bootstrap/syntax.factor old mode 100755 new mode 100644 diff --git a/core/byte-arrays/byte-arrays-docs.factor b/core/byte-arrays/byte-arrays-docs.factor old mode 100755 new mode 100644 diff --git a/core/byte-arrays/byte-arrays-tests.factor b/core/byte-arrays/byte-arrays-tests.factor old mode 100755 new mode 100644 diff --git a/core/byte-arrays/byte-arrays.factor b/core/byte-arrays/byte-arrays.factor old mode 100755 new mode 100644 diff --git a/core/byte-vectors/byte-vectors-docs.factor b/core/byte-vectors/byte-vectors-docs.factor old mode 100755 new mode 100644 diff --git a/core/byte-vectors/byte-vectors-tests.factor b/core/byte-vectors/byte-vectors-tests.factor old mode 100755 new mode 100644 diff --git a/core/byte-vectors/byte-vectors.factor b/core/byte-vectors/byte-vectors.factor old mode 100755 new mode 100644 diff --git a/core/checksums/crc32/crc32.factor b/core/checksums/crc32/crc32.factor old mode 100755 new mode 100644 diff --git a/core/classes/algebra/algebra-docs.factor b/core/classes/algebra/algebra-docs.factor old mode 100755 new mode 100644 diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor old mode 100755 new mode 100644 diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor old mode 100755 new mode 100644 diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor old mode 100755 new mode 100644 diff --git a/core/classes/classes-tests.factor b/core/classes/classes-tests.factor old mode 100755 new mode 100644 diff --git a/core/classes/classes.factor b/core/classes/classes.factor old mode 100755 new mode 100644 diff --git a/core/classes/mixin/mixin-docs.factor b/core/classes/mixin/mixin-docs.factor old mode 100755 new mode 100644 diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor old mode 100755 new mode 100644 diff --git a/core/classes/predicate/predicate-docs.factor b/core/classes/predicate/predicate-docs.factor old mode 100755 new mode 100644 diff --git a/core/classes/predicate/predicate.factor b/core/classes/predicate/predicate.factor old mode 100755 new mode 100644 diff --git a/core/classes/singleton/singleton.factor b/core/classes/singleton/singleton.factor old mode 100755 new mode 100644 diff --git a/core/classes/tuple/tuple-docs.factor b/core/classes/tuple/tuple-docs.factor old mode 100755 new mode 100644 diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor old mode 100755 new mode 100644 diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor old mode 100755 new mode 100644 diff --git a/core/classes/union/union-docs.factor b/core/classes/union/union-docs.factor old mode 100755 new mode 100644 diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor old mode 100755 new mode 100644 diff --git a/core/combinators/combinators-docs.factor b/core/combinators/combinators-docs.factor old mode 100755 new mode 100644 diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor old mode 100755 new mode 100644 diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor old mode 100755 new mode 100644 diff --git a/core/compiler/errors/errors-docs.factor b/core/compiler/errors/errors-docs.factor old mode 100755 new mode 100644 diff --git a/core/compiler/errors/errors.factor b/core/compiler/errors/errors.factor old mode 100755 new mode 100644 diff --git a/core/compiler/units/units-docs.factor b/core/compiler/units/units-docs.factor old mode 100755 new mode 100644 diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor old mode 100755 new mode 100644 diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor old mode 100755 new mode 100644 diff --git a/core/continuations/continuations-tests.factor b/core/continuations/continuations-tests.factor old mode 100755 new mode 100644 diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor old mode 100755 new mode 100644 diff --git a/core/definitions/definitions-docs.factor b/core/definitions/definitions-docs.factor old mode 100755 new mode 100644 diff --git a/core/definitions/definitions-tests.factor b/core/definitions/definitions-tests.factor old mode 100755 new mode 100644 diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor old mode 100755 new mode 100644 diff --git a/core/destructors/destructors-docs.factor b/core/destructors/destructors-docs.factor old mode 100755 new mode 100644 diff --git a/core/destructors/destructors-tests.factor b/core/destructors/destructors-tests.factor old mode 100755 new mode 100644 diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor old mode 100755 new mode 100644 diff --git a/core/effects/effects.factor b/core/effects/effects.factor old mode 100755 new mode 100644 diff --git a/core/generic/generic-docs.factor b/core/generic/generic-docs.factor old mode 100755 new mode 100644 diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor old mode 100755 new mode 100644 diff --git a/core/generic/generic.factor b/core/generic/generic.factor old mode 100755 new mode 100644 diff --git a/core/generic/math/math-docs.factor b/core/generic/math/math-docs.factor old mode 100755 new mode 100644 diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor old mode 100755 new mode 100644 diff --git a/core/growable/growable-docs.factor b/core/growable/growable-docs.factor old mode 100755 new mode 100644 diff --git a/core/growable/growable-tests.factor b/core/growable/growable-tests.factor old mode 100755 new mode 100644 diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor old mode 100755 new mode 100644 diff --git a/core/hashtables/hashtables-tests.factor b/core/hashtables/hashtables-tests.factor old mode 100755 new mode 100644 diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor old mode 100755 new mode 100644 diff --git a/core/init/init.factor b/core/init/init.factor old mode 100755 new mode 100644 diff --git a/core/io/backend/backend-tests.factor b/core/io/backend/backend-tests.factor old mode 100755 new mode 100644 diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor old mode 100755 new mode 100644 diff --git a/core/io/binary/binary-tests.factor b/core/io/binary/binary-tests.factor old mode 100755 new mode 100644 diff --git a/core/io/binary/binary.factor b/core/io/binary/binary.factor old mode 100755 new mode 100644 diff --git a/core/io/encodings/binary/binary.factor b/core/io/encodings/binary/binary.factor old mode 100755 new mode 100644 diff --git a/core/io/encodings/encodings-tests.factor b/core/io/encodings/encodings-tests.factor old mode 100755 new mode 100644 diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor old mode 100755 new mode 100644 diff --git a/core/io/encodings/utf8/utf8-docs.factor b/core/io/encodings/utf8/utf8-docs.factor old mode 100755 new mode 100644 diff --git a/core/io/encodings/utf8/utf8-tests.factor b/core/io/encodings/utf8/utf8-tests.factor old mode 100755 new mode 100644 diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor old mode 100755 new mode 100644 diff --git a/core/io/files/files-docs.factor b/core/io/files/files-docs.factor old mode 100755 new mode 100644 diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor old mode 100755 new mode 100644 diff --git a/core/io/files/files.factor b/core/io/files/files.factor old mode 100755 new mode 100644 diff --git a/core/io/io-docs.factor b/core/io/io-docs.factor old mode 100755 new mode 100644 diff --git a/core/io/io-tests.factor b/core/io/io-tests.factor old mode 100755 new mode 100644 diff --git a/core/io/io.factor b/core/io/io.factor old mode 100755 new mode 100644 diff --git a/core/io/streams/c/c-docs.factor b/core/io/streams/c/c-docs.factor old mode 100755 new mode 100644 diff --git a/core/io/streams/c/c-tests.factor b/core/io/streams/c/c-tests.factor old mode 100755 new mode 100644 diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor old mode 100755 new mode 100644 diff --git a/core/io/streams/nested/nested.factor b/core/io/streams/nested/nested.factor old mode 100755 new mode 100644 diff --git a/core/io/streams/string/string.factor b/core/io/streams/string/string.factor old mode 100755 new mode 100644 diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor old mode 100755 new mode 100644 diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor old mode 100755 new mode 100644 diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor old mode 100755 new mode 100644 diff --git a/core/layouts/layouts-docs.factor b/core/layouts/layouts-docs.factor old mode 100755 new mode 100644 diff --git a/core/layouts/layouts-tests.factor b/core/layouts/layouts-tests.factor old mode 100755 new mode 100644 diff --git a/core/layouts/layouts.factor b/core/layouts/layouts.factor old mode 100755 new mode 100644 diff --git a/core/math/floats/floats-tests.factor b/core/math/floats/floats-tests.factor old mode 100755 new mode 100644 diff --git a/core/math/floats/floats.factor b/core/math/floats/floats.factor old mode 100755 new mode 100644 diff --git a/core/math/integers/integers-docs.factor b/core/math/integers/integers-docs.factor old mode 100755 new mode 100644 diff --git a/core/math/integers/integers-tests.factor b/core/math/integers/integers-tests.factor old mode 100755 new mode 100644 diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor old mode 100755 new mode 100644 diff --git a/core/math/math-docs.factor b/core/math/math-docs.factor old mode 100755 new mode 100644 diff --git a/core/math/math.factor b/core/math/math.factor old mode 100755 new mode 100644 diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor old mode 100755 new mode 100644 diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor old mode 100755 new mode 100644 diff --git a/core/memory/memory-docs.factor b/core/memory/memory-docs.factor old mode 100755 new mode 100644 diff --git a/core/memory/memory-tests.factor b/core/memory/memory-tests.factor old mode 100755 new mode 100644 diff --git a/core/namespaces/namespaces-docs.factor b/core/namespaces/namespaces-docs.factor old mode 100755 new mode 100644 diff --git a/core/parser/parser-docs.factor b/core/parser/parser-docs.factor old mode 100755 new mode 100644 diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor old mode 100755 new mode 100644 diff --git a/core/parser/parser.factor b/core/parser/parser.factor old mode 100755 new mode 100644 diff --git a/core/parser/test/assert-depth.factor b/core/parser/test/assert-depth.factor old mode 100755 new mode 100644 diff --git a/core/quotations/quotations-docs.factor b/core/quotations/quotations-docs.factor old mode 100755 new mode 100644 diff --git a/core/quotations/quotations-tests.factor b/core/quotations/quotations-tests.factor old mode 100755 new mode 100644 diff --git a/core/quotations/quotations.factor b/core/quotations/quotations.factor old mode 100755 new mode 100644 diff --git a/core/sbufs/sbufs.factor b/core/sbufs/sbufs.factor old mode 100755 new mode 100644 diff --git a/core/sequences/sequences-docs.factor b/core/sequences/sequences-docs.factor old mode 100755 new mode 100644 diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor old mode 100755 new mode 100644 diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor old mode 100755 new mode 100644 diff --git a/core/slots/slots-docs.factor b/core/slots/slots-docs.factor old mode 100755 new mode 100644 diff --git a/core/slots/slots.factor b/core/slots/slots.factor old mode 100755 new mode 100644 diff --git a/core/sorting/sorting-tests.factor b/core/sorting/sorting-tests.factor old mode 100755 new mode 100644 diff --git a/core/sorting/sorting.factor b/core/sorting/sorting.factor old mode 100755 new mode 100644 diff --git a/core/source-files/source-files-docs.factor b/core/source-files/source-files-docs.factor old mode 100755 new mode 100644 diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor old mode 100755 new mode 100644 diff --git a/core/splitting/splitting.factor b/core/splitting/splitting.factor old mode 100755 new mode 100644 diff --git a/core/strings/strings-docs.factor b/core/strings/strings-docs.factor old mode 100755 new mode 100644 diff --git a/core/strings/strings-tests.factor b/core/strings/strings-tests.factor old mode 100755 new mode 100644 diff --git a/core/strings/strings.factor b/core/strings/strings.factor old mode 100755 new mode 100644 diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor old mode 100755 new mode 100644 diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor old mode 100755 new mode 100644 diff --git a/core/system/system-docs.factor b/core/system/system-docs.factor old mode 100755 new mode 100644 diff --git a/core/system/system-tests.factor b/core/system/system-tests.factor old mode 100755 new mode 100644 diff --git a/core/system/system.factor b/core/system/system.factor old mode 100755 new mode 100644 diff --git a/core/vectors/vectors-docs.factor b/core/vectors/vectors-docs.factor old mode 100755 new mode 100644 diff --git a/core/vectors/vectors-tests.factor b/core/vectors/vectors-tests.factor old mode 100755 new mode 100644 diff --git a/core/vectors/vectors.factor b/core/vectors/vectors.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/loader/loader-tests.factor b/core/vocabs/loader/loader-tests.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/loader/test/a/a.factor b/core/vocabs/loader/test/a/a.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/loader/test/b/b.factor b/core/vocabs/loader/test/b/b.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/vocabs-docs.factor b/core/vocabs/vocabs-docs.factor old mode 100755 new mode 100644 diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor old mode 100755 new mode 100644 diff --git a/core/words/words-docs.factor b/core/words/words-docs.factor old mode 100755 new mode 100644 diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor old mode 100755 new mode 100644 diff --git a/core/words/words.factor b/core/words/words.factor old mode 100755 new mode 100644 From d657b52eb1523d539e6b6046f0c3363f421c4a3f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 10:52:13 -0500 Subject: [PATCH 027/244] Remove really obsolete stuff from unmaintained --- .../assoc-heaps/assoc-heaps-tests.factor | 55 -------- unmaintained/assoc-heaps/assoc-heaps.factor | 45 ------ unmaintained/assoc-heaps/authors.txt | 1 - unmaintained/assoc-heaps/summary.txt | 1 - unmaintained/webapps/help/authors.txt | 1 - unmaintained/webapps/help/help.factor | 89 ------------ .../webapps/pastebin/annotate-paste.furnace | 47 ------- .../webapps/pastebin/annotation.furnace | 11 -- unmaintained/webapps/pastebin/authors.txt | 1 - unmaintained/webapps/pastebin/footer.furnace | 3 - unmaintained/webapps/pastebin/header.furnace | 23 ---- unmaintained/webapps/pastebin/modes.furnace | 7 - .../webapps/pastebin/new-paste.furnace | 51 ------- .../webapps/pastebin/paste-list.furnace | 33 ----- .../webapps/pastebin/paste-summary.furnace | 12 -- unmaintained/webapps/pastebin/pastebin.factor | 119 ---------------- .../webapps/pastebin/show-paste.furnace | 21 --- unmaintained/webapps/pastebin/style.css | 41 ------ unmaintained/webapps/pastebin/syntax.furnace | 3 - unmaintained/webapps/planet/authors.txt | 1 - unmaintained/webapps/planet/planet.factor | 129 ------------------ unmaintained/webapps/planet/planet.furnace | 45 ------ unmaintained/webapps/planet/style.css | 45 ------ unmaintained/wee-url/load.factor | 4 - unmaintained/wee-url/responder.factor | 91 ------------ unmaintained/wee-url/wee-url.factor | 89 ------------ 26 files changed, 968 deletions(-) delete mode 100644 unmaintained/assoc-heaps/assoc-heaps-tests.factor delete mode 100755 unmaintained/assoc-heaps/assoc-heaps.factor delete mode 100755 unmaintained/assoc-heaps/authors.txt delete mode 100755 unmaintained/assoc-heaps/summary.txt delete mode 100755 unmaintained/webapps/help/authors.txt delete mode 100644 unmaintained/webapps/help/help.factor delete mode 100755 unmaintained/webapps/pastebin/annotate-paste.furnace delete mode 100755 unmaintained/webapps/pastebin/annotation.furnace delete mode 100755 unmaintained/webapps/pastebin/authors.txt delete mode 100644 unmaintained/webapps/pastebin/footer.furnace delete mode 100644 unmaintained/webapps/pastebin/header.furnace delete mode 100644 unmaintained/webapps/pastebin/modes.furnace delete mode 100755 unmaintained/webapps/pastebin/new-paste.furnace delete mode 100644 unmaintained/webapps/pastebin/paste-list.furnace delete mode 100644 unmaintained/webapps/pastebin/paste-summary.furnace delete mode 100755 unmaintained/webapps/pastebin/pastebin.factor delete mode 100755 unmaintained/webapps/pastebin/show-paste.furnace delete mode 100644 unmaintained/webapps/pastebin/style.css delete mode 100755 unmaintained/webapps/pastebin/syntax.furnace delete mode 100755 unmaintained/webapps/planet/authors.txt delete mode 100755 unmaintained/webapps/planet/planet.factor delete mode 100644 unmaintained/webapps/planet/planet.furnace delete mode 100644 unmaintained/webapps/planet/style.css delete mode 100644 unmaintained/wee-url/load.factor delete mode 100644 unmaintained/wee-url/responder.factor delete mode 100644 unmaintained/wee-url/wee-url.factor diff --git a/unmaintained/assoc-heaps/assoc-heaps-tests.factor b/unmaintained/assoc-heaps/assoc-heaps-tests.factor deleted file mode 100644 index 24a7730847..0000000000 --- a/unmaintained/assoc-heaps/assoc-heaps-tests.factor +++ /dev/null @@ -1,55 +0,0 @@ -USING: assocs assoc-heaps heaps heaps.private kernel tools.test ; -IN: temporary - -[ -T{ - assoc-heap - f - H{ { 2 1 } } - T{ min-heap T{ heap f V{ { 1 2 } } } } -} -] [ H{ } clone 1 2 pick heap-push ] unit-test - -[ -T{ - assoc-heap - f - H{ { 1 0 } { 2 1 } } - T{ min-heap T{ heap f V{ { 0 1 } { 1 2 } } } } -} -] [ H{ } clone 1 2 pick heap-push 0 1 pick heap-push ] unit-test - -[ T{ assoc-heap f H{ } T{ min-heap T{ heap f V{ } } } } ] -[ - H{ } clone - 1 2 pick heap-push 0 1 pick heap-push - dup heap-pop 2drop dup heap-pop 2drop -] unit-test - - -[ 0 1 ] [ -T{ - assoc-heap - f - H{ { 1 0 } { 2 1 } } - T{ min-heap T{ heap f V{ { 0 1 } { 1 2 } } } } -} heap-pop -] unit-test - -[ 1 2 ] [ -T{ - assoc-heap - f - H{ { 1 0 } { 2 1 } } - T{ max-heap T{ heap f V{ { 1 2 } { 0 1 } } } } -} heap-pop -] unit-test - -[ -T{ - assoc-heap - f - H{ { 1 2 } { 3 4 } } - T{ min-heap T{ heap f V{ { 2 1 } { 4 3 } } } } -} -] [ H{ { 1 2 } { 3 4 } } H{ } clone [ heap-push-all ] keep ] unit-test diff --git a/unmaintained/assoc-heaps/assoc-heaps.factor b/unmaintained/assoc-heaps/assoc-heaps.factor deleted file mode 100755 index 55a5aa7f62..0000000000 --- a/unmaintained/assoc-heaps/assoc-heaps.factor +++ /dev/null @@ -1,45 +0,0 @@ -USING: assocs heaps kernel sequences ; -IN: assoc-heaps - -TUPLE: assoc-heap assoc heap ; - -INSTANCE: assoc-heap assoc -INSTANCE: assoc-heap priority-queue - -C: assoc-heap - -: ( assoc -- obj ) ; -: ( assoc -- obj ) ; - -M: assoc-heap at* ( key assoc-heap -- value ? ) - assoc-heap-assoc at* ; - -M: assoc-heap assoc-size ( assoc-heap -- n ) - assoc-heap-assoc assoc-size ; - -TUPLE: assoc-heap-key-exists ; - -: check-key-exists ( key assoc-heap -- ) - assoc-heap-assoc key? - [ \ assoc-heap-key-exists construct-empty throw ] when ; - -M: assoc-heap set-at ( value key assoc-heap -- ) - [ check-key-exists ] 2keep - [ assoc-heap-assoc set-at ] 3keep - assoc-heap-heap swapd heap-push ; - -M: assoc-heap heap-empty? ( assoc-heap -- ? ) - assoc-heap-assoc assoc-empty? ; - -M: assoc-heap heap-length ( assoc-heap -- n ) - assoc-heap-assoc assoc-size ; - -M: assoc-heap heap-peek ( assoc-heap -- value key ) - assoc-heap-heap heap-peek ; - -M: assoc-heap heap-push ( value key assoc-heap -- ) - set-at ; - -M: assoc-heap heap-pop ( assoc-heap -- value key ) - dup assoc-heap-heap heap-pop swap - rot dupd assoc-heap-assoc delete-at ; diff --git a/unmaintained/assoc-heaps/authors.txt b/unmaintained/assoc-heaps/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/unmaintained/assoc-heaps/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/unmaintained/assoc-heaps/summary.txt b/unmaintained/assoc-heaps/summary.txt deleted file mode 100755 index 07ae2e33f8..0000000000 --- a/unmaintained/assoc-heaps/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Priority search queues diff --git a/unmaintained/webapps/help/authors.txt b/unmaintained/webapps/help/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/unmaintained/webapps/help/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/unmaintained/webapps/help/help.factor b/unmaintained/webapps/help/help.factor deleted file mode 100644 index 28d73607ba..0000000000 --- a/unmaintained/webapps/help/help.factor +++ /dev/null @@ -1,89 +0,0 @@ -! Copyright (C) 2005, 2007 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel furnace furnace.validator http.server.responders - help help.topics html splitting sequences words strings - quotations macros vocabs tools.browser combinators - arrays io.files ; -IN: webapps.help - -! : string>topic ( string -- topic ) - ! " " split dup length 1 = [ first ] when ; - -: show-help ( topic -- ) - serving-html - dup article-title [ - [ help ] with-html-stream - ] simple-html-document ; - -\ show-help { - { "topic" } -} define-action -\ show-help { { "topic" "handbook" } } default-values - -M: link browser-link-href - link-name - dup word? over f eq? or [ - browser-link-href - ] [ - dup array? [ " " join ] when - [ show-help ] curry quot-link - ] if ; - -: show-word ( word vocab -- ) - lookup show-help ; - -\ show-word { - { "word" } - { "vocab" } -} define-action -\ show-word { { "word" "call" } { "vocab" "kernel" } } default-values - -M: f browser-link-href - drop \ f browser-link-href ; - -M: word browser-link-href - dup word-name swap word-vocabulary - [ show-word ] 2curry quot-link ; - -: show-vocab ( vocab -- ) - f >vocab-link show-help ; - -\ show-vocab { - { "vocab" } -} define-action - -\ show-vocab { { "vocab" "kernel" } } default-values - -M: vocab-spec browser-link-href - vocab-name [ show-vocab ] curry quot-link ; - -: show-vocabs-tagged ( tag -- ) - show-help ; - -\ show-vocabs-tagged { - { "tag" } -} define-action - -M: vocab-tag browser-link-href - vocab-tag-name [ show-vocabs-tagged ] curry quot-link ; - -: show-vocabs-by ( author -- ) - show-help ; - -\ show-vocabs-by { - { "author" } -} define-action - -M: vocab-author browser-link-href - vocab-author-name [ show-vocabs-by ] curry quot-link ; - -"help" "show-help" "extra/webapps/help" web-app - -! Hard-coding for factorcode.org -PREDICATE: pathname resource-pathname - pathname-string "resource:" head? ; - -M: resource-pathname browser-link-href - pathname-string - "resource:" ?head drop - "/responder/source/" swap append ; diff --git a/unmaintained/webapps/pastebin/annotate-paste.furnace b/unmaintained/webapps/pastebin/annotate-paste.furnace deleted file mode 100755 index 14a424f776..0000000000 --- a/unmaintained/webapps/pastebin/annotate-paste.furnace +++ /dev/null @@ -1,47 +0,0 @@ -<% USING: io math math.parser namespaces furnace ; %> - -

Annotate

- -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Summary:" /><% "summary" "*Required" render-error %>
Your name:" /><% "author" "*Required" render-error %>
File type:<% "modes" render-template %>
<% "contents" "*Required" render-error %>
Content:
- -string write %>" /> - - -
diff --git a/unmaintained/webapps/pastebin/annotation.furnace b/unmaintained/webapps/pastebin/annotation.furnace deleted file mode 100755 index e59db32484..0000000000 --- a/unmaintained/webapps/pastebin/annotation.furnace +++ /dev/null @@ -1,11 +0,0 @@ -<% USING: namespaces io furnace calendar ; %> - -

Annotation: <% "summary" get write %>

- - - - - -
Annotation by:<% "author" get write %>
File type:<% "mode" get write %>
Created:<% "date" get timestamp>string write %>
- -<% "syntax" render-template %> diff --git a/unmaintained/webapps/pastebin/authors.txt b/unmaintained/webapps/pastebin/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/unmaintained/webapps/pastebin/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/unmaintained/webapps/pastebin/footer.furnace b/unmaintained/webapps/pastebin/footer.furnace deleted file mode 100644 index 15b90110a0..0000000000 --- a/unmaintained/webapps/pastebin/footer.furnace +++ /dev/null @@ -1,3 +0,0 @@ - - - diff --git a/unmaintained/webapps/pastebin/header.furnace b/unmaintained/webapps/pastebin/header.furnace deleted file mode 100644 index 2c8e79a18d..0000000000 --- a/unmaintained/webapps/pastebin/header.furnace +++ /dev/null @@ -1,23 +0,0 @@ -<% USING: namespaces io furnace sequences xmode.code2html webapps.pastebin ; %> - - - - - - - - <% "title" get write %> - - <% default-stylesheet %> - - - - - -
- <% [ paste-list ] "Paste list" render-link %> | - <% [ new-paste ] "New paste" render-link %> | - <% [ feed.xml ] "Syndicate" render-link %> -
-

<% "title" get write %>

diff --git a/unmaintained/webapps/pastebin/modes.furnace b/unmaintained/webapps/pastebin/modes.furnace deleted file mode 100644 index 18bbec180a..0000000000 --- a/unmaintained/webapps/pastebin/modes.furnace +++ /dev/null @@ -1,7 +0,0 @@ -<% USING: furnace xmode.catalog sequences kernel html.elements assocs io sorting continuations ; %> - - diff --git a/unmaintained/webapps/pastebin/new-paste.furnace b/unmaintained/webapps/pastebin/new-paste.furnace deleted file mode 100755 index b21e19734d..0000000000 --- a/unmaintained/webapps/pastebin/new-paste.furnace +++ /dev/null @@ -1,51 +0,0 @@ -<% USING: continuations furnace namespaces ; %> - -<% - "New paste" "title" set - "header" render-template -%> - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Summary:" /><% "summary" "*Required" render-error %>
Your name:" /><% "author" "*Required" render-error %>
File type:<% "modes" render-template %>
<% "contents" "*Required" render-error %>
Content:
- - - -
- -<% "footer" render-template %> diff --git a/unmaintained/webapps/pastebin/paste-list.furnace b/unmaintained/webapps/pastebin/paste-list.furnace deleted file mode 100644 index 51813ecf97..0000000000 --- a/unmaintained/webapps/pastebin/paste-list.furnace +++ /dev/null @@ -1,33 +0,0 @@ -<% USING: namespaces furnace sequences ; %> - -<% - "Pastebin" "title" set - "header" render-template -%> - - - - - - -
- - - - - - - <% "pastes" get [ "paste-summary" render-component ] each %> -
Summary:Paste by:Date:
- 		-
-

This pastebin is written in Factor. It is inspired by lisppaste. -

-

It can be used for collaborative development over IRC. You can post code for review, and annotate other people's code. Syntax highlighting for over a hundred file types is supported. -

-

- <% "webapps.pastebin" browse-webapp-source %>

-
-
- -<% "footer" render-template %> diff --git a/unmaintained/webapps/pastebin/paste-summary.furnace b/unmaintained/webapps/pastebin/paste-summary.furnace deleted file mode 100644 index dc25fe1924..0000000000 --- a/unmaintained/webapps/pastebin/paste-summary.furnace +++ /dev/null @@ -1,12 +0,0 @@ -<% USING: continuations namespaces io kernel math math.parser -furnace webapps.pastebin calendar sequences ; %> - - - - - <% "summary" get write %> - - - <% "author" get write %> - <% "date" get timestamp>string write %> - diff --git a/unmaintained/webapps/pastebin/pastebin.factor b/unmaintained/webapps/pastebin/pastebin.factor deleted file mode 100755 index 36a72795db..0000000000 --- a/unmaintained/webapps/pastebin/pastebin.factor +++ /dev/null @@ -1,119 +0,0 @@ -USING: calendar furnace furnace.validator io.files kernel -namespaces sequences http.server.responders html math.parser rss -xml.writer xmode.code2html math calendar.format ; -IN: webapps.pastebin - -TUPLE: pastebin pastes ; - -: ( -- pastebin ) - V{ } clone pastebin construct-boa ; - - pastebin set-global - -TUPLE: paste -summary author channel mode contents date -annotations n ; - -: ( summary author channel mode contents -- paste ) - f V{ } clone f paste construct-boa ; - -TUPLE: annotation summary author mode contents ; - -C: annotation - -: get-paste ( n -- paste ) - pastebin get pastebin-pastes nth ; - -: show-paste ( n -- ) - serving-html - get-paste - [ "show-paste" render-component ] with-html-stream ; - -\ show-paste { { "n" v-number } } define-action - -: new-paste ( -- ) - serving-html - [ "new-paste" render-template ] with-html-stream ; - -\ new-paste { } define-action - -: paste-list ( -- ) - serving-html - [ - [ show-paste ] "show-paste-quot" set - [ new-paste ] "new-paste-quot" set - pastebin get "paste-list" render-component - ] with-html-stream ; - -\ paste-list { } define-action - -: paste-link ( paste -- link ) - paste-n number>string [ show-paste ] curry quot-link ; - -: safe-head ( seq n -- seq' ) - over length min head ; - -: paste-feed ( -- entries ) - pastebin get pastebin-pastes 20 safe-head [ - { - paste-summary - paste-link - paste-date - } get-slots timestamp>rfc3339 f swap - ] map ; - -: feed.xml ( -- ) - "text/xml" serving-content - "pastebin" - "http://pastebin.factorcode.org" - paste-feed feed>xml write-xml ; - -\ feed.xml { } define-action - -: add-paste ( paste pastebin -- ) - >r now over set-paste-date r> - pastebin-pastes 2dup length swap set-paste-n push ; - -: submit-paste ( summary author channel mode contents -- ) - [ pastebin get add-paste ] keep - paste-link permanent-redirect ; - -\ new-paste -\ submit-paste { - { "summary" v-required } - { "author" v-required } - { "channel" } - { "mode" v-required } - { "contents" v-required } -} define-form - -\ new-paste { - { "channel" "#concatenative" } - { "mode" "factor" } -} default-values - -: annotate-paste ( n summary author mode contents -- ) - swap get-paste - [ paste-annotations push ] keep - paste-link permanent-redirect ; - -[ "n" show-paste ] -\ annotate-paste { - { "n" v-required v-number } - { "summary" v-required } - { "author" v-required } - { "mode" v-required } - { "contents" v-required } -} define-form - -\ show-paste { - { "mode" "factor" } -} default-values - -: style.css ( -- ) - "text/css" serving-content - "style.css" send-resource ; - -\ style.css { } define-action - -"pastebin" "paste-list" "extra/webapps/pastebin" web-app diff --git a/unmaintained/webapps/pastebin/show-paste.furnace b/unmaintained/webapps/pastebin/show-paste.furnace deleted file mode 100755 index 30129eda24..0000000000 --- a/unmaintained/webapps/pastebin/show-paste.furnace +++ /dev/null @@ -1,21 +0,0 @@ -<% USING: namespaces io furnace sequences xmode.code2html calendar ; %> - -<% - "Paste: " "summary" get append "title" set - "header" render-template -%> - - - - - - -
Paste by:<% "author" get write %>
Created:<% "date" get timestamp>string write %>
File type:<% "mode" get write %>
- -<% "syntax" render-template %> - -<% "annotations" get [ "annotation" render-component ] each %> - -<% model get "annotate-paste" render-component %> - -<% "footer" render-template %> diff --git a/unmaintained/webapps/pastebin/style.css b/unmaintained/webapps/pastebin/style.css deleted file mode 100644 index 4a469f92cb..0000000000 --- a/unmaintained/webapps/pastebin/style.css +++ /dev/null @@ -1,41 +0,0 @@ -body { - font:75%/1.6em "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif; - color:#888; -} - -h1.pastebin-title { - font-size:300%; -} - -a { - color:#222; - border-bottom:1px dotted #ccc; - text-decoration:none; -} - -a:hover { - border-bottom:1px solid #ccc; -} - -pre.code { - border:1px dashed #ccc; - background-color:#f5f5f5; - padding:5px; - font-size:150%; - color:#000000; -} - -.navbar { - background-color:#eeeeee; - padding:5px; - border:1px solid #ccc; -} - -.infobox { - border: 1px solid #C1DAD7; - padding: 10px; -} - -.error { - color: red; -} diff --git a/unmaintained/webapps/pastebin/syntax.furnace b/unmaintained/webapps/pastebin/syntax.furnace deleted file mode 100755 index 17b64b920b..0000000000 --- a/unmaintained/webapps/pastebin/syntax.furnace +++ /dev/null @@ -1,3 +0,0 @@ -<% USING: xmode.code2html splitting namespaces ; %> - -
<% "contents" get string-lines "mode" get htmlize-lines %>
diff --git a/unmaintained/webapps/planet/authors.txt b/unmaintained/webapps/planet/authors.txt deleted file mode 100755 index 1901f27a24..0000000000 --- a/unmaintained/webapps/planet/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov diff --git a/unmaintained/webapps/planet/planet.factor b/unmaintained/webapps/planet/planet.factor deleted file mode 100755 index 9a5f8eeb97..0000000000 --- a/unmaintained/webapps/planet/planet.factor +++ /dev/null @@ -1,129 +0,0 @@ -USING: sequences rss arrays concurrency.combinators kernel -sorting html.elements io assocs namespaces math threads vocabs -html furnace http.server.templating calendar math.parser -splitting continuations debugger system http.server.responders -xml.writer prettyprint logging calendar.format ; -IN: webapps.planet - -: print-posting-summary ( posting -- ) -

- dup entry-title write
- - "Read More..." write - -

; - -: print-posting-summaries ( postings -- ) - [ print-posting-summary ] each ; - -: print-blogroll ( blogroll -- ) - ; - -: format-date ( date -- string ) - rfc3339>timestamp timestamp>string ; - -: print-posting ( posting -- ) -

- - dup entry-title write-html - -

-

- dup entry-description write-html -

-

- entry-pub-date format-date write -

; - -: print-postings ( postings -- ) - [ print-posting ] each ; - -SYMBOL: default-blogroll -SYMBOL: cached-postings - -: safe-head ( seq n -- seq' ) - over length min head ; - -: mini-planet-factor ( -- ) - cached-postings get 4 safe-head print-posting-summaries ; - -: planet-factor ( -- ) - serving-html [ "planet" render-template ] with-html-stream ; - -\ planet-factor { } define-action - -: planet-feed ( -- feed ) - "[ planet-factor ]" - "http://planet.factorcode.org" - cached-postings get 30 safe-head ; - -: feed.xml ( -- ) - "text/xml" serving-content - planet-feed feed>xml write-xml ; - -\ feed.xml { } define-action - -: style.css ( -- ) - "text/css" serving-content - "style.css" send-resource ; - -\ style.css { } define-action - -SYMBOL: last-update - -: ( author entry -- entry' ) - clone - [ ": " swap entry-title 3append ] keep - [ set-entry-title ] keep ; - -: fetch-feed ( url -- feed ) - download-feed feed-entries ; - -\ fetch-feed DEBUG add-error-logging - -: fetch-blogroll ( blogroll -- entries ) - dup 0 swap 1 - [ fetch-feed ] parallel-map - [ [ ] with map ] 2map concat ; - -: sort-entries ( entries -- entries' ) - [ [ entry-pub-date ] compare ] sort ; - -: update-cached-postings ( -- ) - default-blogroll get - fetch-blogroll sort-entries - cached-postings set-global ; - -: update-thread ( -- ) - millis last-update set-global - [ update-cached-postings ] "RSS feed update slave" spawn drop - 10 60 * 1000 * sleep - update-thread ; - -: start-update-thread ( -- ) - [ - "webapps.planet" [ - update-thread - ] with-logging - ] "RSS feed update master" spawn drop ; - -"planet" "planet-factor" "extra/webapps/planet" web-app - -{ - { "Berlin Brown" "http://factorlang-fornovices.blogspot.com/feeds/posts/default" "http://factorlang-fornovices.blogspot.com" } - { "Chris Double" "http://www.blogger.com/feeds/18561009/posts/full/-/factor" "http://www.bluishcoder.co.nz/" } - { "Elie Chaftari" "http://fun-factor.blogspot.com/feeds/posts/default" "http://fun-factor.blogspot.com/" } - { "Doug Coleman" "http://code-factor.blogspot.com/feeds/posts/default" "http://code-factor.blogspot.com/" } - { "Daniel Ehrenberg" "http://useless-factor.blogspot.com/feeds/posts/default" "http://useless-factor.blogspot.com/" } - { "Gavin Harrison" "http://gmh33.blogspot.com/feeds/posts/default" "http://gmh33.blogspot.com/" } - { "Kio M. Smallwood" - "http://sekenre.wordpress.com/feed/atom/" - "http://sekenre.wordpress.com/" } - { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" } - { "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" } - { "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" } -} default-blogroll set-global diff --git a/unmaintained/webapps/planet/planet.furnace b/unmaintained/webapps/planet/planet.furnace deleted file mode 100644 index 4c6676c0a2..0000000000 --- a/unmaintained/webapps/planet/planet.furnace +++ /dev/null @@ -1,45 +0,0 @@ -<% USING: namespaces html.elements webapps.planet sequences -furnace ; %> - - - - - - - - planet-factor - - - - - -

[ planet-factor ]

- - - - - -
<% cached-postings get 20 safe-head print-postings %> -

- planet-factor is an Atom/RSS aggregator that collects the - contents of Factor-related blogs. It is inspired by - Planet Lisp. -

-

- - Syndicate -

-

- This webapp is written in Factor.
- <% "webapps.planet" browse-webapp-source %> -

-

Blogroll

- <% default-blogroll get print-blogroll %> -

- If you want your weblog added to the blogroll, just ask. -

-
- - - diff --git a/unmaintained/webapps/planet/style.css b/unmaintained/webapps/planet/style.css deleted file mode 100644 index 7a66d8d495..0000000000 --- a/unmaintained/webapps/planet/style.css +++ /dev/null @@ -1,45 +0,0 @@ -body { - font:75%/1.6em "Lucida Grande", "Lucida Sans Unicode", verdana, geneva, sans-serif; - color:#888; -} - -h1.planet-title { - font-size:300%; -} - -a { - color:#222; - border-bottom:1px dotted #ccc; - text-decoration:none; -} - -a:hover { - border-bottom:1px solid #ccc; -} - -.posting-title { - background-color:#f5f5f5; -} - -pre, code { - color:#000000; - font-size:120%; -} - -.infobox { - border-left: 1px solid #C1DAD7; -} - -.posting-date { - text-align: right; - font-size:90%; -} - -a.more { - display:block; - padding:0 0 5px 0; - color:#333; - text-decoration:none; - text-align:right; - border:none; -} diff --git a/unmaintained/wee-url/load.factor b/unmaintained/wee-url/load.factor deleted file mode 100644 index 96d27164e8..0000000000 --- a/unmaintained/wee-url/load.factor +++ /dev/null @@ -1,4 +0,0 @@ -REQUIRES: apps/http-server libs/store ; - -PROVIDE: apps/wee-url -{ +files+ { "responder.factor" } } ; diff --git a/unmaintained/wee-url/responder.factor b/unmaintained/wee-url/responder.factor deleted file mode 100644 index 4d7b076cb6..0000000000 --- a/unmaintained/wee-url/responder.factor +++ /dev/null @@ -1,91 +0,0 @@ -! Copyright (C) 2006 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: generic assocs help html httpd -io kernel math namespaces prettyprint sequences store strings ; -IN: wee-url-responder - -SYMBOL: wee-shortcuts -SYMBOL: wee-store - -"wee-url.store" load-store wee-store set-global -H{ } clone wee-shortcuts wee-store get store-variable - -: responder-url "responder-url" get ; - -: wee-url ( string -- url ) - [ - "http://" % - host % - responder-url % - % - ] "" make ; - -: letter-bank - "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" ; - -: random-letter letter-bank length random letter-bank nth ; - -: random-url ( -- string ) - 6 random 1+ [ drop random-letter ] map >string - dup wee-shortcuts get key? [ drop random-url ] when ; - -: prepare-wee-url ( url -- url ) - CHAR: : over member? [ "http://" swap append ] unless ; - -: set-symmetric-hash ( obj1 obj2 hash -- ) - 3dup set-at swapd set-at ; - -: add-shortcut ( url-long -- url-short ) - dup wee-shortcuts get at* [ - nip - ] [ - drop - random-url [ wee-shortcuts get set-symmetric-hash ] keep - wee-store get save-store - ] if ; - -: url-prompt ( -- ) - serving-html - "wee-url.com - wee URLs since 2007" [ -
- "URL: " write - - -
- ] simple-html-document ; - -: url-submitted ( url-long url-short -- ) - "URL Submitted" [ - "URL: " write write nl - "wee-url: " write - wee-url write nl - "Back to " write - "wee-url" write nl - ] simple-html-document ; - -: url-submit ( url -- ) - serving-html - prepare-wee-url [ add-shortcut ] keep url-submitted ; - -: url-error ( -- ) - serving-html - "wee-url error" [ - "No such link." write - ] simple-html-document ; - -: wee-url-responder ( url -- ) - "url" query-param [ - url-submit drop - ] [ - dup empty? [ - drop url-prompt - ] [ - wee-shortcuts get at* - [ permanent-redirect ] [ drop url-error ] if - ] if - ] if* ; - -[ - "wee-url" "responder" set - [ wee-url-responder ] "get" set -] make-responder diff --git a/unmaintained/wee-url/wee-url.factor b/unmaintained/wee-url/wee-url.factor deleted file mode 100644 index ead2ee8976..0000000000 --- a/unmaintained/wee-url/wee-url.factor +++ /dev/null @@ -1,89 +0,0 @@ -! Copyright (C) 2007 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: assocs furnace html html.elements http.server -http.server.responders io kernel math math.ranges -namespaces random sequences store strings ; -IN: webapps.wee-url - -SYMBOL: shortcuts -SYMBOL: store - -! "wee-url.store" load-store store set-global -! H{ } clone shortcuts store get store-variable - -: set-at-once ( value key assoc -- ? ) - 2dup key? [ 3drop f ] [ set-at t ] if ; - -: responder-url "responder/wee-url" ; - -: wee-url ( string -- url ) - [ - "http://" % - host % - responder-url % - % - ] "" make ; - -: letter-bank - "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" ; inline - -: random-url ( -- string ) - 1 6 [a,b] random [ drop letter-bank random ] "" map-as - dup shortcuts get key? [ drop random-url ] when ; - -: add-shortcut ( url-long url-short -- url-short ) - shortcuts get set-at-once [ - store get save-store - ] [ - drop - ] if ; - -: show-submit ( -- ) - serving-html - "wee-url.com - wee URLs since 2007" [ -
- "URL: " write - - -
- ] simple-html-document ; - -\ show-submit { } define-action - -: url-submitted ( url-long url-short -- ) - "URL Submitted" [ - "URL: " write write nl - "wee-url: " write - wee-url write nl - "Back to " write - "wee-url" write nl - ] simple-html-document ; - -: url-submit ( url -- ) - [ add-shortcut ] keep - url-submitted ; - -\ url-submit { - { "url" } -} define-action - -: url-error ( -- ) - serving-html - "wee-url error" [ - "No such link." write - ] simple-html-document ; - -: wee-url-responder ( url -- ) - "url" query-param [ - url-submit drop - ] [ - dup empty? [ - drop show-submit - ] [ - shortcuts get at* - [ permanent-redirect ] [ drop url-error ] if - ] if - ] if* ; - -! "wee-url" "wee-url-responder" "extra/webapps/wee-url" web-app -~ From dbae275dc221281e4ca8902aa0cc6d0d1b72685b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 10:52:57 -0500 Subject: [PATCH 028/244] Don't need cocoa.standalone --- basis/cocoa/standalone/standalone.factor | 12 ------------ 1 file changed, 12 deletions(-) delete mode 100644 basis/cocoa/standalone/standalone.factor diff --git a/basis/cocoa/standalone/standalone.factor b/basis/cocoa/standalone/standalone.factor deleted file mode 100644 index 528736f172..0000000000 --- a/basis/cocoa/standalone/standalone.factor +++ /dev/null @@ -1,12 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel cocoa.nibs cocoa.application cocoa ; -IN: cocoa.standalone - -: cocoa-app ( quot -- ) - [ - "MiniFactor.nib" load-nib - call - finish-launching - NSApp -> run - ] with-cocoa ; inline From efe0bf2ecd39a5c197d1b995b0541364eb1f8c0d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 10:53:12 -0500 Subject: [PATCH 029/244] Document cocoa-app combinator --- basis/cocoa/application/application-docs.factor | 13 ++++++++++--- basis/cocoa/application/application.factor | 7 +++++++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/basis/cocoa/application/application-docs.factor b/basis/cocoa/application/application-docs.factor index 55fa5e10b8..791613e876 100644 --- a/basis/cocoa/application/application-docs.factor +++ b/basis/cocoa/application/application-docs.factor @@ -26,6 +26,10 @@ HELP: with-cocoa { $values { "quot" quotation } } { $description "Sets up an autorelease pool, initializes the " { $snippet "NSApplication" } " singleton, and calls the quotation." } ; +HELP: cocoa-app +{ $values { "quot" quotation } } +{ $description "Initializes Cocoa, calls the quotation, and starts the Cocoa event loop." } ; + HELP: do-event { $values { "app" "an " { $snippet "NSApplication" } } { "?" "a boolean" } } { $description "Processes a pending event in the queue, if any, returning a boolean indicating if there was one. Does not block." } ; @@ -46,13 +50,16 @@ HELP: objc-error { $error-description "Thrown by the Objective C runtime when an error occurs, for example, sending a message to an object with an unrecognized selector." } ; ARTICLE: "cocoa-application-utils" "Cocoa application utilities" +"Utilities:" { $subsection NSApp } -{ $subsection with-autorelease-pool } -{ $subsection with-cocoa } { $subsection do-event } { $subsection add-observer } { $subsection remove-observer } -{ $subsection install-delegate } ; +{ $subsection install-delegate } +"Combinators:" +{ $subsection cocoa-app } +{ $subsection with-autorelease-pool } +{ $subsection with-cocoa } ; IN: cocoa.application ABOUT: "cocoa-application-utils" diff --git a/basis/cocoa/application/application.factor b/basis/cocoa/application/application.factor index 065a4abc5a..8f32782d76 100644 --- a/basis/cocoa/application/application.factor +++ b/basis/cocoa/application/application.factor @@ -50,6 +50,13 @@ FUNCTION: void NSBeep ( ) ; : finish-launching ( -- ) NSApp -> finishLaunching ; +: cocoa-app ( quot -- ) + [ + call + finish-launching + NSApp -> run + ] with-cocoa ; inline + : install-delegate ( receiver delegate -- ) -> alloc -> init -> setDelegate: ; From d5bbbd90e4ccf3d286b31624eb5910234c89d18c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 10:53:19 -0500 Subject: [PATCH 030/244] Fix typo --- basis/tools/scaffold/scaffold-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index 479b636fcf..d2989d3cac 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -5,7 +5,7 @@ IN: tools.scaffold HELP: developer-name { $description "Set this symbol to hold your name so that the scaffold tools can generate the correct file header for copyright. Setting this variable in your .factor-boot-rc file is recommended." } -{ $unchecked-example "USING: namespaces tools.scaffold ;\n\"Stacky Guy\" developer-name set-global" } ; +{ $code "USING: namespaces tools.scaffold ;\n\"Stacky Guy\" developer-name set-global" } ; HELP: help. { $values From 00afda7f7e91ca8654119a07d3a2a8f773707e36 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 2 Oct 2008 10:53:30 -0500 Subject: [PATCH 031/244] Don't copy freetype over if UI is not deployed --- basis/tools/deploy/backend/backend.factor | 8 +++++--- basis/tools/deploy/macosx/macosx.factor | 24 ++++++++++++++++++----- basis/tools/deploy/windows/windows.factor | 23 ++++++++++++++-------- 3 files changed, 39 insertions(+), 16 deletions(-) diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index cb899f4b87..a0565c6bab 100644 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -10,13 +10,15 @@ io.encodings.utf8 destructors accessors ; IN: tools.deploy.backend : copy-vm ( executable bundle-name extension -- vm ) - [ prepend-path ] dip append vm over copy-file ; + [ prepend-path ] dip append vm over copy-file ; : copy-fonts ( name dir -- ) - append-path "resource:fonts/" swap copy-tree-into ; + deploy-ui? get [ + append-path "resource:fonts/" swap copy-tree-into + ] [ 2drop ] if ; : image-name ( vocab bundle-name -- str ) - prepend-path ".image" append ; + prepend-path ".image" append ; : copy-lines ( -- ) readln [ print flush copy-lines ] when* ; diff --git a/basis/tools/deploy/macosx/macosx.factor b/basis/tools/deploy/macosx/macosx.factor index ee60ce3982..d3464993e1 100644 --- a/basis/tools/deploy/macosx/macosx.factor +++ b/basis/tools/deploy/macosx/macosx.factor @@ -4,7 +4,7 @@ USING: io io.files kernel namespaces make sequences system tools.deploy.backend tools.deploy.config assocs hashtables prettyprint io.unix.backend cocoa io.encodings.utf8 io.backend cocoa.application cocoa.classes cocoa.plists -qualified ; +qualified combinators ; IN: tools.deploy.macosx : bundle-dir ( -- dir ) @@ -30,12 +30,26 @@ IN: tools.deploy.macosx "Contents/Info.plist" append-path write-plist ; +: copy-dll ( bundle-name -- ) + "Frameworks/libfactor.dylib" copy-bundle-dir ; + +: copy-freetype ( bundle-name -- ) + deploy-ui? get [ "Frameworks" copy-bundle-dir ] [ drop ] if ; + +: copy-nib ( bundle-name -- ) + deploy-ui? get [ + "Resources/English.lproj/MiniFactor.nib" copy-bundle-dir + ] [ drop ] if ; + : create-app-dir ( vocab bundle-name -- vm ) [ - nip - [ "Frameworks" copy-bundle-dir ] - [ "Resources/English.lproj/MiniFactor.nib" copy-bundle-dir ] - [ "Contents/Resources/" copy-fonts ] tri + nip { + [ copy-dll ] + [ copy-freetype ] + [ copy-nib ] + [ "Contents/Resources/" copy-fonts ] + [ "Contents/Resources" append-path make-directories ] + } cleave ] [ create-app-plist ] [ "Contents/MacOS/" append-path "" copy-vm ] 2tri ; diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor index e0ce2c268a..ce4fee19d7 100644 --- a/basis/tools/deploy/windows/windows.factor +++ b/basis/tools/deploy/windows/windows.factor @@ -5,16 +5,23 @@ tools.deploy.backend tools.deploy.config assocs hashtables prettyprint combinators windows.shell32 windows.user32 ; IN: tools.deploy.windows -: copy-dlls ( bundle-name -- ) - { - "resource:freetype6.dll" - "resource:zlib1.dll" - "resource:factor.dll" - } swap copy-files-into ; +: copy-dll ( bundle-name -- ) + "resource:factor.dll" swap copy-file-into ; + +: copy-freetype ( bundle-name -- ) + deploy-ui? get [ + { + "resource:freetype6.dll" + "resource:zlib1.dll" + } swap copy-files-into + ] when ; : create-exe-dir ( vocab bundle-name -- vm ) - dup copy-dlls - dup "" copy-fonts + deploy-ui? get [ + dup copy-dll + dup copy-freetype + dup "" copy-fonts + ] when ".exe" copy-vm ; M: winnt deploy* From 67683dde20affbdc8c8897c95b614a66e3758dff Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 12:11:56 -0500 Subject: [PATCH 032/244] make-db is gone, use or instead. docs. use dip instead of >r r> --- basis/db/db-docs.factor | 113 ++++++++------------------ basis/db/db.factor | 13 +-- basis/db/pools/pools.factor | 8 +- basis/db/postgresql/postgresql.factor | 25 +++--- basis/db/sqlite/sqlite.factor | 18 ++-- basis/db/tuples/tuples-tests.factor | 39 +++++---- 6 files changed, 90 insertions(+), 126 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 74b72b8789..a4a948d07f 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -5,27 +5,19 @@ alien assocs strings math multiline quotations ; IN: db HELP: db -{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ; +{ $description "The " { $snippet "db" } " class is the superclass of all other database classes. It stores a " { $snippet "handle" } " to the database as well as insert, update, and delete queries." } ; HELP: new-db { $values { "class" class } { "obj" object } } -{ $description "Creates a new database object from a given class." } ; - -HELP: make-db* -{ $values { "object" object } { "db" object } { "db" object } } -{ $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ; - -HELP: make-db -{ $values { "object" object } { "class" class } { "db" db } } -{ $description "Takes a sequence of parameters specific to each database and a class name of the database, and constructs a new database object." } ; +{ $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." } ; HELP: db-open { $values { "db" db } { "db" db } } -{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple." } ; +{ $description "Opens a database using the configuration data stored in a " { $link db } " tuple. The database object now references a database handle that must be cleaned up. Therefore, it is better to use the " { $link with-db } " combinator than calling this word directly." } ; HELP: db-close { $values { "handle" alien } } -{ $description "Closes a database using the handle provided." } ; +{ $description "Closes a database using the handle provided. Use of the " { $link with-db } " combinator is preferred over manually opening and closing databases so that resources are not leaked." } ; HELP: dispose-statements { $values { "assoc" assoc } } @@ -38,30 +30,18 @@ HELP: db-dispose HELP: statement { $description "A " { $snippet "statement" } " stores the information about a statemen, such as the SQL statement text, the in/out parameters, and type information." } ; -HELP: simple-statement -{ $description } ; - -HELP: prepared-statement -{ $description } ; - HELP: result-set { $description "An object encapsulating a raw SQL result object. There are two ways in which a result set can be accessed, but they are specific to the database backend in use." { $subsection "db-random-access-result-set" } { $subsection "db-sequential-result-set" } } ; -HELP: init-result-set -{ $values - { "result-set" result-set } } -{ $description "" } ; - HELP: new-result-set { $values { "query" "a query" } { "handle" alien } { "class" class } { "result-set" result-set } } { $description "Creates a new " { $link result-set } " object of type " { $snippet "class" } "." } ; - HELP: new-statement { $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } } { $description "Makes a new statement object from the given parameters." } ; @@ -80,18 +60,6 @@ HELP: prepare-statement { $values { "statement" statement } } { $description "For databases which implement a method on this generic, it does some internal processing to ready the statement for execution." } ; -HELP: bind-statement* -{ $values { "statement" statement } } -{ $description "" } ; - -HELP: low-level-bind -{ $values { "statement" statement } } -{ $description "" } ; - -HELP: bind-tuple -{ $values { "tuple" tuple } { "statement" statement } } -{ $description "" } ; - HELP: query-results { $values { "query" object } { "result-set" result-set } @@ -125,41 +93,14 @@ HELP: more-rows? { $values { "result-set" result-set } { "?" "a boolean" } } { $description "Returns true if the " { $link result-set } " has more rows to traverse." } ; -HELP: execute-statement* -{ $values { "statement" statement } { "type" object } } -{ $description } ; - -HELP: execute-one-statement -{ $values - { "statement" null } } -{ $description "" } ; - -HELP: execute-statement -{ $values { "statement" statement } } -{ $description "" } ; - - - - HELP: begin-transaction { $description "Begins a new transaction. User code should make use of the " { $link with-transaction } " combinator." } ; -HELP: bind-statement -{ $values - { "obj" object } { "statement" null } } -{ $description "" } ; - HELP: commit-transaction { $description "Commits a transaction. User code should make use of the " { $link with-transaction } " combinator." } ; -HELP: default-query -{ $values - { "query" null } - { "result-set" null } } -{ $description "" } ; - HELP: in-transaction { $description "A variable that is set true when a transaction is in progress." } ; @@ -170,14 +111,14 @@ HELP: in-transaction? HELP: query-each { $values - { "statement" null } { "quot" quotation } } -{ $description "" } ; + { "statement" statement } { "quot" quotation } } +{ $description "A combinator that calls a quotation on a sequence of SQL statments to their results query results." } ; HELP: query-map { $values - { "statement" null } { "quot" quotation } + { "statement" statement } { "quot" quotation } { "seq" sequence } } -{ $description "" } ; +{ $description "A combinator that maps a sequence of SQL statments to their results query results." } ; HELP: rollback-transaction { $description "Rolls back a transaction; no data is committed to the database. User code should make use of the " { $link with-transaction } " combinator." } ; @@ -211,7 +152,7 @@ HELP: sql-row-typed HELP: with-db { $values - { "seq" sequence } { "class" class } { "quot" quotation } } + { "db" db } { "quot" quotation } } { $description "Calls the quotation with a database bound to the " { $link db } " symbol. The database called is based on the " { $snippet "class" } " with the " } ; HELP: with-transaction @@ -247,7 +188,7 @@ $nl { $subsection row-column-typed } ; ARTICLE: "db-sequential-result-set" "Sequential result sets" -"Sequential result sets can be iterated one element after the next. SQLite's result sets offer this method of traversal." +"Sequential result sets can be iterated one element after the next. SQLite's result sets offer this method of traversal." $nl "Databases which work in this way must provide methods for the following traversal words:" { $subsection more-rows? } @@ -272,26 +213,44 @@ $nl { $subsection row-column-typed } ; ARTICLE: "db-protocol" "Low-level database protocol" -"The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries." -; +"The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries." $nl +"Opening a database:" +{ $subsection db-open } +"Closing a database:" +{ $subsection db-close } + +"Performing a query:" +{ $subsection query-results } + +"Handling query results:" +{ $subsection "db-result-sets" } + + ; ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial" "Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." ; ARTICLE: "db-porting-the-library" "Porting the database library" -"This section is not yet written." +"There are two layers to implement when porting the database library." +{ $subsection "db-protocol" } ; ARTICLE: "db-custom-database-combinators" "Custom database combinators" -"Every database library requires some effort on the programmer's part to initialize and open a database. SQLite uses files on your harddisk, so a simple pathname is all the setup required. With PostgreSQL, you log in to a networked server as a user on a specfic port." $nl +"Every database library requires some effort on the programmer's part to initialize and open a database. SQLite uses files on your harddisk, so a simple pathname is all the setup required. With PostgreSQL, you log in to a networked server as a user on a specfic port." $nl -"Make a " { $snippet "with-" } " word to open, close, and use your database." +"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." { $code <" USING: db.sqlite db io.files ; -: with-my-database ( quot -- ) - { "my-database.db" temp-file } sqlite-db rot with-db ; -"> } +: with-sqlite-db ( quot -- ) + "my-database.db" temp-file sqlite-db rot with-db ;"> } + +{ $code <" +USING: db.postgresql db ; +: with-postgresql-db ( quot -- ) + { "localhost" "db-username" "db-password" "db-name" } + postgresql-db rot with-db ;"> +} ; diff --git a/basis/db/db.factor b/basis/db/db.factor index 87bf21d261..5b159d0ea1 100755 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs classes continuations destructors kernel math namespaces sequences classes.tuple words strings -tools.walker accessors combinators ; +tools.walker accessors combinators fry ; IN: db TUPLE: db @@ -17,10 +17,6 @@ TUPLE: db H{ } clone >>update-statements H{ } clone >>delete-statements ; inline -GENERIC: make-db* ( object db -- db ) - -: make-db ( object class -- db ) new-db make-db* ; - GENERIC: db-open ( db -- db ) HOOK: db-close db ( handle -- ) @@ -111,10 +107,9 @@ M: object execute-statement* ( statement type -- ) : query-map ( statement quot -- seq ) accumulator [ query-each ] dip { } like ; inline -: with-db ( seq class quot -- ) - [ make-db db-open db ] dip - [ db get swap [ drop ] prepose with-disposal ] curry with-variable ; - inline +: with-db ( db quot -- ) + [ db-open db ] dip + '[ db get [ drop @ ] with-disposal ] with-variable ; inline : default-query ( query -- result-set ) query-results [ [ sql-row ] query-map ] with-disposal ; diff --git a/basis/db/pools/pools.factor b/basis/db/pools/pools.factor index 63153c451e..45f37f8f7c 100644 --- a/basis/db/pools/pools.factor +++ b/basis/db/pools/pools.factor @@ -1,10 +1,10 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel arrays namespaces sequences continuations -io.pools db ; +io.pools db fry ; IN: db.pools -TUPLE: db-pool < pool db params ; +TUPLE: db-pool < pool db ; : ( params db -- pool ) db-pool @@ -15,7 +15,7 @@ TUPLE: db-pool < pool db params ; >r r> with-pool ; inline M: db-pool make-connection ( pool -- ) - [ params>> ] [ db>> ] bi make-db db-open ; + db>> db-open ; : with-pooled-db ( pool quot -- ) - [ db swap with-variable ] curry with-pooled-connection ; inline + '[ db _ with-variable ] with-pooled-connection ; inline diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 28548d1260..08df25c13a 100755 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -10,28 +10,24 @@ USE: tools.walker IN: db.postgresql TUPLE: postgresql-db < db - host port pgopts pgtty db user pass ; + host port pgopts pgtty database username password ; + +: ( -- postgresql-db ) + postgresql-db new-db ; TUPLE: postgresql-statement < statement ; TUPLE: postgresql-result-set < result-set ; -M: postgresql-db make-db* ( seq db -- db ) - >r first4 r> - swap >>db - swap >>pass - swap >>user - swap >>host ; - M: postgresql-db db-open ( db -- db ) dup { [ host>> ] [ port>> ] [ pgopts>> ] [ pgtty>> ] - [ db>> ] - [ user>> ] - [ pass>> ] + [ database>> ] + [ username>> ] + [ password>> ] } cleave connect-postgres >>handle ; M: postgresql-db dispose ( db -- ) @@ -102,7 +98,7 @@ M: postgresql-result-set dispose ( result-set -- ) M: postgresql-statement prepare-statement ( statement -- ) dup - >r db get handle>> f r> + [ db get handle>> f ] dip [ sql>> ] [ in-params>> ] bi length f PQprepare postgresql-error >>handle drop ; @@ -121,7 +117,8 @@ M: postgresql-db bind% ( spec -- ) bind-name% 1, ; M: postgresql-db bind# ( spec object -- ) - >r bind-name% f swap type>> r> 1, ; + [ bind-name% f swap type>> ] dip + 1, ; : create-table-sql ( class -- statement ) [ @@ -143,7 +140,7 @@ M: postgresql-db bind# ( spec object -- ) : create-function-sql ( class -- statement ) [ - >r remove-id r> + [ remove-id ] dip "create function add_" 0% dup 0% "(" 0% over [ "," 0% ] diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index dfd9fab08c..dfe4fdf475 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -11,8 +11,9 @@ IN: db.sqlite TUPLE: sqlite-db < db path ; -M: sqlite-db make-db* ( path db -- db ) - swap >>path ; +: ( path -- sqlite-db ) + sqlite-db new-db + swap >>path ; M: sqlite-db db-open ( db -- db ) dup path>> sqlite-open >>handle ; @@ -78,7 +79,8 @@ M: generator-bind sqlite-bind-conversion ( tuple generate-bind -- array ) tuck [ generator-singleton>> eval-generator tuck ] [ slot-name>> ] bi rot set-slot-named - >r [ key>> ] [ type>> ] bi r> swap ; + [ [ key>> ] [ type>> ] bi ] dip + swap ; M: sqlite-statement bind-tuple ( tuple statement -- ) [ @@ -100,7 +102,7 @@ M: sqlite-result-set row-column ( result-set n -- obj ) M: sqlite-result-set row-column-typed ( result-set n -- obj ) dup pick out-params>> nth type>> - >r >r handle>> r> r> sqlite-column-typed ; + [ handle>> ] 2dip sqlite-column-typed ; M: sqlite-result-set advance-row ( result-set -- ) dup handle>> sqlite-next >>has-more? drop ; @@ -160,10 +162,10 @@ M: sqlite-db ( tuple -- statement ) ; M: sqlite-db bind# ( spec obj -- ) - >r - [ column-name>> ":" swap next-sql-counter 3append dup 0% ] - [ type>> ] bi - r> 1, ; + [ + [ column-name>> ":" swap next-sql-counter 3append dup 0% ] + [ type>> ] bi + ] dip 1, ; M: sqlite-db bind% ( spec -- ) dup 1, column-name>> ":" prepend 0% ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 406d4756a2..f5569a97cd 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -7,16 +7,34 @@ db.postgresql accessors random math.bitwise math.ranges strings urls fry db.tuples.private ; IN: db.tuples.tests +: sqlite-db ( -- sqlite-db ) + "tuples-test.db" temp-file ; + : test-sqlite ( quot -- ) - [ ] swap '[ - "tuples-test.db" temp-file sqlite-db _ with-db - ] unit-test ; + '[ + [ ] [ + "tuples-test.db" temp-file _ with-db + ] unit-test + ] call ; inline + +: postgresql-db ( -- postgresql-db ) + + "localhost" >>host + "postgres" >>username + "thepasswordistrust" >>password + "factor-test" >>database ; : test-postgresql ( quot -- ) - [ ] swap '[ - { "localhost" "postgres" "foob" "factor-test" } - postgresql-db _ with-db - ] unit-test ; + '[ + [ ] [ postgresql-db _ with-db ] unit-test + ] call ; inline + +! These words leak resources, but are useful for interactivel testing +: sqlite-test-db ( -- ) + sqlite-db db-open db set ; + +: postgresql-test-db ( -- ) + postgresql-db db-open db set ; TUPLE: person the-id the-name the-number the-real ts date time blob factor-blob url ; @@ -639,10 +657,3 @@ compound-foo "COMPOUND_FOO" [ test-compound-primary-key ] test-sqlite [ test-compound-primary-key ] test-postgresql - -: sqlite-test-db ( -- ) - "tuples-test.db" temp-file sqlite-db make-db db-open db set ; - -: postgresql-test-db ( -- ) - { "localhost" "postgres" "foob" "factor-test" } postgresql-db - make-db db-open db set ; From a7027700d13fcd80816ceac22c3766981f1e5baf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 12:51:21 -0500 Subject: [PATCH 033/244] update with-db usages --- basis/db/pools/pools.factor | 9 ++++---- basis/furnace/alloy/alloy.factor | 22 +++++++++---------- .../furnace/auth/providers/db/db-tests.factor | 2 +- basis/furnace/db/db.factor | 2 +- basis/furnace/sessions/sessions-tests.factor | 4 ++-- basis/http/http-tests.factor | 2 +- extra/webapps/planet/planet.factor | 4 ++-- .../concatenative/concatenative.factor | 2 +- 8 files changed, 22 insertions(+), 25 deletions(-) diff --git a/basis/db/pools/pools.factor b/basis/db/pools/pools.factor index 45f37f8f7c..8bc5e87f0e 100644 --- a/basis/db/pools/pools.factor +++ b/basis/db/pools/pools.factor @@ -6,13 +6,12 @@ IN: db.pools TUPLE: db-pool < pool db ; -: ( params db -- pool ) +: ( db -- pool ) db-pool - swap >>db - swap >>params ; + swap >>db ; -: with-db-pool ( db params quot -- ) - >r r> with-pool ; inline +: with-db-pool ( db quot -- ) + [ ] dip with-pool ; inline M: db-pool make-connection ( pool -- ) db>> db-open ; diff --git a/basis/furnace/alloy/alloy.factor b/basis/furnace/alloy/alloy.factor index decee690a3..128ec448b7 100644 --- a/basis/furnace/alloy/alloy.factor +++ b/basis/furnace/alloy/alloy.factor @@ -17,19 +17,17 @@ IN: furnace.alloy state-classes ensure-tables user ensure-table ; -: ( responder db params -- responder' ) - [ [ init-furnace-tables ] with-db ] +: ( responder db -- responder' ) + [ [ init-furnace-tables ] with-db ] keep [ - [ - - - - ] 2dip - - - ] 2bi ; + + + + ] dip + + ; -: start-expiring ( db params -- ) +: start-expiring ( db -- ) '[ - _ _ [ state-classes [ expire-state ] each ] with-db + _ [ state-classes [ expire-state ] each ] with-db ] 5 minutes every drop ; diff --git a/basis/furnace/auth/providers/db/db-tests.factor b/basis/furnace/auth/providers/db/db-tests.factor index fac5c23e4a..3bcd82a15d 100755 --- a/basis/furnace/auth/providers/db/db-tests.factor +++ b/basis/furnace/auth/providers/db/db-tests.factor @@ -11,7 +11,7 @@ io.files accessors kernel ; [ "auth-test.db" temp-file delete-file ] ignore-errors -"auth-test.db" temp-file sqlite-db [ +"auth-test.db" temp-file [ user ensure-table diff --git a/basis/furnace/db/db.factor b/basis/furnace/db/db.factor index b4a4386015..ed18e42a4f 100755 --- a/basis/furnace/db/db.factor +++ b/basis/furnace/db/db.factor @@ -6,7 +6,7 @@ IN: furnace.db TUPLE: db-persistence < filter-responder pool ; -: ( responder params db -- responder' ) +: ( responder db -- responder' ) db-persistence boa ; M: db-persistence call-responder* diff --git a/basis/furnace/sessions/sessions-tests.factor b/basis/furnace/sessions/sessions-tests.factor index ff089a92b2..6bb3c1cd69 100755 --- a/basis/furnace/sessions/sessions-tests.factor +++ b/basis/furnace/sessions/sessions-tests.factor @@ -48,9 +48,9 @@ M: foo call-responder* [ [ ] "text/plain" exit-with ] >>display ; -[ "auth-test.db" temp-file sqlite-db delete-file ] ignore-errors +[ "auth-test.db" temp-file delete-file ] ignore-errors -"auth-test.db" temp-file sqlite-db [ +"auth-test.db" temp-file [ init-request session ensure-table diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 9a1421a3ad..eb8ba34f9e 100755 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -182,7 +182,7 @@ http.server.dispatchers db.tuples ; [ stop-server "Goodbye" "text/html" ] >>display "quit" add-responder ; -: test-db "test.db" temp-file sqlite-db ; +: test-db "test.db" temp-file ; [ test-db drop delete-file ] ignore-errors diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 00d843573c..6c097d7faa 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -195,5 +195,5 @@ posting "POSTINGS" { planet "planet-common" } >>template ; -: start-update-task ( db params -- ) - '[ _ _ [ update-cached-postings ] with-db ] 10 minutes every drop ; +: start-update-task ( db -- ) + '[ _ [ update-cached-postings ] with-db ] 10 minutes every drop ; diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 5553fda740..aa99493fa6 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -26,7 +26,7 @@ webapps.user-admin webapps.help ; IN: websites.concatenative -: test-db ( -- params db ) "resource:test.db" sqlite-db ; +: test-db ( -- params db ) "resource:test.db" ; : init-factor-db ( -- ) test-db [ From 1c189a479c62c6512b7f2b489394df3002ccc5f2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 14:02:38 -0500 Subject: [PATCH 034/244] more docs, fix typos --- basis/db/db-docs.factor | 30 +++++++++++++++++++----------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index a4a948d07f..b0a01269ab 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -112,13 +112,13 @@ HELP: in-transaction? HELP: query-each { $values { "statement" statement } { "quot" quotation } } -{ $description "A combinator that calls a quotation on a sequence of SQL statments to their results query results." } ; +{ $description "A combinator that calls a quotation on a sequence of SQL statements to their results query results." } ; HELP: query-map { $values { "statement" statement } { "quot" quotation } { "seq" sequence } } -{ $description "A combinator that maps a sequence of SQL statments to their results query results." } ; +{ $description "A combinator that maps a sequence of SQL statements to their results query results." } ; HELP: rollback-transaction { $description "Rolls back a transaction; no data is committed to the database. User code should make use of the " { $link with-transaction } " combinator." } ; @@ -218,14 +218,19 @@ ARTICLE: "db-protocol" "Low-level database protocol" { $subsection db-open } "Closing a database:" { $subsection db-close } - +"Creating tatements:" +{ $subsection } +{ $subsection } +"Using statements with the database:" +{ $subsection prepare-statement } +{ $subsection bind-statement* } +{ $subsection low-level-bind } "Performing a query:" { $subsection query-results } - "Handling query results:" { $subsection "db-result-sets" } - - ; +; +! { $subsection bind-tuple } ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial" "Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." @@ -243,13 +248,16 @@ ARTICLE: "db-custom-database-combinators" "Custom database combinators" { $code <" USING: db.sqlite db io.files ; : with-sqlite-db ( quot -- ) - "my-database.db" temp-file sqlite-db rot with-db ;"> } + "my-database.db" temp-file rot with-db ;"> } -{ $code <" -USING: db.postgresql db ; +{ $code <" USING: db.postgresql db ; : with-postgresql-db ( quot -- ) - { "localhost" "db-username" "db-password" "db-name" } - postgresql-db rot with-db ;"> + + "localhost" >>host + "erg" >>username + "secrets?" >>password + "factor-test" >>database + swap with-db ;"> } ; From 50493ba446c42cc2ea0ff193fc13a9ac50e199e4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 16:02:31 -0500 Subject: [PATCH 035/244] fix unit tests --- basis/db/db-tests.factor | 2 +- basis/db/pools/pools-tests.factor | 2 +- basis/db/postgresql/postgresql-tests.factor | 13 +++++++------ basis/db/sqlite/sqlite-tests.factor | 2 +- basis/db/tuples/tuples.factor | 3 ++- 5 files changed, 12 insertions(+), 10 deletions(-) diff --git a/basis/db/db-tests.factor b/basis/db/db-tests.factor index 3f1dab2c37..56b6c25a19 100644 --- a/basis/db/db-tests.factor +++ b/basis/db/db-tests.factor @@ -3,4 +3,4 @@ IN: db.tests { 1 0 } [ [ drop ] query-each ] must-infer-as { 1 1 } [ [ ] query-map ] must-infer-as -{ 2 0 } [ [ ] with-db ] must-infer-as +{ 1 0 } [ [ ] with-db ] must-infer-as diff --git a/basis/db/pools/pools-tests.factor b/basis/db/pools/pools-tests.factor index f07d1e8468..0ea7b1a6f4 100644 --- a/basis/db/pools/pools-tests.factor +++ b/basis/db/pools/pools-tests.factor @@ -13,7 +13,7 @@ USE: db.sqlite [ "pool-test.db" temp-file delete-file ] ignore-errors -[ ] [ "pool-test.db" temp-file sqlite-db "pool" set ] unit-test +[ ] [ "pool-test.db" temp-file "pool" set ] unit-test [ ] [ "pool" get expired>> t >>expired drop ] unit-test diff --git a/basis/db/postgresql/postgresql-tests.factor b/basis/db/postgresql/postgresql-tests.factor index 65b75a63dc..fe53e2416e 100644 --- a/basis/db/postgresql/postgresql-tests.factor +++ b/basis/db/postgresql/postgresql-tests.factor @@ -1,13 +1,14 @@ -! You will need to run 'createdb factor-test' to create the database. -! Set username and password in the 'connect' word. - USING: kernel db.postgresql alien continuations io classes prettyprint sequences namespaces tools.test db -db.tuples db.types unicode.case ; +db.tuples db.types unicode.case accessors ; IN: db.postgresql.tests : test-db ( -- postgresql-db ) - { "localhost" "postgres" "foob" "factor-test" } postgresql-db ; + + "localhost" >>host + "postgres" >>username + "thepasswordistrust" >>password + "factor-test" >>database ; [ ] [ test-db [ ] with-db ] unit-test @@ -92,4 +93,4 @@ IN: db.postgresql.tests : with-dummy-db ( quot -- ) - >r T{ postgresql-db } db r> with-variable ; + [ T{ postgresql-db } db ] dip with-variable ; diff --git a/basis/db/sqlite/sqlite-tests.factor b/basis/db/sqlite/sqlite-tests.factor index 67eac2702b..fe95980bcf 100644 --- a/basis/db/sqlite/sqlite-tests.factor +++ b/basis/db/sqlite/sqlite-tests.factor @@ -4,7 +4,7 @@ continuations db.types db.tuples unicode.case ; IN: db.sqlite.tests : db-path "test.db" temp-file ; -: test.db db-path sqlite-db ; +: test.db db-path ; [ ] [ [ db-path delete-file ] ignore-errors ] unit-test diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 7f567697d2..20d7ac4f84 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -7,7 +7,7 @@ destructors mirrors sets db.types ; IN: db.tuples From 75c2283dd6b77be1d38868966dc29d15a34cedf6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 16:36:29 -0500 Subject: [PATCH 036/244] fix stack effect --- extra/websites/concatenative/concatenative.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index aa99493fa6..d7fdfa2460 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -26,7 +26,7 @@ webapps.user-admin webapps.help ; IN: websites.concatenative -: test-db ( -- params db ) "resource:test.db" ; +: test-db ( -- db ) "resource:test.db" ; : init-factor-db ( -- ) test-db [ From aeb5d60d3ad0ae2336854d94ba394dcb32f92825 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 16:36:50 -0500 Subject: [PATCH 037/244] fix test --- basis/db/pools/pools-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/db/pools/pools-tests.factor b/basis/db/pools/pools-tests.factor index 0ea7b1a6f4..0a68db501b 100644 --- a/basis/db/pools/pools-tests.factor +++ b/basis/db/pools/pools-tests.factor @@ -4,7 +4,7 @@ accessors kernel math destructors ; \ must-infer -{ 2 0 } [ [ ] with-db-pool ] must-infer-as +{ 1 0 } [ [ ] with-db-pool ] must-infer-as { 1 0 } [ [ ] with-pooled-db ] must-infer-as From 39eacca297cd0c96320b10d5fc70522c9186d403 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 16:37:04 -0500 Subject: [PATCH 038/244] fix test, something is still broken --- basis/http/http-tests.factor | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 608ba0c88f..b3930878ff 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -182,9 +182,11 @@ http.server.dispatchers db.tuples ; [ stop-this-server "Goodbye" "text/html" ] >>display "quit" add-responder ; -: test-db "test.db" temp-file ; +: test-db-file "test.db" temp-file ; -[ test-db drop delete-file ] ignore-errors +: test-db test-db-file ; + +[ test-db-file delete-file ] ignore-errors test-db [ init-furnace-tables From 84e267a2a999507d174477230a2b1ec0aab97200 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 17:24:55 -0500 Subject: [PATCH 039/244] remove lib usage --- extra/lisp/lisp.factor | 6 +++--- extra/lisp/parser/parser.factor | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/lisp/lisp.factor b/extra/lisp/lisp.factor index 2866e63c69..e60529caab 100644 --- a/extra/lisp/lisp.factor +++ b/extra/lisp/lisp.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. -USING: kernel peg sequences arrays strings combinators.lib +USING: kernel peg sequences arrays strings namespaces combinators math locals locals.private locals.backend accessors -vectors syntax lisp.parser assocs parser sequences.lib words +vectors syntax lisp.parser assocs parser words quotations fry lists summary combinators.short-circuit continuations multiline ; IN: lisp @@ -180,4 +180,4 @@ M: no-such-var summary drop "No such variable" ; : " parse-multiline-string define-lisp-builtins - lisp-string>factor parsed \ call parsed ; parsing \ No newline at end of file + lisp-string>factor parsed \ call parsed ; parsing diff --git a/extra/lisp/parser/parser.factor b/extra/lisp/parser/parser.factor index 1b14f5bb34..72344fd0dc 100644 --- a/extra/lisp/parser/parser.factor +++ b/extra/lisp/parser/parser.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 James Cash ! See http://factorcode.org/license.txt for BSD license. USING: kernel peg peg.ebnf math.parser sequences arrays strings -combinators.lib math fry accessors lists combinators.short-circuit ; +math fry accessors lists combinators.short-circuit ; IN: lisp.parser @@ -36,4 +36,4 @@ atom = number | string s-expression = LPAREN (list-item)* RPAREN => [[ second seq>cons ]] list-item = _ ( atom | s-expression ) _ => [[ second ]] -;EBNF \ No newline at end of file +;EBNF From c0dab60dc72f075195566079d4f0262a7b4ae087 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 17:33:26 -0500 Subject: [PATCH 040/244] dont use lib --- extra/descriptive/descriptive.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index 4b40747e9f..d02983d7fd 100755 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -1,4 +1,4 @@ -USING: words kernel sequences combinators.lib locals +USING: words kernel sequences locals locals.private accessors parser namespaces continuations summary definitions generalizations arrays ; IN: descriptive From 4e81c83e642d5c0fcb423782c589485a53acc496 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 17:34:42 -0500 Subject: [PATCH 041/244] remove lib usage --- extra/parser-combinators/regexp/regexp.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/parser-combinators/regexp/regexp.factor b/extra/parser-combinators/regexp/regexp.factor index 40d4603fb6..b13321d991 100755 --- a/extra/parser-combinators/regexp/regexp.factor +++ b/extra/parser-combinators/regexp/regexp.factor @@ -1,6 +1,6 @@ USING: arrays combinators kernel lists math math.parser namespaces parser lexer parser-combinators parser-combinators.simple -promises quotations sequences combinators.lib strings math.order +promises quotations sequences strings math.order assocs prettyprint.backend memoize unicode.case unicode.categories combinators.short-circuit accessors make io ; IN: parser-combinators.regexp From d99be8bf77edb567cdd9465174dfe64f6d7f6d28 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 17:37:03 -0500 Subject: [PATCH 042/244] dont use lib --- extra/faq/faq.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/faq/faq.factor b/extra/faq/faq.factor index 1ab348e434..c0636c5fd7 100644 --- a/extra/faq/faq.factor +++ b/extra/faq/faq.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Daniel Ehrenberg ! See http://factorcode.org/license.txt for BSD license. -USING: xml kernel sequences xml.utilities combinators.lib -math xml.data arrays assocs xml.generator xml.writer namespaces +USING: xml kernel sequences xml.utilities math xml.data +arrays assocs xml.generator xml.writer namespaces make math.parser io accessors ; IN: faq From 6e7aa21cb58877a935e7a820b270c3c13fcadee8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 17:40:49 -0500 Subject: [PATCH 043/244] dont use lib --- extra/project-euler/014/014.factor | 2 +- extra/project-euler/021/021.factor | 4 ++-- extra/project-euler/032/032.factor | 2 +- extra/project-euler/036/036.factor | 2 +- extra/project-euler/043/043.factor | 4 ++-- extra/project-euler/047/047.factor | 2 +- extra/project-euler/052/052.factor | 2 +- extra/project-euler/075/075.factor | 4 ++-- 8 files changed, 11 insertions(+), 11 deletions(-) diff --git a/extra/project-euler/014/014.factor b/extra/project-euler/014/014.factor index fcbc956de8..dc0c060b22 100644 --- a/extra/project-euler/014/014.factor +++ b/extra/project-euler/014/014.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators.lib combinators.short-circuit kernel +USING: arrays combinators.short-circuit kernel math math.ranges namespaces make sequences sorting ; IN: project-euler.014 diff --git a/extra/project-euler/021/021.factor b/extra/project-euler/021/021.factor index 9ae5f6af10..af6bb3270b 100644 --- a/extra/project-euler/021/021.factor +++ b/extra/project-euler/021/021.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib combinators.short-circuit kernel math math.functions - math.ranges namespaces project-euler.common sequences sequences.lib ; +USING: combinators.short-circuit kernel math math.functions + math.ranges namespaces project-euler.common sequences ; IN: project-euler.021 ! http://projecteuler.net/index.php?section=problems&id=21 diff --git a/extra/project-euler/032/032.factor b/extra/project-euler/032/032.factor index 8a54c595a9..f9667c75fe 100755 --- a/extra/project-euler/032/032.factor +++ b/extra/project-euler/032/032.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib hashtables kernel math math.combinatorics math.functions +USING: hashtables kernel math math.combinatorics math.functions math.parser math.ranges project-euler.common sequences sets ; IN: project-euler.032 diff --git a/extra/project-euler/036/036.factor b/extra/project-euler/036/036.factor index f3a9f738bf..fc9df9a8fe 100644 --- a/extra/project-euler/036/036.factor +++ b/extra/project-euler/036/036.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib combinators.short-circuit kernel math.parser math.ranges +USING: combinators.short-circuit kernel math.parser math.ranges project-euler.common sequences ; IN: project-euler.036 diff --git a/extra/project-euler/043/043.factor b/extra/project-euler/043/043.factor index a2f4ad5c61..84ed7a830f 100644 --- a/extra/project-euler/043/043.factor +++ b/extra/project-euler/043/043.factor @@ -1,8 +1,8 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib combinators.short-circuit hashtables kernel math +USING: combinators.short-circuit hashtables kernel math math.combinatorics math.parser math.ranges project-euler.common sequences - sequences.lib sorting sets ; + sorting sets ; IN: project-euler.043 ! http://projecteuler.net/index.php?section=problems&id=43 diff --git a/extra/project-euler/047/047.factor b/extra/project-euler/047/047.factor index e59ca56f39..87a1387887 100644 --- a/extra/project-euler/047/047.factor +++ b/extra/project-euler/047/047.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators.lib kernel math math.primes math.primes.factors +USING: arrays kernel math math.primes math.primes.factors math.ranges namespaces sequences ; IN: project-euler.047 diff --git a/extra/project-euler/052/052.factor b/extra/project-euler/052/052.factor index aec8015f94..3f562baa85 100644 --- a/extra/project-euler/052/052.factor +++ b/extra/project-euler/052/052.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: combinators.lib combinators.short-circuit kernel math +USING: combinators.short-circuit kernel math project-euler.common sequences sorting ; IN: project-euler.052 diff --git a/extra/project-euler/075/075.factor b/extra/project-euler/075/075.factor index 8e5b849de5..76f2a2a26e 100755 --- a/extra/project-euler/075/075.factor +++ b/extra/project-euler/075/075.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators.lib kernel math math.ranges - namespaces project-euler.common sequences sequences.lib ; +USING: arrays kernel math math.ranges + namespaces project-euler.common sequences ; IN: project-euler.075 ! http://projecteuler.net/index.php?section=problems&id=75 From 86cdfa3a4c81086b2e19771cfe5a126e8bf85f55 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 17:49:04 -0500 Subject: [PATCH 044/244] remove lib usage, fix compile errors --- extra/project-euler/017/017.factor | 2 +- extra/project-euler/019/019.factor | 4 ++-- extra/project-euler/022/022.factor | 2 +- extra/project-euler/030/030.factor | 2 +- extra/project-euler/034/034.factor | 2 +- extra/project-euler/035/035.factor | 2 +- extra/project-euler/039/039.factor | 2 +- extra/project-euler/042/042.factor | 2 +- extra/project-euler/055/055.factor | 6 +++--- extra/project-euler/059/059.factor | 2 +- extra/project-euler/116/116.factor | 2 +- extra/project-euler/148/148.factor | 2 +- extra/project-euler/151/151.factor | 3 +-- extra/project-euler/186/186.factor | 2 +- extra/project-euler/190/190.factor | 2 +- 15 files changed, 18 insertions(+), 19 deletions(-) diff --git a/extra/project-euler/017/017.factor b/extra/project-euler/017/017.factor index cf58e88ffe..5f6541873a 100644 --- a/extra/project-euler/017/017.factor +++ b/extra/project-euler/017/017.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math.ranges math.text.english sequences sequences.lib strings +USING: kernel math.ranges math.text.english sequences strings ascii combinators.short-circuit ; IN: project-euler.017 diff --git a/extra/project-euler/019/019.factor b/extra/project-euler/019/019.factor index b29495f913..9482b337bb 100644 --- a/extra/project-euler/019/019.factor +++ b/extra/project-euler/019/019.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Samuel Tardieu, Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: calendar combinators kernel math math.ranges namespaces sequences - sequences.lib math.order ; + math.order ; IN: project-euler.019 ! http://projecteuler.net/index.php?section=problems&id=19 @@ -32,7 +32,7 @@ IN: project-euler.019 : euler019 ( -- answer ) 1901 2000 [a,b] [ - 12 [1,b] [ 1 zeller-congruence ] map-with + 12 [1,b] [ 1 zeller-congruence ] with map ] map concat [ zero? ] count ; ! [ euler019 ] 100 ave-time diff --git a/extra/project-euler/022/022.factor b/extra/project-euler/022/022.factor index 82054ce014..a508ddea6c 100644 --- a/extra/project-euler/022/022.factor +++ b/extra/project-euler/022/022.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: ascii io.encodings.ascii io.files kernel math project-euler.common - sequences sequences.lib sorting splitting ; + sequences sorting splitting ; IN: project-euler.022 ! http://projecteuler.net/index.php?section=problems&id=22 diff --git a/extra/project-euler/030/030.factor b/extra/project-euler/030/030.factor index 53d6b199fb..250494c0dc 100644 --- a/extra/project-euler/030/030.factor +++ b/extra/project-euler/030/030.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.functions project-euler.common sequences sequences.lib ; +USING: kernel math math.functions project-euler.common sequences ; IN: project-euler.030 ! http://projecteuler.net/index.php?section=problems&id=30 diff --git a/extra/project-euler/034/034.factor b/extra/project-euler/034/034.factor index cf73ee828b..28c4fa5dc7 100644 --- a/extra/project-euler/034/034.factor +++ b/extra/project-euler/034/034.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math.ranges project-euler.common sequences sequences.lib ; +USING: kernel math.ranges project-euler.common sequences ; IN: project-euler.034 ! http://projecteuler.net/index.php?section=problems&id=34 diff --git a/extra/project-euler/035/035.factor b/extra/project-euler/035/035.factor index cec9bc6957..8e8b654d28 100755 --- a/extra/project-euler/035/035.factor +++ b/extra/project-euler/035/035.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.combinatorics math.parser math.primes - project-euler.common sequences sequences.lib sets ; + project-euler.common sequences sets ; IN: project-euler.035 ! http://projecteuler.net/index.php?section=problems&id=35 diff --git a/extra/project-euler/039/039.factor b/extra/project-euler/039/039.factor index 7a9f51f1d3..d0caa6d0e4 100755 --- a/extra/project-euler/039/039.factor +++ b/extra/project-euler/039/039.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators.lib kernel math math.ranges +USING: arrays kernel math math.ranges namespaces project-euler.common sequences ; IN: project-euler.039 diff --git a/extra/project-euler/042/042.factor b/extra/project-euler/042/042.factor index da26e34927..8ae95d6db7 100644 --- a/extra/project-euler/042/042.factor +++ b/extra/project-euler/042/042.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: ascii io.files kernel math math.functions namespaces make - project-euler.common sequences sequences.lib splitting io.encodings.ascii ; + project-euler.common sequences splitting io.encodings.ascii ; IN: project-euler.042 ! http://projecteuler.net/index.php?section=problems&id=42 diff --git a/extra/project-euler/055/055.factor b/extra/project-euler/055/055.factor index 289f3a002a..bf1dd43b97 100644 --- a/extra/project-euler/055/055.factor +++ b/extra/project-euler/055/055.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.parser project-euler.common sequences sequences.lib ; +USING: kernel math math.parser project-euler.common sequences ; IN: project-euler.055 ! http://projecteuler.net/index.php?section=problems&id=55 @@ -49,8 +49,8 @@ IN: project-euler.055 : (lychrel?) ( n iteration -- ? ) dup 50 < [ - >r add-reverse dup palindrome? - [ r> 2drop f ] [ r> 1+ (lychrel?) ] if + [ add-reverse ] dip over palindrome? + [ 2drop f ] [ 1+ (lychrel?) ] if ] [ 2drop t ] if ; diff --git a/extra/project-euler/059/059.factor b/extra/project-euler/059/059.factor index f209b50a46..e3ab9762d8 100644 --- a/extra/project-euler/059/059.factor +++ b/extra/project-euler/059/059.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Aaron Schaefer, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays ascii assocs hashtables io.encodings.ascii io.files kernel math - math.parser namespaces make sequences sequences.lib sequences.private sorting + math.parser namespaces make sequences sequences.private sorting splitting grouping strings sets accessors ; IN: project-euler.059 diff --git a/extra/project-euler/116/116.factor b/extra/project-euler/116/116.factor index 5e2059ad9a..0e3633dc9a 100644 --- a/extra/project-euler/116/116.factor +++ b/extra/project-euler/116/116.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.ranges sequences sequences.lib ; +USING: kernel math math.ranges sequences ; IN: project-euler.116 ! http://projecteuler.net/index.php?section=problems&id=116 diff --git a/extra/project-euler/148/148.factor b/extra/project-euler/148/148.factor index 49fd9a4895..0509936e52 100644 --- a/extra/project-euler/148/148.factor +++ b/extra/project-euler/148/148.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.functions sequences sequences.lib ; +USING: kernel math math.functions sequences ; IN: project-euler.148 ! http://projecteuler.net/index.php?section=problems&id=148 diff --git a/extra/project-euler/151/151.factor b/extra/project-euler/151/151.factor index b64ae3d49f..7913cf9540 100644 --- a/extra/project-euler/151/151.factor +++ b/extra/project-euler/151/151.factor @@ -1,7 +1,6 @@ ! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs combinators kernel math math.order namespaces sequences - sequences.lib ; +USING: assocs combinators kernel math math.order namespaces sequences ; IN: project-euler.151 ! http://projecteuler.net/index.php?section=problems&id=151 diff --git a/extra/project-euler/186/186.factor b/extra/project-euler/186/186.factor index 5308662daf..7504e09a81 100644 --- a/extra/project-euler/186/186.factor +++ b/extra/project-euler/186/186.factor @@ -1,5 +1,5 @@ USING: circular disjoint-sets kernel math math.ranges - sequences sequences.lib ; +sequences ; IN: project-euler.186 : (generator) ( k -- n ) diff --git a/extra/project-euler/190/190.factor b/extra/project-euler/190/190.factor index 35b9344362..c0b7cb577f 100644 --- a/extra/project-euler/190/190.factor +++ b/extra/project-euler/190/190.factor @@ -1,6 +1,6 @@ ! Copyright (c) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences sequences.lib math math.functions math.ranges locals ; +USING: kernel sequences math math.functions math.ranges locals ; IN: project-euler.190 ! http://projecteuler.net/index.php?section=problems&id=190 From b8f8d1f159d0d6490182f11afb96d73f2f5f1354 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 17:51:08 -0500 Subject: [PATCH 045/244] dont use lib --- extra/money/money.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/money/money.factor b/extra/money/money.factor index 76bc2bae18..5fa76d5f53 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -1,6 +1,6 @@ USING: io kernel math math.functions math.parser parser lexer namespaces make sequences splitting grouping combinators -continuations sequences.lib ; +continuations ; IN: money : dollars/cents ( dollars -- dollars cents ) From 3ee55eb341936cc78e0e9d41b28a7925b88931af Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 18:08:21 -0500 Subject: [PATCH 046/244] remove lib usage, update docs --- extra/hexdump/hexdump-docs.factor | 14 ++++++++++++-- extra/hexdump/hexdump.factor | 12 ++++++++---- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/extra/hexdump/hexdump-docs.factor b/extra/hexdump/hexdump-docs.factor index adf31d3787..a83f64e8db 100644 --- a/extra/hexdump/hexdump-docs.factor +++ b/extra/hexdump/hexdump-docs.factor @@ -1,12 +1,22 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax kernel ; IN: hexdump HELP: hexdump. -{ $values { "seq" "a sequence" } } +{ $values { "sequence" "a sequence" } } { $description "Converts a sequence to its hexadecimal and ASCII representation sixteen characters at a time and writes it to standard out." } ; HELP: hexdump -{ $values { "seq" "a sequence" } { "str" "a string" } } +{ $values { "sequence" "a sequence" } { "string" "a string" } } { $description "Converts a sequence to its hexadecimal and ASCII representation sixteen characters at a time. Lines are separated by a newline character." } { $see-also hexdump. } ; +ARTICLE: "hexdump" "Hexdump" +"The " { $vocab-link "hexdump" } " vocabulary provides a traditional hexdump view of a sequence." $nl +"Write hexdump to string:" +{ $subsection hexdump } +"Write the hexdump to the output stream:" +{ $subsection hexdump. } ; + +ABOUT: "hexdump" diff --git a/extra/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor index f444f5a4f2..618ed00802 100644 --- a/extra/hexdump/hexdump.factor +++ b/extra/hexdump/hexdump.factor @@ -1,5 +1,8 @@ -USING: arrays io io.streams.string kernel math math.parser namespaces -prettyprint sequences sequences.lib splitting grouping strings ascii ; +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays io io.streams.string kernel math math.parser +namespaces prettyprint sequences splitting grouping strings +ascii ; IN: hexdump -: hexdump ( seq -- str ) + +: hexdump ( sequence -- string ) [ dup length header. 16 [ line. ] each-index ] with-string-writer ; -: hexdump. ( seq -- ) +: hexdump. ( sequence -- ) hexdump write ; From 17c8846e9f8e89986b5e4f2ec3354f695128dc63 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 18:11:03 -0500 Subject: [PATCH 047/244] move hexdump to basis --- {extra => basis}/hexdump/authors.txt | 0 {extra => basis}/hexdump/hexdump-docs.factor | 0 {extra => basis}/hexdump/hexdump-tests.factor | 0 {extra => basis}/hexdump/hexdump.factor | 0 {extra => basis}/hexdump/summary.txt | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {extra => basis}/hexdump/authors.txt (100%) rename {extra => basis}/hexdump/hexdump-docs.factor (100%) rename {extra => basis}/hexdump/hexdump-tests.factor (100%) rename {extra => basis}/hexdump/hexdump.factor (100%) rename {extra => basis}/hexdump/summary.txt (100%) diff --git a/extra/hexdump/authors.txt b/basis/hexdump/authors.txt similarity index 100% rename from extra/hexdump/authors.txt rename to basis/hexdump/authors.txt diff --git a/extra/hexdump/hexdump-docs.factor b/basis/hexdump/hexdump-docs.factor similarity index 100% rename from extra/hexdump/hexdump-docs.factor rename to basis/hexdump/hexdump-docs.factor diff --git a/extra/hexdump/hexdump-tests.factor b/basis/hexdump/hexdump-tests.factor similarity index 100% rename from extra/hexdump/hexdump-tests.factor rename to basis/hexdump/hexdump-tests.factor diff --git a/extra/hexdump/hexdump.factor b/basis/hexdump/hexdump.factor similarity index 100% rename from extra/hexdump/hexdump.factor rename to basis/hexdump/hexdump.factor diff --git a/extra/hexdump/summary.txt b/basis/hexdump/summary.txt similarity index 100% rename from extra/hexdump/summary.txt rename to basis/hexdump/summary.txt From f9661a469931dc2834ffedb331fa560e0dfe8ef0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 18:26:56 -0500 Subject: [PATCH 048/244] fix io.paths --- extra/io/paths/paths.factor | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index fb4f6d3a6d..58b3518edd 100755 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -1,14 +1,16 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: io.files kernel sequences accessors -dlists deques arrays sequences.lib ; +dlists deques arrays ; IN: io.paths TUPLE: directory-iterator path bfs queue ; : qualified-directory ( path -- seq ) - dup directory [ first2 >r append-path r> 2array ] with map ; + dup directory [ first2 [ append-path ] dip 2array ] with map ; : push-directory ( path iter -- ) - >r qualified-directory r> [ + [ qualified-directory ] dip [ dup queue>> swap bfs>> [ push-front ] [ push-back ] if ] curry each ; @@ -24,27 +26,24 @@ TUPLE: directory-iterator path bfs queue ; ] if ; : iterate-directory ( iter quot -- obj ) - 2dup >r >r >r next-file dup [ - r> call dup [ - r> r> 2drop - ] [ - drop r> r> iterate-directory - ] if + over next-file [ + over call + [ 2drop ] [ iterate-directory ] if ] [ - drop r> r> r> 3drop f - ] if ; inline + 2drop f + ] if* ; inline recursive : find-file ( path bfs? quot -- path/f ) - >r r> + [ ] dip [ keep and ] curry iterate-directory ; inline : each-file ( path bfs? quot -- ) - >r r> + [ ] dip [ f ] compose iterate-directory drop ; inline : find-all-files ( path bfs? quot -- paths ) - >r r> - pusher >r [ f ] compose iterate-directory drop r> ; inline + [ ] dip + pusher [ [ f ] compose iterate-directory drop ] dip ; inline : recursive-directory ( path bfs? -- paths ) - [ ] accumulator >r each-file r> ; + [ ] accumulator [ each-file ] dip ; From 426ec8a08b7166dcaedde8b3f0fc7bf58d8fe6d6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 18:34:42 -0500 Subject: [PATCH 049/244] remove dead file --- extra/crypto/random.factor | 40 -------------------------------------- 1 file changed, 40 deletions(-) delete mode 100755 extra/crypto/random.factor diff --git a/extra/crypto/random.factor b/extra/crypto/random.factor deleted file mode 100755 index f2d3b0555a..0000000000 --- a/extra/crypto/random.factor +++ /dev/null @@ -1,40 +0,0 @@ -USING: kernel math math-contrib sequences namespaces errors -hashtables words arrays parser compiler syntax io ; -IN: crypto -: make-bits ( quot numbits -- n | quot: -- 0/1 ) - 0 -rot [ drop dup call rot 1 shift bitor swap ] each drop ; - -: random-bytes ( m -- n ) - >r [ 2 random ] r> 8 * make-bits ; - -! DEFER: random-bits -: add-bit ( bit integer -- integer ) 1 shift bitor ; -: append-bits ( inta intb nbits -- int ) swapd shift bitor ; -: large-random-bits ( n -- int ) - #! random number with high bit and low bit enabled (odd) - 2 swap ^ [ random ] keep -1 shift 1 bitor bitor ; -! : next-double ( -- f ) 53 random-bits 9007199254740992 /f ; - -: 0count ( integer -- n ) 0 swap [ 0 = [ 1+ ] when ] each-bit ; -: 1count ( integer -- n ) 0 swap [ 1 = [ 1+ ] when ] each-bit ; - -: bit-reverse-table -{ - HEX: 00 HEX: 80 HEX: 40 HEX: C0 HEX: 20 HEX: A0 HEX: 60 HEX: E0 HEX: 10 HEX: 90 HEX: 50 HEX: D0 HEX: 30 HEX: B0 HEX: 70 HEX: F0 - HEX: 08 HEX: 88 HEX: 48 HEX: C8 HEX: 28 HEX: A8 HEX: 68 HEX: E8 HEX: 18 HEX: 98 HEX: 58 HEX: D8 HEX: 38 HEX: B8 HEX: 78 HEX: F8 - HEX: 04 HEX: 84 HEX: 44 HEX: C4 HEX: 24 HEX: A4 HEX: 64 HEX: E4 HEX: 14 HEX: 94 HEX: 54 HEX: D4 HEX: 34 HEX: B4 HEX: 74 HEX: F4 - HEX: 0C HEX: 8C HEX: 4C HEX: CC HEX: 2C HEX: AC HEX: 6C HEX: EC HEX: 1C HEX: 9C HEX: 5C HEX: DC HEX: 3C HEX: BC HEX: 7C HEX: FC - HEX: 02 HEX: 82 HEX: 42 HEX: C2 HEX: 22 HEX: A2 HEX: 62 HEX: E2 HEX: 12 HEX: 92 HEX: 52 HEX: D2 HEX: 32 HEX: B2 HEX: 72 HEX: F2 - HEX: 0A HEX: 8A HEX: 4A HEX: CA HEX: 2A HEX: AA HEX: 6A HEX: EA HEX: 1A HEX: 9A HEX: 5A HEX: DA HEX: 3A HEX: BA HEX: 7A HEX: FA - HEX: 06 HEX: 86 HEX: 46 HEX: C6 HEX: 26 HEX: A6 HEX: 66 HEX: E6 HEX: 16 HEX: 96 HEX: 56 HEX: D6 HEX: 36 HEX: B6 HEX: 76 HEX: F6 - HEX: 0E HEX: 8E HEX: 4E HEX: CE HEX: 2E HEX: AE HEX: 6E HEX: EE HEX: 1E HEX: 9E HEX: 5E HEX: DE HEX: 3E HEX: BE HEX: 7E HEX: FE - HEX: 01 HEX: 81 HEX: 41 HEX: C1 HEX: 21 HEX: A1 HEX: 61 HEX: E1 HEX: 11 HEX: 91 HEX: 51 HEX: D1 HEX: 31 HEX: B1 HEX: 71 HEX: F1 - HEX: 09 HEX: 89 HEX: 49 HEX: C9 HEX: 29 HEX: A9 HEX: 69 HEX: E9 HEX: 19 HEX: 99 HEX: 59 HEX: D9 HEX: 39 HEX: B9 HEX: 79 HEX: F9 - HEX: 05 HEX: 85 HEX: 45 HEX: C5 HEX: 25 HEX: A5 HEX: 65 HEX: E5 HEX: 15 HEX: 95 HEX: 55 HEX: D5 HEX: 35 HEX: B5 HEX: 75 HEX: F5 - HEX: 0D HEX: 8D HEX: 4D HEX: CD HEX: 2D HEX: AD HEX: 6D HEX: ED HEX: 1D HEX: 9D HEX: 5D HEX: DD HEX: 3D HEX: BD HEX: 7D HEX: FD - HEX: 03 HEX: 83 HEX: 43 HEX: C3 HEX: 23 HEX: A3 HEX: 63 HEX: E3 HEX: 13 HEX: 93 HEX: 53 HEX: D3 HEX: 33 HEX: B3 HEX: 73 HEX: F3 - HEX: 0B HEX: 8B HEX: 4B HEX: CB HEX: 2B HEX: AB HEX: 6B HEX: EB HEX: 1B HEX: 9B HEX: 5B HEX: DB HEX: 3B HEX: BB HEX: 7B HEX: FB - HEX: 07 HEX: 87 HEX: 47 HEX: C7 HEX: 27 HEX: A7 HEX: 67 HEX: E7 HEX: 17 HEX: 97 HEX: 57 HEX: D7 HEX: 37 HEX: B7 HEX: 77 HEX: F7 - HEX: 0F HEX: 8F HEX: 4F HEX: CF HEX: 2F HEX: AF HEX: 6F HEX: EF HEX: 1F HEX: 9F HEX: 5F HEX: DF HEX: 3F HEX: BF HEX: 7F HEX: FF -} ; inline - From b35db385d345ff0448b38a3d2c61fdb78528bed0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 18:45:51 -0500 Subject: [PATCH 050/244] fix up extra/crypto --- extra/crypto/barrett/barrett-tests.factor | 3 +++ extra/crypto/barrett/barrett.factor | 10 ++++------ extra/crypto/common/authors.txt | 1 - extra/crypto/common/common.factor | 17 ----------------- extra/crypto/hmac/hmac.factor | 2 +- extra/crypto/rsa/rsa-tests.factor | 1 + extra/crypto/rsa/rsa.factor | 2 ++ extra/crypto/summary.txt | 2 +- extra/crypto/xor/xor-tests.factor | 19 ++++++++++--------- extra/crypto/xor/xor.factor | 14 +++++++++----- 10 files changed, 31 insertions(+), 40 deletions(-) delete mode 100755 extra/crypto/common/authors.txt delete mode 100644 extra/crypto/common/common.factor diff --git a/extra/crypto/barrett/barrett-tests.factor b/extra/crypto/barrett/barrett-tests.factor index be52240372..01163f730f 100644 --- a/extra/crypto/barrett/barrett-tests.factor +++ b/extra/crypto/barrett/barrett-tests.factor @@ -1,4 +1,7 @@ +! Copyright (C) 2008 DoDoug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: crypto.barrett kernel math namespaces tools.test ; +IN: crypto.barrett.tests [ HEX: 1f63edfb7e838622c7412eafaf0439cf0cdf3aae8bdd09e2de69b509a53883a83560d5ce50ea039e4 ] [ HEX: 827c67f31b2b46afa49ed95d7f7a3011e5875f7052d4c55437ce726d3c6ce0dc9c445fda63b6dc4e 16 barrett-mu ] unit-test diff --git a/extra/crypto/barrett/barrett.factor b/extra/crypto/barrett/barrett.factor index 4a070190e3..25e67d01ce 100644 --- a/extra/crypto/barrett/barrett.factor +++ b/extra/crypto/barrett/barrett.factor @@ -1,14 +1,12 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.functions ; IN: crypto.barrett : barrett-mu ( n size -- mu ) #! Calculates Barrett's reduction parameter mu #! size = word size in bits (8, 16, 32, 64, ...) - ! over log2 1+ over / 2 * >r 2 swap ^ r> ^ swap / floor ; - [ - [ log2 1+ ] [ / 2 * ] bi* - ] [ - 2^ rot ^ swap /i - ] 2bi ; + [ [ log2 1+ ] [ / 2 * ] bi* ] + [ 2^ rot ^ swap /i ] 2bi ; diff --git a/extra/crypto/common/authors.txt b/extra/crypto/common/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/extra/crypto/common/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/crypto/common/common.factor b/extra/crypto/common/common.factor deleted file mode 100644 index 61cc11f959..0000000000 --- a/extra/crypto/common/common.factor +++ /dev/null @@ -1,17 +0,0 @@ -USING: arrays kernel io io.binary sbufs splitting grouping -strings sequences namespaces math math.parser parser -hints math.bitwise assocs ; -IN: crypto.common - -: (nth-int) ( string n -- int ) - 2 shift dup 4 + rot ; inline - -: nth-int ( string n -- int ) (nth-int) le> ; inline - -: update ( num var -- ) [ w+ ] change ; inline - -SYMBOL: big-endian? - -: mod-nth ( n seq -- elt ) - #! 5 "abcd" -> b - [ length mod ] [ nth ] bi ; diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor index 6e30f19775..d98e8a9798 100755 --- a/extra/crypto/hmac/hmac.factor +++ b/extra/crypto/hmac/hmac.factor @@ -1,4 +1,4 @@ -USING: arrays combinators crypto.common checksums checksums.md5 +USING: arrays combinators checksums checksums.md5 checksums.sha1 checksums.md5.private io io.binary io.files io.streams.byte-array kernel math math.vectors memoize sequences io.encodings.binary ; diff --git a/extra/crypto/rsa/rsa-tests.factor b/extra/crypto/rsa/rsa-tests.factor index 7de6bed76f..03aca0578b 100644 --- a/extra/crypto/rsa/rsa-tests.factor +++ b/extra/crypto/rsa/rsa-tests.factor @@ -1,4 +1,5 @@ USING: kernel math namespaces crypto.rsa tools.test ; +IN: crypto.rsa.tests [ 123456789 ] [ 128 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test [ 123456789 ] [ 129 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index 5d3228db10..b1eb907547 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: math.miller-rabin kernel math math.functions namespaces sequences accessors ; IN: crypto.rsa diff --git a/extra/crypto/summary.txt b/extra/crypto/summary.txt index edd7c44333..0421c07ca0 100644 --- a/extra/crypto/summary.txt +++ b/extra/crypto/summary.txt @@ -1 +1 @@ -Cryptographic algorithms implemented in Factor, such as MD5 and SHA1 +HMAC, XOR, Barrett, RSA, Timing diff --git a/extra/crypto/xor/xor-tests.factor b/extra/crypto/xor/xor-tests.factor index ef781b9f25..f3a13e086f 100644 --- a/extra/crypto/xor/xor-tests.factor +++ b/extra/crypto/xor/xor-tests.factor @@ -2,23 +2,24 @@ USING: continuations crypto.xor kernel strings tools.test ; IN: crypto.xor.tests ! No key -[ "" dup xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with -[ { } dup xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with -[ V{ } dup xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with -[ "" "asdf" dupd xor-crypt xor-crypt ] [ T{ no-xor-key f } = ] must-fail-with +[ "" dup xor-crypt ] [ T{ empty-xor-key } = ] must-fail-with +[ { } dup xor-crypt ] [ T{ empty-xor-key } = ] must-fail-with +[ V{ } dup xor-crypt ] [ T{ empty-xor-key } = ] must-fail-with +[ "" "asdf" dupd xor-crypt xor-crypt ] [ T{ empty-xor-key } = ] must-fail-with ! a xor a = 0 [ "\0\0\0\0\0\0\0" ] [ "abcdefg" dup xor-crypt ] unit-test [ { 15 15 15 15 } ] [ { 10 10 10 10 } { 5 5 5 5 } xor-crypt ] unit-test -[ "asdf" ] [ "key" "asdf" dupd xor-crypt xor-crypt >string ] unit-test -[ "" ] [ "key" "" xor-crypt >string ] unit-test +[ "asdf" ] [ "asdf" "key" [ xor-crypt ] [ xor-crypt ] bi >string ] unit-test +[ "" ] [ "" "key" xor-crypt >string ] unit-test [ "a longer message...!" ] [ - "." - "a longer message...!" dupd xor-crypt xor-crypt >string + "a longer message...!" + "." [ xor-crypt ] [ xor-crypt ] bi >string ] unit-test [ "a longer message...!" ] [ + "a longer message...!" "a very long key, longer than the message even." - "a longer message...!" dupd xor-crypt xor-crypt >string + [ xor-crypt ] [ xor-crypt ] bi >string ] unit-test diff --git a/extra/crypto/xor/xor.factor b/extra/crypto/xor/xor.factor index 247387ebdf..6e3a605f5c 100644 --- a/extra/crypto/xor/xor.factor +++ b/extra/crypto/xor/xor.factor @@ -1,8 +1,12 @@ -USING: crypto.common kernel math sequences ; +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel math sequences fry ; IN: crypto.xor -ERROR: no-xor-key ; +: mod-nth ( n seq -- elt ) [ length mod ] [ nth ] bi ; -: xor-crypt ( key seq -- seq' ) - over empty? [ no-xor-key ] when - dup length rot [ mod-nth bitxor ] curry 2map ; +ERROR: empty-xor-key ; + +: xor-crypt ( seq key -- seq' ) + dup empty? [ empty-xor-key ] when + [ dup length ] dip '[ _ mod-nth bitxor ] 2map ; From 4c8ff1e2897a6409525b5c21994454110aab856c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 19:03:57 -0500 Subject: [PATCH 051/244] fix taxes --- extra/taxes/usa/federal/federal.factor | 12 ++++++++++++ extra/taxes/usa/fica/fica.factor | 2 +- extra/taxes/usa/usa-tests.factor | 4 ++-- extra/taxes/usa/usa.factor | 13 ++----------- 4 files changed, 17 insertions(+), 14 deletions(-) diff --git a/extra/taxes/usa/federal/federal.factor b/extra/taxes/usa/federal/federal.factor index 5274535f81..b71b831ca6 100644 --- a/extra/taxes/usa/federal/federal.factor +++ b/extra/taxes/usa/federal/federal.factor @@ -45,3 +45,15 @@ M: federal withholding* ( salary w4 tax-table entity -- x ) [ federal-tax ] 3keep drop [ fica-tax ] 2keep medicare-tax + + ; + +: total-withholding ( salary w4 tax-table -- x ) + dup entity>> dup federal = [ + withholding* + ] [ + drop + [ drop federal withholding* ] + [ dup entity>> withholding* ] 3bi + + ] if ; + +: net ( salary w4 collector -- x ) + >r dupd r> total-withholding - ; diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor index e71b2723a3..c1e85b75b4 100644 --- a/extra/taxes/usa/fica/fica.factor +++ b/extra/taxes/usa/fica/fica.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors math math.order money ; +USING: accessors assocs.lib math math.order money ; IN: taxes.usa.fica : fica-tax-rate ( -- x ) DECIMAL: .062 ; inline diff --git a/extra/taxes/usa/usa-tests.factor b/extra/taxes/usa/usa-tests.factor index 6aac4b928c..a529762c81 100644 --- a/extra/taxes/usa/usa-tests.factor +++ b/extra/taxes/usa/usa-tests.factor @@ -110,9 +110,9 @@ IN: taxes.usa.tests [ 138 69 ] [ - 24000 2008 2 f withholding biweekly dollars/cents + 24000 2008 2 f total-withholding biweekly dollars/cents ] unit-test [ 754 72 ] [ - 78250 2008 2 f withholding biweekly dollars/cents + 78250 2008 2 f total-withholding biweekly dollars/cents ] unit-test diff --git a/extra/taxes/usa/usa.factor b/extra/taxes/usa/usa.factor index 1d21524b45..27ff4aef98 100644 --- a/extra/taxes/usa/usa.factor +++ b/extra/taxes/usa/usa.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs kernel math math.intervals -namespaces sequences money math.order taxes.usa.w4 -taxes.usa.federal ; +namespaces sequences money math.order taxes.usa.w4 ; IN: taxes.usa ! Withhold: FICA, Medicare, Federal (FICA is social security) @@ -17,12 +16,7 @@ GENERIC: withholding* ( salary w4 tax-table entity -- x ) dup entity>> adjust-allowances* ; : withholding ( salary w4 tax-table -- x ) - dup entity>> federal = [ - dup entity>> withholding* - ] [ - [ dup entity>> withholding* ] - [ drop federal withholding* ] 3bi + - ] if ; + dup entity>> withholding* ; : tax-bracket-range ( pair -- n ) first2 swap - ; @@ -36,6 +30,3 @@ GENERIC: withholding* ( salary w4 tax-table entity -- x ) : marriage-table ( w4 tax-table -- triples ) swap married?>> [ married>> ] [ single>> ] if ; - -: net ( salary w4 collector -- x ) - >r dupd r> withholding - ; From ec31e23ca7e8b86a42a8527fc8a3f5bb23564603 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 2 Oct 2008 19:35:03 -0500 Subject: [PATCH 052/244] trivial lint changes --- unmaintained/lint/lint.factor | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/unmaintained/lint/lint.factor b/unmaintained/lint/lint.factor index 644346d29e..ab1a67a83e 100644 --- a/unmaintained/lint/lint.factor +++ b/unmaintained/lint/lint.factor @@ -3,14 +3,15 @@ USING: accessors alien alien.accessors arrays assocs combinators.lib io kernel macros math namespaces prettyprint quotations sequences vectors vocabs words html.elements sets -slots.private combinators.short-circuit ; +slots.private combinators.short-circuit math.order hashtables +sequences.deep ; IN: lint SYMBOL: def-hash SYMBOL: def-hash-keys : set-hash-vector ( val key hash -- ) - 2dup at -rot >r >r ?push r> r> set-at ; + 2dup at -rot [ ?push ] 2dip set-at ; : add-word-def ( word quot -- ) dup callable? [ @@ -67,7 +68,7 @@ def-hash get-global [ ! Remove constants [ 1 ] [ - drop dup length 1 = swap first number? and not + drop { [ length 1 = ] [ first number? ] } 1&& not ] assoc-filter ! Remove set-alien-cell, etc. @@ -80,6 +81,13 @@ def-hash get-global [ drop trivial-defs member? not ] assoc-filter +[ + drop { + [ [ wrapper? ] deep-contains? ] + [ [ hashtable? ] deep-contains? ] + } 1|| not +] assoc-filter + ! Remove n m shift defs [ drop dup length 3 = [ From 743ec65b4fe1729fd39ab409ef7a4d105d3b3c79 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 3 Oct 2008 01:12:09 -0500 Subject: [PATCH 053/244] Move hexdump back to extra --- {basis => extra}/hexdump/authors.txt | 0 {basis => extra}/hexdump/hexdump-docs.factor | 0 {basis => extra}/hexdump/hexdump-tests.factor | 0 {basis => extra}/hexdump/hexdump.factor | 0 {basis => extra}/hexdump/summary.txt | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {basis => extra}/hexdump/authors.txt (100%) rename {basis => extra}/hexdump/hexdump-docs.factor (100%) rename {basis => extra}/hexdump/hexdump-tests.factor (100%) rename {basis => extra}/hexdump/hexdump.factor (100%) rename {basis => extra}/hexdump/summary.txt (100%) diff --git a/basis/hexdump/authors.txt b/extra/hexdump/authors.txt similarity index 100% rename from basis/hexdump/authors.txt rename to extra/hexdump/authors.txt diff --git a/basis/hexdump/hexdump-docs.factor b/extra/hexdump/hexdump-docs.factor similarity index 100% rename from basis/hexdump/hexdump-docs.factor rename to extra/hexdump/hexdump-docs.factor diff --git a/basis/hexdump/hexdump-tests.factor b/extra/hexdump/hexdump-tests.factor similarity index 100% rename from basis/hexdump/hexdump-tests.factor rename to extra/hexdump/hexdump-tests.factor diff --git a/basis/hexdump/hexdump.factor b/extra/hexdump/hexdump.factor similarity index 100% rename from basis/hexdump/hexdump.factor rename to extra/hexdump/hexdump.factor diff --git a/basis/hexdump/summary.txt b/extra/hexdump/summary.txt similarity index 100% rename from basis/hexdump/summary.txt rename to extra/hexdump/summary.txt From 196c91709f4cb5e0582f5f88b21c473bece9ce1e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 3 Oct 2008 01:12:50 -0500 Subject: [PATCH 054/244] stop-server word --- basis/io/servers/connection/connection.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 0516f24402..674ed8803c 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -105,7 +105,7 @@ M: threaded-server handle-client* handler>> call ; threaded-server get encoding>> [ started-accept-loop ] [ [ accept-loop ] with-disposal ] bi ; -\ start-accept-loop ERROR add-error-logging +\ start-accept-loop NOTICE add-error-logging : init-server ( threaded-server -- threaded-server ) dup semaphore>> [ From ce8b1e3fff3e911ba1fc199c578c23e83b2a72dc Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 3 Oct 2008 01:13:01 -0500 Subject: [PATCH 055/244] Fix permissions --- Makefile | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) mode change 100755 => 100644 Makefile diff --git a/Makefile b/Makefile old mode 100755 new mode 100644 index 769aeacb8c..aa520063e3 --- a/Makefile +++ b/Makefile @@ -149,14 +149,11 @@ macosx.app: factor ln -s Factor.app/Contents/MacOS/factor ./factor cp $(ENGINE) $(BUNDLE)/Contents/Frameworks - install_name_tool \ - -id @executable_path/../Frameworks/libfreetype.6.dylib \ - Factor.app/Contents/Frameworks/libfreetype.6.dylib install_name_tool \ -change libfactor.dylib \ @executable_path/../Frameworks/libfactor.dylib \ Factor.app/Contents/MacOS/factor - + factor: $(DLL_OBJS) $(EXE_OBJS) $(LINKER) $(ENGINE) $(DLL_OBJS) $(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ From 56a0af9628c7817202729b881387b6da92ac2d77 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Oct 2008 02:19:03 -0500 Subject: [PATCH 056/244] initial math cleanup --- extra/math/algebra/algebra.factor | 6 ++- extra/math/analysis/analysis.factor | 12 +++-- extra/math/combinatorics/combinatorics.factor | 11 ++-- extra/math/compare/compare.factor | 1 - extra/math/derivatives/derivatives.factor | 13 +++-- extra/math/erato/erato.factor | 4 +- extra/math/fft/fft.factor | 2 +- extra/math/miller-rabin/miller-rabin.factor | 2 + .../math/newtons-method/newtons-method.factor | 14 +++-- .../numerical-integration.factor | 14 ++--- extra/math/polynomials/polynomials.factor | 4 +- extra/math/primes/primes.factor | 51 ++++++++++--------- extra/math/quaternions/quaternions.factor | 2 +- extra/math/secant-method/secant-method.factor | 24 ++++++--- extra/math/statistics/statistics.factor | 6 ++- extra/math/text/english/english.factor | 11 ++-- extra/math/trig/trig.factor | 4 +- 17 files changed, 101 insertions(+), 80 deletions(-) diff --git a/extra/math/algebra/algebra.factor b/extra/math/algebra/algebra.factor index 8bb8420d1a..8cccded26a 100644 --- a/extra/math/algebra/algebra.factor +++ b/extra/math/algebra/algebra.factor @@ -1,8 +1,10 @@ ! Copyright (c) 2007 Samuel Tardieu ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.functions sequences ; +USING: kernel math math.functions sequences fry ; IN: math.algebra : chinese-remainder ( aseq nseq -- x ) dup product - [ [ over / [ swap gcd drop ] keep * * ] curry 2map sum ] keep rem ; foldable + [ + '[ _ over / [ swap gcd drop ] keep * * ] 2map sum + ] keep rem ; foldable diff --git a/extra/math/analysis/analysis.factor b/extra/math/analysis/analysis.factor index a41281d779..7da1c96b61 100755 --- a/extra/math/analysis/analysis.factor +++ b/extra/math/analysis/analysis.factor @@ -1,5 +1,7 @@ +! Copyright (C) 2008 Doug Coleman, Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.constants math.functions math.intervals -math.vectors namespaces sequences ; +math.vectors namespaces sequences combinators.short-circuit ; IN: math.analysis r log * r> - - swap 6 gamma-z gamma-p6 v. log + ; + [ 0.5 + dup gamma-g6 + dup [ log * ] dip - ] + [ 6 gamma-z gamma-p6 v. log ] bi + ; : gamma-lanczos6 ( x -- gamma[x] ) #! gamma(x) = gamma(x+1) / x @@ -39,7 +41,7 @@ PRIVATE> : gamma ( x -- y ) #! gamma(x) = integral 0..inf [ t^(x-1) exp(-t) ] dt #! gamma(n+1) = n! for n > 0 - dup 0.0 <= over 1.0 mod zero? and [ + dup { [ 0.0 <= ] [ 1.0 mod zero? ] } 1&& [ drop 1./0. ] [ dup abs gamma-lanczos6 swap dup 0 > [ drop ] [ gamma-neg ] if @@ -55,7 +57,7 @@ PRIVATE> ] if ; : nth-root ( n x -- y ) - over 0 = [ "0th root is undefined" throw ] when >r recip r> swap ^ ; + [ recip ] dip swap ^ ; ! Forth Scientific Library Algorithm #1 ! diff --git a/extra/math/combinatorics/combinatorics.factor b/extra/math/combinatorics/combinatorics.factor index a0c6df083b..b1c49b8ab5 100644 --- a/extra/math/combinatorics/combinatorics.factor +++ b/extra/math/combinatorics/combinatorics.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007, 2008 Slava Pestov, Doug Coleman, Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: assocs kernel math math.order math.ranges mirrors -namespaces make sequences sequences.lib sorting ; +namespaces sequences sorting fry ; IN: math.combinatorics [ dupd - ] when ; inline ! See this article for explanation of the factoradic-based permutation methodology: -! http://msdn2.microsoft.com/en-us/library/aa302371.aspx +! http://msdn2.microsoft.com/en-us/library/aa302371.aspx : factoradic ( n -- factoradic ) 0 [ over 0 > ] [ 1+ [ /mod ] keep swap ] [ ] produce reverse 2nip ; @@ -39,13 +39,10 @@ PRIVATE> twiddle [ nPk ] keep factorial / ; : permutation ( n seq -- seq ) - tuck permutation-indices swap nths ; + [ permutation-indices ] keep nths ; : all-permutations ( seq -- seq ) - [ - [ length factorial ] keep [ permutation , ] curry each - ] { } make ; + [ length factorial ] keep '[ _ permutation ] map ; : inverse-permutation ( seq -- permutation ) >alist sort-values keys ; - diff --git a/extra/math/compare/compare.factor b/extra/math/compare/compare.factor index 28a8eadc81..d19dac3d2b 100644 --- a/extra/math/compare/compare.factor +++ b/extra/math/compare/compare.factor @@ -19,4 +19,3 @@ IN: math.compare : clamp ( a value b -- x ) min max ; - diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor index ad8d944bfe..b7612e112b 100644 --- a/extra/math/derivatives/derivatives.factor +++ b/extra/math/derivatives/derivatives.factor @@ -1,4 +1,3 @@ - USING: kernel continuations combinators sequences math math.order math.ranges accessors float-arrays ; @@ -7,11 +6,11 @@ IN: math.derivatives TUPLE: state x func h err i j errt fac hh ans a done ; : largest-float ( -- x ) HEX: 7fefffffffffffff bits>double ; foldable -: ntab ( -- val ) 8 ; -: con ( -- val ) 1.6 ; -: con2 ( -- val ) con con * ; -: big ( -- val ) largest-float ; -: safe ( -- val ) 2.0 ; +: ntab ( -- val ) 8 ; inline +: con ( -- val ) 1.6 ; inline +: con2 ( -- val ) con con * ; inline +: big ( -- val ) largest-float ; inline +: safe ( -- val ) 2.0 ; inline ! Yes, this was ported from C code. : a[i][i] ( state -- elt ) [ i>> ] [ i>> ] [ a>> ] tri nth nth ; @@ -120,4 +119,4 @@ TUPLE: state x func h err i j errt fac hh ans a done ; bi ; : derivative ( x func -- m ) 0.01 2.0 (derivative) drop ; -: derivative-func ( func -- der ) [ derivative ] curry ; \ No newline at end of file +: derivative-func ( func -- der ) [ derivative ] curry ; diff --git a/extra/math/erato/erato.factor b/extra/math/erato/erato.factor index f836d71a99..4c6675e8f1 100644 --- a/extra/math/erato/erato.factor +++ b/extra/math/erato/erato.factor @@ -11,8 +11,8 @@ TUPLE: erato limit bits latest ; : ind ( n -- i ) 2/ 1- ; inline -: is-prime ( n erato -- bool ) - >r ind r> bits>> nth ; inline +: is-prime ( n limit -- bool ) + [ ind ] [ bits>> ] bi* nth ; inline : indices ( n erato -- range ) limit>> ind over 3 * ind swap rot ; diff --git a/extra/math/fft/fft.factor b/extra/math/fft/fft.factor index 682d2a49db..b82ecb6b2c 100644 --- a/extra/math/fft/fft.factor +++ b/extra/math/fft/fft.factor @@ -9,7 +9,7 @@ IN: math.fft : odd ( seq -- seq ) 2 group 1 ; DEFER: fft : two ( seq -- seq ) fft 2 v/n dup append ; -: omega ( n -- n ) recip -2 pi i* * * exp ; +: omega ( n -- n' ) recip -2 pi i* * * exp ; : twiddle ( seq -- seq ) dup length dup omega swap n^v v* ; : (fft) ( seq -- seq ) dup odd two twiddle swap even two v+ ; : fft ( seq -- seq ) dup length 1 = [ (fft) ] unless ; diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor index f1953340db..45665c701d 100755 --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: combinators combinators.lib io locals kernel math math.functions math.ranges namespaces random sequences hashtables sets ; diff --git a/extra/math/newtons-method/newtons-method.factor b/extra/math/newtons-method/newtons-method.factor index 5bf71deac8..269eae2538 100644 --- a/extra/math/newtons-method/newtons-method.factor +++ b/extra/math/newtons-method/newtons-method.factor @@ -1,11 +1,17 @@ ! Copyright © 2008 Reginald Keith Ford II +! See http://factorcode.org/license.txt for BSD license. ! Newton's Method of approximating roots - USING: kernel math math.derivatives ; IN: math.newtons-method -: newtons-method ( guess function -- x ) newton-precision [ [ newton-step ] keep ] times drop ; + +: newtons-method ( guess function -- x ) + newton-precision [ [ newton-step ] keep ] times drop ; diff --git a/extra/math/numerical-integration/numerical-integration.factor b/extra/math/numerical-integration/numerical-integration.factor index 798d3a5e71..dfaa618b53 100644 --- a/extra/math/numerical-integration/numerical-integration.factor +++ b/extra/math/numerical-integration/numerical-integration.factor @@ -1,18 +1,20 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel sequences namespaces make math math.ranges math.vectors vectors ; IN: math.numerical-integration SYMBOL: num-steps 180 num-steps set-global + : setup-simpson-range ( from to -- frange ) 2dup swap - num-steps get / ; : generate-simpson-weights ( seq -- seq ) - [ - { 1 4 } % length 2 / 2 - { 2 4 } concat % 1 , - ] { } make ; + { 1 4 } + swap length 2 / 2 - { 2 4 } concat + { 1 } 3append ; : integrate-simpson ( from to f -- x ) - >r setup-simpson-range r> - dupd map dup generate-simpson-weights + [ setup-simpson-range dup ] dip + map dup generate-simpson-weights v. swap [ third ] keep first - 6 / * ; - diff --git a/extra/math/polynomials/polynomials.factor b/extra/math/polynomials/polynomials.factor index 8662bbb089..51512ca2e3 100644 --- a/extra/math/polynomials/polynomials.factor +++ b/extra/math/polynomials/polynomials.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel sequences vectors math math.vectors namespaces make shuffle splitting sequences.lib math.order ; IN: math.polynomials @@ -82,5 +84,5 @@ PRIVATE> : polyval ( p x -- p[x] ) #! Evaluate a polynomial. - >r dup length r> powers v. ; + [ dup length ] dip powers v. ; diff --git a/extra/math/primes/primes.factor b/extra/math/primes/primes.factor index f3a515e72b..feb60c555d 100644 --- a/extra/math/primes/primes.factor +++ b/extra/math/primes/primes.factor @@ -8,44 +8,45 @@ IN: math.primes : next-prime ( n -- p ) - dup 999983 < [ - primes-under-million [ natural-search drop 1+ ] keep nth - ] [ - next-odd find-prime-miller-rabin - ] if ; foldable + dup 999983 < [ + primes-under-million [ natural-search drop 1+ ] keep nth + ] [ + next-odd find-prime-miller-rabin + ] if ; foldable : prime? ( n -- ? ) - dup 1000000 < [ - dup primes-under-million natural-search nip = - ] [ - miller-rabin - ] if ; foldable + dup 1000000 < [ + dup primes-under-million natural-search nip = + ] [ + miller-rabin + ] if ; foldable : lprimes ( -- list ) - 0 primes-under-million seq>list - 1000003 [ 2 + find-prime-miller-rabin ] lfrom-by - lappend ; + 0 primes-under-million seq>list + 1000003 [ 2 + find-prime-miller-rabin ] lfrom-by + lappend ; : lprimes-from ( n -- list ) - dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; + dup 3 < [ drop lprimes ] [ 1- next-prime [ next-prime ] lfrom-by ] if ; : primes-upto ( n -- seq ) - { - { [ dup 2 < ] [ drop { } ] } - { [ dup 1000003 < ] - [ primes-under-million [ natural-search drop 1+ 0 swap ] keep ] } - [ primes-under-million 1000003 lprimes-from - rot [ <= ] curry lwhile list>array append ] - } cond ; foldable + { + { [ dup 2 < ] [ drop { } ] } + { [ dup 1000003 < ] [ + primes-under-million [ natural-search drop 1+ 0 swap ] keep + ] } + [ primes-under-million 1000003 lprimes-from + rot [ <= ] curry lwhile list>array append ] + } cond ; foldable : primes-between ( low high -- seq ) - primes-upto - [ 1- next-prime ] dip - [ natural-search drop ] keep [ length ] keep ; foldable + primes-upto + [ 1- next-prime ] dip + [ natural-search drop ] keep [ length ] keep ; foldable : coprime? ( a b -- ? ) gcd nip 1 = ; foldable diff --git a/extra/math/quaternions/quaternions.factor b/extra/math/quaternions/quaternions.factor index 3c450f1c05..65f18d3568 100755 --- a/extra/math/quaternions/quaternions.factor +++ b/extra/math/quaternions/quaternions.factor @@ -28,7 +28,7 @@ PRIVATE> : qconjugate ( u -- u' ) #! Quaternion conjugate. - first2 neg >r conjugate r> 2array ; + first2 [ conjugate ] [ neg ] bi* 2array ; : qrecip ( u -- 1/u ) #! Quaternion inverse. diff --git a/extra/math/secant-method/secant-method.factor b/extra/math/secant-method/secant-method.factor index e039b42bbd..ad52c0cd4a 100644 --- a/extra/math/secant-method/secant-method.factor +++ b/extra/math/secant-method/secant-method.factor @@ -1,14 +1,26 @@ ! Copyright © 2008 Reginald Keith Ford II +! See http://factorcode.org/license.txt for BSD license. ! Secant Method of approximating roots - USING: kernel math math.function-tools math.points math.vectors ; IN: math.secant-method -: secant-method ( left right function -- x ) secant-precision [ secant-step ] times drop + 2 / ; + +: secant-method ( left right function -- x ) + secant-precision [ secant-step ] times drop + 2 / ; + ! : close-enough? ( a b -- t/f ) - abs tiny-amount < ; -! : secant-method2 ( left right function -- x ) 2over close-enough? [ drop average ] [ secant-step secant-method ] if ; \ No newline at end of file + +! : secant-method2 ( left right function -- x ) + ! 2over close-enough? + ! [ drop average ] [ secant-step secant-method ] if ; diff --git a/extra/math/statistics/statistics.factor b/extra/math/statistics/statistics.factor index 28cc05151b..8cd6d26c1c 100644 --- a/extra/math/statistics/statistics.factor +++ b/extra/math/statistics/statistics.factor @@ -1,5 +1,7 @@ +! Copyright (C) 2008 Doug Coleman, Michael Judge. +! See http://factorcode.org/license.txt for BSD license. USING: kernel math math.analysis math.functions math.vectors sequences - sequences.lib sorting ; +sequences.lib sorting ; IN: math.statistics : mean ( seq -- n ) @@ -18,7 +20,7 @@ IN: math.statistics : median ( seq -- n ) #! middle number if odd, avg of two middle numbers if even natural-sort dup length dup even? [ - 1- 2 / swap [ nth ] [ >r 1+ r> nth ] 2bi + 2 / + 1- 2 / swap [ nth ] [ [ 1+ ] dip nth ] 2bi + 2 / ] [ 2 / swap nth ] if ; diff --git a/extra/math/text/english/english.factor b/extra/math/text/english/english.factor index 387be4d791..439d0a75fe 100755 --- a/extra/math/text/english/english.factor +++ b/extra/math/text/english/english.factor @@ -1,8 +1,7 @@ ! Copyright (c) 2007 Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: combinators.lib kernel math math.functions math.parser namespaces - sequences splitting grouping sequences.lib - combinators.short-circuit ; +sequences splitting grouping combinators.short-circuit ; IN: math.text.english text) ( n -- str ) - dup negative-text swap abs 3digit-groups recombine append ; + [ negative-text ] [ abs 3digit-groups recombine ] bi append ; PRIVATE> : number>text ( n -- str ) - dup zero? [ - small-numbers - ] [ - [ (number>text) ] with-scope - ] if ; + dup zero? [ small-numbers ] [ [ (number>text) ] with-scope ] if ; diff --git a/extra/math/trig/trig.factor b/extra/math/trig/trig.factor index be9ec6a56c..3d9428adda 100644 --- a/extra/math/trig/trig.factor +++ b/extra/math/trig/trig.factor @@ -1,6 +1,6 @@ - +! Copyright (C) 2008 Eduardo Cavazos. +! See http://factorcode.org/license.txt for BSD license. USING: math math.constants ; - IN: math.trig : deg>rad pi * 180 / ; inline From dc4e989002a01bbe8af9d9d46b6296ac6a18587e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Oct 2008 20:19:20 -0500 Subject: [PATCH 057/244] clean up the db code some, more docs --- basis/db/db-docs.factor | 70 ++++++++++++++++++++++-------- basis/db/db.factor | 16 +++---- basis/db/sqlite/sqlite.factor | 4 +- basis/db/tuples/tuples-docs.factor | 55 ++++++++++++++++++++++- basis/db/tuples/tuples.factor | 7 ++- 5 files changed, 118 insertions(+), 34 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index b0a01269ab..250e21fdaa 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -9,7 +9,8 @@ HELP: db HELP: new-db { $values { "class" class } { "obj" object } } -{ $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." } ; +{ $description "Creates a new database object from a given class with caches for prepared statements. Does not actually connect to the database until " { $link db-open } " or " { $link with-db } " is called." } +{ $notes "User-defined databases must call this constructor word instead of " { $link new } "." } ; HELP: db-open { $values { "db" db } { "db" db } } @@ -19,6 +20,8 @@ HELP: db-close { $values { "handle" alien } } { $description "Closes a database using the handle provided. Use of the " { $link with-db } " combinator is preferred over manually opening and closing databases so that resources are not leaked." } ; +{ db-open db-close with-db } related-words + HELP: dispose-statements { $values { "assoc" assoc } } { $description "Disposes an associative list of statements." } ; @@ -49,22 +52,28 @@ HELP: new-statement HELP: { $values { "string" string } { "in" sequence } { "out" sequence } { "statement" statement } } -{ $description "Makes a new simple statement object from the given parameters." } ; +{ $description "Makes a new simple statement object from the given parameters.." } +{ $warning "Using a simple statement can lead to SQL injection attacks in PostgreSQL. The Factor database implementation for SQLite only uses " { $link } " as the sole kind of statement; simple statements alias to prepared ones." } ; HELP: { $values { "string" string } { "in" sequence } { "out" sequence } { "statement" statement } } -{ $description "Makes a new prepared statement object from the given parameters." } ; +{ $description "Makes a new prepared statement object from the given parameters. A prepared statement's parameters will be escaped by the database backend to avoid SQL injection attacks. Prepared statements should be preferred over simple statements." } ; HELP: prepare-statement { $values { "statement" statement } } { $description "For databases which implement a method on this generic, it does some internal processing to ready the statement for execution." } ; +HELP: low-level-bind +{ $values + { "statement" statement } } +{ $description "For use with prepared statements, methods on this word should bind the datatype in the SQL spec to its identifier in the SQL string. To name bound variables, SQLite uses identifiers in the form of " { $snippet ":name" } ", while PostgreSQL uses increasing numbers beginning with a dollar sign, e.g. " { $snippet "$1" } "." } ; + HELP: query-results { $values { "query" object } { "result-set" result-set } } -{ $description "Returns a " { $link result-set } " object representing the reults of a SQL query." } ; +{ $description "Returns a " { $link result-set } " object representing the results of a SQL query. See " { $link "db-result-sets" } "." } ; HELP: #rows { $values { "result-set" result-set } { "n" integer } } @@ -161,22 +170,20 @@ HELP: with-transaction { $description "" } ; ARTICLE: "db" "Database library" +"Accessing a database:" { $subsection "db-custom-database-combinators" } +"Higher-level database help:" +{ $vocab-subsection "Database types" "db.types" } +{ $vocab-subsection "High-level tuple/database integration" "db.tuples" } +"Low-level database help:" { $subsection "db-protocol" } { $subsection "db-result-sets" } { $subsection "db-lowlevel-tutorial" } -"Higher-level database:" -{ $vocab-subsection "Database types" "db.types" } -{ $vocab-subsection "High-level tuple/database integration" "db.tuples" } -! { $subsection "db-tuples" } -! { $subsection "db-tuples-protocol" } -! { $subsection "db-tuples-tutorial" } "Supported database backends:" { $vocab-subsection "SQLite" "db.sqlite" } { $vocab-subsection "PostgreSQL" "db.postgresql" } "To add support for another database to Factor:" -{ $subsection "db-porting-the-library" } -; +{ $subsection "db-porting-the-library" } ; ARTICLE: "db-random-access-result-set" "Random access result sets" "Random-access result sets do not have to be traversed in order. For instance, PostgreSQL's result set object can be accessed as a matrix with i,j coordinates." @@ -234,7 +241,32 @@ ARTICLE: "db-protocol" "Low-level database protocol" ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial" "Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." -; +"Executing a SQL command:" +{ $subsection sql-command } +"Executing a query directly:" +{ $subsection sql-query } +"Here's an example usage where we'll make a book table, insert some objects, and query them." $nl +"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details." +{ $code <" +USING: db.sqlite db io.files ; +: with-book-db ( quot -- ) + "book.db" temp-file swap with-db ;"> } +"Now let's create the table manually:" +{ $code <" "create table books + (id integer primary key, title text, author text, date_published timestamp, + edition integer, cover_price double, condition text)" + [ sql-command ] with-book-db" "> } +"Time to insert some books:" +{ $code <" +"insert into books + (title, author, date_published, edition, cover_price, condition) + values('Factor for Sheeple', 'Mister Stacky Pants', date('now'), 1, 13.37, 'mint')" +[ sql-command ] with-book-db"> } +"Now let's select the book:" +{ $code <" +"select id, title, cover_price from books;" [ sql-query ] with-book-db "> } +"Notice that the result of this query is a Factor array containing the database rows as arrays of strings. We would have to convert the " { $snippet "cover_price" } " from a string to a number in order to use it in a calculation." $nl +"In conclusion, this method of accessing a database is supported, but it is fairly low-level and generally specific to a single database. The " { $vocab-link "db.tuples" } " vocabulary is a good alternative to writing SQL by hand." ; ARTICLE: "db-porting-the-library" "Porting the database library" "There are two layers to implement when porting the database library." @@ -244,22 +276,24 @@ ARTICLE: "db-porting-the-library" "Porting the database library" ARTICLE: "db-custom-database-combinators" "Custom database combinators" "Every database library requires some effort on the programmer's part to initialize and open a database. SQLite uses files on your harddisk, so a simple pathname is all the setup required. With PostgreSQL, you log in to a networked server as a user on a specfic port." $nl -"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." +"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." $nl + +"SQLite example combinator:" { $code <" USING: db.sqlite db io.files ; : with-sqlite-db ( quot -- ) - "my-database.db" temp-file rot with-db ;"> } + "my-database.db" temp-file swap with-db ;"> } +"PostgreSQL example combinator:" { $code <" USING: db.postgresql db ; : with-postgresql-db ( quot -- ) "localhost" >>host + 5432 >>port "erg" >>username "secrets?" >>password "factor-test" >>database swap with-db ;"> -} - -; +} ; ABOUT: "db" diff --git a/basis/db/db.factor b/basis/db/db.factor index 5b159d0ea1..bf23005bc2 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -111,22 +111,22 @@ M: object execute-statement* ( statement type -- ) [ db-open db ] dip '[ db get [ drop @ ] with-disposal ] with-variable ; inline +! Words for working with raw SQL statements : default-query ( query -- result-set ) query-results [ [ sql-row ] query-map ] with-disposal ; : sql-query ( sql -- rows ) f f [ default-query ] with-disposal ; -: sql-command ( sql -- ) - dup string? [ - f f [ execute-statement ] with-disposal - ] [ - ! [ - [ sql-command ] each - ! ] with-transaction - ] if ; +: (sql-command) ( string -- ) + f f [ execute-statement ] with-disposal ; +: sql-command ( sql -- ) + dup string? [ (sql-command) ] [ [ (sql-command) ] each ] if ; + +! Transactions SYMBOL: in-transaction + HOOK: begin-transaction db ( -- ) HOOK: commit-transaction db ( -- ) HOOK: rollback-transaction db ( -- ) diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index dfe4fdf475..8580b9012c 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -49,8 +49,8 @@ M: sqlite-result-set dispose ( result-set -- ) handle>> [ sqlite3_reset drop ] [ sqlite3_clear_bindings drop ] bi ; M: sqlite-statement low-level-bind ( statement -- ) - [ bind-params>> ] [ handle>> ] bi - [ swap [ key>> ] [ value>> ] [ type>> ] tri sqlite-bind-type ] curry each ; + [ handle>> ] [ bind-params>> ] bi + [ [ key>> ] [ value>> ] [ type>> ] tri sqlite-bind-type ] with each ; M: sqlite-statement bind-statement* ( statement -- ) sqlite-maybe-prepare diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor index 497cc2e8c5..8b1c8cbb49 100644 --- a/basis/db/tuples/tuples-docs.factor +++ b/basis/db/tuples/tuples-docs.factor @@ -1,9 +1,46 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: classes help.markup help.syntax io.streams.string kernel -quotations sequences strings multiline math db.types ; +quotations sequences strings multiline math db.types db ; IN: db.tuples +HELP: +{ $values + { "query" query } + { "statement" statement } } +{ $description "A database-specific hook for generating the SQL for a count statement." } ; + +HELP: +{ $values + { "tuple" tuple } { "class" class } + { "object" object } } +{ $description "A database-specific hook for generating the SQL for an delete statement." } ; + +HELP: +{ $values + { "class" class } + { "object" object } } +{ $description "A database-specific hook for generating the SQL for an insert statement with a database-assigned primary key." } ; + +HELP: +{ $values + { "class" class } + { "object" object } } +{ $description "A database-specific hook for generating the SQL for an insert statement with a user-assigned primary key." } ; + +HELP: +{ $values + { "tuple" tuple } { "class" class } + { "tuple" tuple } } +{ $description "A database-specific hook for generating the SQL for a select statement." } ; + +HELP: +{ $values + { "class" class } + { "object" object } } +{ $description "A database-specific hook for generating the SQL for an update statement." } ; + + HELP: define-persistent { $values { "class" class } { "table" string } { "columns" "an array of slot specifiers" } } @@ -128,7 +165,21 @@ ARTICLE: "db-tuples-words" "High-level tuple/database words" { $subsection count-tuples } ; ARTICLE: "db-tuples-protocol" "Tuple database protocol" -; +"Creating a table:" +{ $subsection create-sql-statement } +"Dropping a table:" +{ $subsection drop-sql-statement } +"Inserting a tuple:" +{ $subsection } +{ $subsection } +"Updating a tuple:" +{ $subsection } +"Deleting tuples:" +{ $subsection } +"Selecting tuples:" +{ $subsection } +"Counting tuples:" +{ $subsection } ; ARTICLE: "db-tuples-tutorial" "Tuple database tutorial" "Let's make a tuple and store it in a database. To follow along, click on each code example and run it in the listener. If you forget to run an example, just start at the top and run them all again in order." $nl diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index 20d7ac4f84..7a5c9e41e6 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -6,8 +6,6 @@ math.parser io prettyprint db.types continuations destructors mirrors sets db.types ; IN: db.tuples - db ( tuple class -- object ) HOOK: db ( tuple class -- tuple ) HOOK: db ( query -- statement ) HOOK: query>statement db ( query -- statement ) - HOOK: insert-tuple-set-key db ( tuple statement -- ) +string ; @@ -68,7 +68,6 @@ GENERIC: eval-generator ( singleton -- object ) PRIVATE> - ! High level ERROR: no-slots-named class seq ; : check-columns ( class columns -- ) From 3d92ef87fe275ea4e45dfeda56d4dcb1fc9800e5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 3 Oct 2008 20:21:23 -0500 Subject: [PATCH 058/244] remove redundant section --- basis/db/db-docs.factor | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 250e21fdaa..509391579e 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -181,9 +181,7 @@ ARTICLE: "db" "Database library" { $subsection "db-lowlevel-tutorial" } "Supported database backends:" { $vocab-subsection "SQLite" "db.sqlite" } -{ $vocab-subsection "PostgreSQL" "db.postgresql" } -"To add support for another database to Factor:" -{ $subsection "db-porting-the-library" } ; +{ $vocab-subsection "PostgreSQL" "db.postgresql" } ; ARTICLE: "db-random-access-result-set" "Random access result sets" "Random-access result sets do not have to be traversed in order. For instance, PostgreSQL's result set object can be accessed as a matrix with i,j coordinates." @@ -268,11 +266,6 @@ USING: db.sqlite db io.files ; "Notice that the result of this query is a Factor array containing the database rows as arrays of strings. We would have to convert the " { $snippet "cover_price" } " from a string to a number in order to use it in a calculation." $nl "In conclusion, this method of accessing a database is supported, but it is fairly low-level and generally specific to a single database. The " { $vocab-link "db.tuples" } " vocabulary is a good alternative to writing SQL by hand." ; -ARTICLE: "db-porting-the-library" "Porting the database library" -"There are two layers to implement when porting the database library." -{ $subsection "db-protocol" } -; - ARTICLE: "db-custom-database-combinators" "Custom database combinators" "Every database library requires some effort on the programmer's part to initialize and open a database. SQLite uses files on your harddisk, so a simple pathname is all the setup required. With PostgreSQL, you log in to a networked server as a user on a specfic port." $nl From 6b3b48a106405c482a2ecc9bbe58f40fb4fd7b06 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 11:44:12 -0500 Subject: [PATCH 059/244] random is generic, better random docs, cleanups --- .../mersenne-twister-tests.factor | 8 ++-- basis/random/random-docs.factor | 46 +++++++++++++++---- basis/random/random-tests.factor | 6 ++- basis/random/random.factor | 40 +++++++++++----- 4 files changed, 74 insertions(+), 26 deletions(-) diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index 3f0ebf692a..8a2a5031fa 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -3,17 +3,17 @@ random.mersenne-twister sequences tools.test math.order ; IN: random.mersenne-twister.tests : check-random ( max -- ? ) - dup >r random 0 r> between? ; + [ random 0 ] keep between? ; [ t ] [ 100 [ drop 674 check-random ] all? ] unit-test -: make-100-randoms - [ 100 [ 100 random , ] times ] { } make ; +: randoms ( -- seq ) + 100 [ 100 random ] replicate ; : test-rng ( seed quot -- ) >r r> with-random ; -[ f ] [ 1234 [ make-100-randoms make-100-randoms = ] test-rng ] unit-test +[ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test [ 1333075495 ] [ 0 [ 1000 [ drop random-generator get random-32* drop ] each random-generator get random-32* ] test-rng diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index 74751328d5..c5daee783e 100644 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -1,12 +1,6 @@ -USING: help.markup help.syntax math ; +USING: help.markup help.syntax math kernel sequences ; IN: random -ARTICLE: "random-numbers" "Generating random integers" -"The " { $vocab-link "random" } " vocabulary implements the ``Mersenne Twister'' pseudo-random number generator algorithm." -{ $subsection random } ; - -ABOUT: "random-numbers" - HELP: seed-random { $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } } { $description "Seed the random number generator." } @@ -21,8 +15,8 @@ HELP: random-bytes* { $description "Generates a byte-array of random bytes." } ; HELP: random -{ $values { "seq" "a sequence" } { "elt" "a random element" } } -{ $description "Outputs a random element of the sequence. If the sequence is empty, always outputs " { $link f } "." } +{ $values { "obj" object } { "elt" "a random element" } } +{ $description "Outputs a random element of the input object. If the object is an integer, an input of zero always returns a zero, a negative integer throws an error, and positive integers yield a random integer in the interval " { $snippet "[0,n)" } ". On a sequence, an empty sequence always outputs " { $link f } " while any other sequence outputs a random element." } { $notes "Since integers are sequences, passing an integer " { $snippet "n" } " yields a random integer in the interval " { $snippet "[0,n)" } "." } ; HELP: random-bytes @@ -47,4 +41,36 @@ HELP: with-secure-random { $values { "quot" "a quotation" } } { $description "Calls the quotation with the secure random generator in a dynamic variable. All random numbers will be generated using this random generator." } ; -{ with-random with-secure-random } related-words +HELP: with-system-random +{ $values { "quot" "a quotation" } } +{ $description "Calls the quotation with the system's random generator in a dynamic variable. All random numbers will be generated using this random generator." } ; + +{ with-random with-secure-random with-system-random } related-words + +HELP: delete-random +{ $values + { "seq" sequence } + { "elt" object } } +{ $description "Delete a random number from a sequence using " { $link delete-nth } " and returns the deleted object." } ; + +ARTICLE: "random-protocol" "Random protocol" +"A random number generator must implement one of these two words:" +{ $subsection random-32* } +{ $subsection random-bytes* } +"Optional, to seed a random number generator:" +{ $subsection seed-random } ; + +ARTICLE: "random" "Generating random integers" +"The " { $vocab-link "random" } " vocabulary contains a protocol for generating random or pseudorandom numbers. The ``Mersenne Twister'' pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "." +"Generate a random object:" +{ $subsection random } +"Combinators to change the random number generator:" +{ $subsection with-random } +{ $subsection with-system-random } +{ $subsection with-secure-random } +"Implementation:" +{ $subsection "random-protocol" } +"Deleting a random element from a sequence:" +{ $subsection delete-random } ; + +ABOUT: "random" diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor index 89c0c02c4a..7300a0dac4 100644 --- a/basis/random/random-tests.factor +++ b/basis/random/random-tests.factor @@ -1,5 +1,5 @@ USING: random sequences tools.test kernel math math.functions -sets ; +sets math.constants ; IN: random.tests [ 4 ] [ 4 random-bytes length ] unit-test @@ -15,3 +15,7 @@ IN: random.tests [ t ] [ 10000 [ 0 [ drop 400 random + ] reduce ] keep / 2 * 400 10 ~ ] unit-test [ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test + +[ t ] [ pi random float? ] unit-test + +[ 0 ] [ 0 random ] unit-test diff --git a/basis/random/random.factor b/basis/random/random.factor index 5ee45e6729..673a97caa3 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -33,20 +33,38 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; random-generator get random-bytes* ] keep head ; -: random ( seq -- elt ) - [ f ] [ - [ - length dup log2 7 + 8 /i 1+ - [ random-bytes byte-array>bignum ] - [ 3 shift 2^ ] bi / * >integer - ] keep nth - ] if-empty ; - -: delete-random ( seq -- elt ) - [ length random ] keep [ nth ] 2keep delete-nth ; +GENERIC: random ( obj -- elt ) : random-bits ( n -- r ) 2^ random ; +bignum ] + [ 3 shift 2^ ] bi / * >integer ; + +PRIVATE> + +M: sequence random ( seq -- elt ) + [ f ] [ + [ length random-integer ] keep nth + ] if-empty ; + +ERROR: negative-random n ; +M: integer random ( integer -- integer' ) + { + { [ dup 0 = ] [ ] } + { [ dup 0 < ] [ negative-random ] } + [ random-integer ] + } cond ; + +M: float random ( float -- elt ) + 64 random-bits 64 2^ 1- / * ; + +: delete-random ( seq -- elt ) + [ length random-integer ] keep [ nth ] 2keep delete-nth ; + : with-random ( tuple quot -- ) random-generator swap with-variable ; inline From efb5fa0814034ffc8036dfc61adc1f1ce787dc15 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 11:45:21 -0500 Subject: [PATCH 060/244] don't redefine delete-random --- basis/heaps/authors.txt | 1 + basis/heaps/heaps-tests.factor | 4 ---- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/basis/heaps/authors.txt b/basis/heaps/authors.txt index 1229a590fa..d0c12d9aa4 100755 --- a/basis/heaps/authors.txt +++ b/basis/heaps/authors.txt @@ -1,2 +1,3 @@ Doug Coleman Ryan Murphy +Slava Pestov diff --git a/basis/heaps/heaps-tests.factor b/basis/heaps/heaps-tests.factor index 13b6a97654..e28eb3007a 100644 --- a/basis/heaps/heaps-tests.factor +++ b/basis/heaps/heaps-tests.factor @@ -1,6 +1,5 @@ ! Copyright 2007, 2008 Ryan Murphy, Slava Pestov ! See http://factorcode.org/license.txt for BSD license. - USING: arrays kernel math namespaces tools.test heaps heaps.private math.parser random assocs sequences sorting accessors math.order ; @@ -54,9 +53,6 @@ IN: heaps.tests [ t ] swap [ 2^ test-entry-indices ] curry unit-test ] each -: delete-random ( seq -- elt ) - dup length random dup pick nth >r swap delete-nth r> ; - : sort-entries ( entries -- entries' ) [ [ key>> ] compare ] sort ; From aebb58263478d27eeee495620021ad75f8a06ada Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 11:45:48 -0500 Subject: [PATCH 061/244] remove ?first etc --- extra/sequences/lib/lib-tests.factor | 7 ------- extra/sequences/lib/lib.factor | 9 --------- 2 files changed, 16 deletions(-) diff --git a/extra/sequences/lib/lib-tests.factor b/extra/sequences/lib/lib-tests.factor index a44d41d98a..509d9b1432 100755 --- a/extra/sequences/lib/lib-tests.factor +++ b/extra/sequences/lib/lib-tests.factor @@ -47,13 +47,6 @@ IN: sequences.lib.tests [ t ] [ "ab" 4 strings [ >string ] map "abab" swap member? ] unit-test [ { { } { 1 } { 2 } { 1 2 } } ] [ { 1 2 } power-set ] unit-test -[ f ] [ { } ?first ] unit-test -[ f ] [ { } ?fourth ] unit-test -[ 1 ] [ { 1 2 3 } ?first ] unit-test -[ 2 ] [ { 1 2 3 } ?second ] unit-test -[ 3 ] [ { 1 2 3 } ?third ] unit-test -[ f ] [ { 1 2 3 } ?fourth ] unit-test - [ 1 2 { 3 4 } [ + + ] 2 map-withn ] must-infer { { 6 7 } } [ 1 2 { 3 4 } [ + + ] 2 map-withn ] unit-test { { 16 17 18 19 20 } } [ 1 2 3 4 { 6 7 8 9 10 } [ + + + + ] 4 map-withn ] unit-test diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index fe9d9bb587..ed7f40598c 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -131,15 +131,6 @@ PRIVATE> : power-set ( seq -- subsets ) 2 over length exact-number-strings swap [ switches ] curry map ; -: ?first ( seq -- first/f ) 0 swap ?nth ; inline -: ?second ( seq -- second/f ) 1 swap ?nth ; inline -: ?third ( seq -- third/f ) 2 swap ?nth ; inline -: ?fourth ( seq -- fourth/f ) 3 swap ?nth ; inline - -: ?first2 ( seq -- 1st/f 2nd/f ) dup ?first swap ?second ; inline -: ?first3 ( seq -- 1st/f 2nd/f 3rd/f ) dup ?first2 rot ?third ; inline -: ?first4 ( seq -- 1st/f 2nd/f 3rd/f 4th/f ) dup ?first3 roll ?fourth ; inline - USE: continuations : ?subseq ( from to seq -- subseq ) >r >r 0 max r> r> From 5ca60480c51aff0d7dbf0f00b106999a8f9e416e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 12:40:58 -0500 Subject: [PATCH 062/244] put a random method on intervals, works for float and integer intervals --- basis/math/intervals/intervals.factor | 39 +++++++++++++++++++++++++-- 1 file changed, 37 insertions(+), 2 deletions(-) diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 7c3bf27e9d..f359cfb7c4 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2007, 2008 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. ! Based on Slate's src/unfinished/interval.slate by Brian Rice. USING: accessors kernel sequences arrays math math.order -combinators generic ; +combinators generic random math.constants qualified ; +FROM: math.ranges => ; IN: math.intervals SYMBOL: empty-interval @@ -396,3 +397,37 @@ SYMBOL: incomparable [ to>> first2 [ 1- ] unless ] bi [a,b] ] unless ; + +> second not ; + +: open-right? ( interval -- ? ) to>> second not ; + +: integral-interval? ( interval -- ? ) + [ from>> ] [ to>> ] bi [ first integer? ] both? ; + +PRIVATE> + +ERROR: empty-random-interval ; + +: random-interval-integer ( interval -- n ) + [ [ to>> first ] [ open-right? [ 1- ] when ] bi ] + [ + [ from>> first ] + [ open-left? [ 1+ ] when ] bi + tuck - 1+ random + + ] bi ; + +: random-interval-float ( interval -- x ) + [ [ from>> first ] [ open-left? [ epsilon + ] when ] bi ] + [ [ to>> first ] [ open-right? [ epsilon - ] when ] bi ] bi + epsilon random [ empty-random-interval ] unless* ; + +M: interval random ( interval -- x ) + dup empty-interval = [ empty-random-interval ] when + dup integral-interval? [ + random-interval-integer + ] [ + random-interval-float + ] if ; From ce7cf8122435c2e8be6386a388faf5dab476e65f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 12:45:10 -0500 Subject: [PATCH 063/244] add more unit tests --- basis/math/intervals/intervals-tests.factor | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index 7d8d496737..481b065a1c 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -1,6 +1,6 @@ USING: math.intervals kernel sequences words math math.order arrays prettyprint tools.test random vocabs combinators -accessors ; +accessors math.constants ; IN: math.intervals.tests [ empty-interval ] [ 2 2 (a,b) ] unit-test @@ -334,3 +334,13 @@ IN: math.intervals.tests [ execute ] [ swapd execute ] 3bi = ] all? ] unit-test + +[ t ] [ 1.0 1.0 epsilon + [a,b] random float? ] unit-test +[ t ] [ 1.0 1.0 epsilon + [a,b) random float? ] unit-test +[ t ] [ 1.0 1.0 epsilon + (a,b] random float? ] unit-test +[ 1.0 1.0 (a,b) random float? ] must-fail + +[ 3 4 + (a,b) random ] must-fail +[ 3 ] [ 3 4 [a,b) random ] unit-test +[ 4 ] [ 3 4 (a,b] random ] unit-test +[ t ] [ 3 4 [a,b] random { 3 4 } member? ] unit-test From a057da4116ea7871679920048dd7484da09147f5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 13:21:06 -0500 Subject: [PATCH 064/244] "finish" database docs --- basis/db/db-docs.factor | 10 ++++++++++ basis/db/tuples/tuples-docs.factor | 17 +++++++++++++++++ 2 files changed, 27 insertions(+) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 509391579e..0acd1f0245 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -49,6 +49,16 @@ HELP: new-statement { $values { "sql" string } { "in" sequence } { "out" sequence } { "class" class } { "statement" statement } } { $description "Makes a new statement object from the given parameters." } ; +HELP: bind-statement +{ $values + { "obj" object } { "statement" statement } } +{ $description "Sets the statement's " { $slot "bind-params" } " and calls " { $link bind-statement* } " to do the database-specific bind. Sets " { $slot "bound?" } " to true if binding succeeds." } ; + +HELP: bind-statement* +{ $values + { "statement" statement } } +{ $description "Does a low-level bind of the SQL statement's tuple parameters if the database requires. Some databases should treat this as a no-op and bind instead when the actual statement is run." } ; + HELP: { $values { "string" string } { "in" sequence } { "out" sequence } { "statement" statement } } diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor index 8b1c8cbb49..02f5dfa38c 100644 --- a/basis/db/tuples/tuples-docs.factor +++ b/basis/db/tuples/tuples-docs.factor @@ -4,6 +4,23 @@ USING: classes help.markup help.syntax io.streams.string kernel quotations sequences strings multiline math db.types db ; IN: db.tuples +HELP: create-sql-statement +{ $values + { "class" class } + { "object" object } } +{ $description "Generates the SQL code for creating a table for a given class." } ; + +HELP: drop-sql-statement +{ $values + { "class" class } + { "object" object } } +{ $description "Generates the SQL code for dropping a table for a given class." } ; + +HELP: insert-tuple-set-key +{ $values + { "tuple" tuple } { "statement" statement } } +{ $description "Inserts a tuple and sets its primary key in one word. This is necessary for some databases." } ; + HELP: { $values { "query" query } From 12afcd2c2c0e2d0062db8d88a4399576bbde3895 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 13:26:17 -0500 Subject: [PATCH 065/244] add relative-url to urls --- basis/urls/urls-docs.factor | 6 ++++++ basis/urls/urls.factor | 2 ++ 2 files changed, 8 insertions(+) diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index 03ffaded05..dc61623571 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -135,6 +135,12 @@ HELP: relative-url } } ; +HELP: relative-url? +{ $values + { "url" url } + { "?" "a boolean" } } +{ $description "Tests whether a given url is relative to a domain." } ; + HELP: secure-protocol? { $values { "protocol" string } { "?" "a boolean" } } { $description "Tests if protocol connections must be made with secure sockets (SSL/TLS)." } diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 30e8c68f9d..597cdfdb7f 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -155,6 +155,8 @@ PRIVATE> f >>host f >>port ; +: relative-url? ( url -- ? ) protocol>> not ; + ! Half-baked stuff follows : secure-protocol? ( protocol -- ? ) "https" = ; From af37d280422de00a9106339ff05662d9bd5b54d7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 13:27:29 -0500 Subject: [PATCH 066/244] remove relative-urls? word and some dead code --- extra/spider/spider.factor | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index 64ee081ecc..bd5b2668be 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -9,7 +9,6 @@ IN: spider TUPLE: spider base count max-count sleep max-depth initial-links filters spidered todo nonmatching quiet ; -! secure? agent page-timeout data-timeout overall-timeout TUPLE: spider-result url depth headers fetch-time parsed-html links processing-time timestamp ; @@ -27,8 +26,6 @@ links processing-time timestamp ; > not ; - : apply-filters ( links spider -- links' ) filters>> [ '[ _ 1&& ] filter ] when* ; @@ -82,10 +79,10 @@ links processing-time timestamp ; [ initial-links>> normalize-hrefs 0 ] keep [ add-todo ] keep ; -: slurp-heap-when ( heap quot1 quot2: ( value key -- ) -- ) +: slurp-heap-while ( heap quot1 quot2: ( value key -- ) -- ) pick heap-empty? [ 3drop ] [ [ [ heap-pop dup ] 2dip slip [ t ] compose [ 2drop f ] if ] - [ roll [ slurp-heap-when ] [ 3drop ] if ] 3bi + [ roll [ slurp-heap-while ] [ 3drop ] if ] 3bi ] if ; inline recursive PRIVATE> @@ -98,7 +95,7 @@ PRIVATE> '[ _ <= spider get [ count>> ] [ max-count>> ] bi < and - ] [ spider-page spider-sleep ] slurp-heap-when + ] [ spider-page spider-sleep ] slurp-heap-while spider get ] with-variable ] with-logging ; From a130928ec248874b03aaff802c357689a53bad68 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 13:28:42 -0500 Subject: [PATCH 067/244] fix docs --- extra/spider/spider-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/spider/spider-docs.factor b/extra/spider/spider-docs.factor index 5f820ca368..41dd13e918 100644 --- a/extra/spider/spider-docs.factor +++ b/extra/spider/spider-docs.factor @@ -16,7 +16,7 @@ HELP: run-spider { "spider" spider } } { $description "Runs a spider until completion. See the " { $subsection "spider-tutorial" } " for a complete description of the tuple slots that affect how thet spider works." } ; -HELP: slurp-heap-when +HELP: slurp-heap-while { $values { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } } { $description "Removes values from a heap that match the predicate quotation " { $snippet "quot1" } " and processes them with " { $snippet "quot2" } " until the predicate quotation no longer matches." } ; From 7dc77903629356e69fe5e317b02bcda2868dce16 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 4 Oct 2008 14:18:16 -0500 Subject: [PATCH 068/244] fix link --- basis/help/handbook/handbook.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/help/handbook/handbook.factor b/basis/help/handbook/handbook.factor index 51750d772f..c1505705da 100644 --- a/basis/help/handbook/handbook.factor +++ b/basis/help/handbook/handbook.factor @@ -90,7 +90,7 @@ ARTICLE: "numbers" "Numbers" { $subsection "math-constants" } { $subsection "math-functions" } { $subsection "number-strings" } -{ $subsection "random-numbers" } +{ $subsection "random" } "Number implementations:" { $subsection "integers" } { $subsection "rationals" } From 54f28c0751cd9df7c283724e67b2cd5be69cb756 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 5 Oct 2008 14:11:11 -0500 Subject: [PATCH 069/244] Fix terminology --- basis/urls/urls-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index dc61623571..204dc2ff08 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -139,7 +139,7 @@ HELP: relative-url? { $values { "url" url } { "?" "a boolean" } } -{ $description "Tests whether a given url is relative to a domain." } ; +{ $description "Tests whether a given URL is relative to a domain." } ; HELP: secure-protocol? { $values { "protocol" string } { "?" "a boolean" } } From 503963580b2e2d09ae41130604eebbee4b2ab252 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 5 Oct 2008 14:33:06 -0500 Subject: [PATCH 070/244] Cut down on vergbiage --- basis/urls/urls-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index 204dc2ff08..b423e6b751 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -139,7 +139,7 @@ HELP: relative-url? { $values { "url" url } { "?" "a boolean" } } -{ $description "Tests whether a given URL is relative to a domain." } ; +{ $description "Tests whether a URL is relative." } ; HELP: secure-protocol? { $values { "protocol" string } { "?" "a boolean" } } From fad3d52bc147af98cf1e9a263607286025698067 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 15:14:05 -0500 Subject: [PATCH 071/244] remove random floats, better docs --- basis/random/random-docs.factor | 19 ++++++++++++++++--- basis/random/random.factor | 5 +---- 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor index c5daee783e..51656a77dd 100644 --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -16,8 +16,21 @@ HELP: random-bytes* HELP: random { $values { "obj" object } { "elt" "a random element" } } -{ $description "Outputs a random element of the input object. If the object is an integer, an input of zero always returns a zero, a negative integer throws an error, and positive integers yield a random integer in the interval " { $snippet "[0,n)" } ". On a sequence, an empty sequence always outputs " { $link f } " while any other sequence outputs a random element." } -{ $notes "Since integers are sequences, passing an integer " { $snippet "n" } " yields a random integer in the interval " { $snippet "[0,n)" } "." } ; +{ $description "Outputs a random element of the input object. If the object is an integer, an input of zero always returns a zero, while any other integer integers yield a random integer in the interval between itself and zero, inclusive of zero. On a sequence, an empty sequence always outputs " { $link f } "." } +{ $examples + { $unchecked-example "USING: random prettyprint ;" + "10 random ." + "3" } + { $example "USING: random prettyprint ;" + "0 random ." + "0" } + { $unchecked-example "USING: random prettyprint ;" + "-10 random ." + "-8" } + { $unchecked-example "USING: random prettyprint ;" + "{ \"a\" \"b\" \"c\" } random ." + "\"a\"" } +} ; HELP: random-bytes { $values { "n" "an integer" } { "byte-array" "a random integer" } } @@ -51,7 +64,7 @@ HELP: delete-random { $values { "seq" sequence } { "elt" object } } -{ $description "Delete a random number from a sequence using " { $link delete-nth } " and returns the deleted object." } ; +{ $description "Deletes a random number from a sequence using " { $link delete-nth } " and returns the deleted object." } ; ARTICLE: "random-protocol" "Random protocol" "A random number generator must implement one of these two words:" diff --git a/basis/random/random.factor b/basis/random/random.factor index 673a97caa3..8a69b28171 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -55,13 +55,10 @@ ERROR: negative-random n ; M: integer random ( integer -- integer' ) { { [ dup 0 = ] [ ] } - { [ dup 0 < ] [ negative-random ] } + { [ dup 0 < ] [ neg random-integer neg ] } [ random-integer ] } cond ; -M: float random ( float -- elt ) - 64 random-bits 64 2^ 1- / * ; - : delete-random ( seq -- elt ) [ length random-integer ] keep [ nth ] 2keep delete-nth ; From 4e88005bf4b362d81b578789fd619524fef27e38 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 15:14:18 -0500 Subject: [PATCH 072/244] remove random intervals for now --- basis/math/intervals/intervals.factor | 34 --------------------------- 1 file changed, 34 deletions(-) diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index f359cfb7c4..38d67aa043 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -397,37 +397,3 @@ SYMBOL: incomparable [ to>> first2 [ 1- ] unless ] bi [a,b] ] unless ; - -> second not ; - -: open-right? ( interval -- ? ) to>> second not ; - -: integral-interval? ( interval -- ? ) - [ from>> ] [ to>> ] bi [ first integer? ] both? ; - -PRIVATE> - -ERROR: empty-random-interval ; - -: random-interval-integer ( interval -- n ) - [ [ to>> first ] [ open-right? [ 1- ] when ] bi ] - [ - [ from>> first ] - [ open-left? [ 1+ ] when ] bi - tuck - 1+ random + - ] bi ; - -: random-interval-float ( interval -- x ) - [ [ from>> first ] [ open-left? [ epsilon + ] when ] bi ] - [ [ to>> first ] [ open-right? [ epsilon - ] when ] bi ] bi - epsilon random [ empty-random-interval ] unless* ; - -M: interval random ( interval -- x ) - dup empty-interval = [ empty-random-interval ] when - dup integral-interval? [ - random-interval-integer - ] [ - random-interval-float - ] if ; From 02bb3063ffcb35ec074016460bf9c307902d27da Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 15:21:23 -0500 Subject: [PATCH 073/244] add word to convert timevals to unix time, add utility words --- basis/calendar/calendar-docs.factor | 38 ++++++++++++++++++++++++++--- basis/calendar/calendar.factor | 10 +++++++- 2 files changed, 44 insertions(+), 4 deletions(-) diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index c3d84fc783..f1cdafb476 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -165,7 +165,15 @@ HELP: milliseconds { $values { "x" number } { "duration" duration } } { $description "Creates a duration object with the specified number of milliseconds." } ; -{ years months days hours minutes seconds milliseconds } related-words +HELP: microseconds +{ $values { "x" number } { "duration" duration } } +{ $description "Creates a duration object with the specified number of microseconds." } ; + +HELP: nanoseconds +{ $values { "x" number } { "duration" duration } } +{ $description "Creates a duration object with the specified number of nanoseconds." } ; + +{ years months days hours minutes seconds milliseconds microseconds nanoseconds } related-words HELP: leap-year? { $values { "obj" object } { "?" "a boolean" } } @@ -263,7 +271,27 @@ HELP: duration>milliseconds } } ; -{ duration>years duration>months duration>days duration>hours duration>minutes duration>seconds duration>milliseconds } related-words +HELP: duration>microseconds +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in microseconds." } +{ $examples + { $example "USING: calendar prettyprint ;" + "6 seconds duration>microseconds ." + "6000000" + } +} ; + +HELP: duration>nanoseconds +{ $values { "duration" duration } { "x" number } } +{ $description "Calculates the length of a duration in nanoseconds." } +{ $examples + { $example "USING: calendar prettyprint ;" + "6 seconds duration>nanoseconds ." + "6000000000" + } +} ; + +{ duration>years duration>months duration>days duration>hours duration>minutes duration>seconds duration>milliseconds duration>microseconds duration>nanoseconds } related-words HELP: time- @@ -528,6 +556,8 @@ ARTICLE: "using-durations" "Using durations" { $subsection minutes } { $subsection seconds } { $subsection milliseconds } +{ $subsection microseconds } +{ $subsection nanoseconds } { $subsection instant } "Converting a duration to a number:" { $subsection duration>years } @@ -536,7 +566,9 @@ ARTICLE: "using-durations" "Using durations" { $subsection duration>hours } { $subsection duration>minutes } { $subsection duration>seconds } -{ $subsection duration>milliseconds } ; +{ $subsection duration>milliseconds } +{ $subsection duration>microseconds } +{ $subsection duration>nanoseconds } ; ARTICLE: "relative-timestamps" "Relative timestamps" "In the future:" diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index c2c386a790..31c835aada 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.functions namespaces sequences strings system vocabs.loader threads accessors combinators -locals classes.tuple math.order summary +locals classes.tuple math.order summary structs combinators.short-circuit ; IN: calendar @@ -129,6 +129,8 @@ PRIVATE> : minutes ( x -- duration ) instant clone swap >>minute ; : seconds ( x -- duration ) instant clone swap >>second ; : milliseconds ( x -- duration ) 1000 / seconds ; +: microseconds ( x -- duration ) 1000000 / seconds ; +: nanoseconds ( x -- duration ) 1000000000 / seconds ; GENERIC: leap-year? ( obj -- ? ) @@ -261,6 +263,8 @@ M: duration <=> [ duration>years ] compare ; : duration>minutes ( duration -- x ) duration>years minutes-per-year * ; : duration>seconds ( duration -- x ) duration>years seconds-per-year * ; : duration>milliseconds ( duration -- x ) duration>seconds 1000 * ; +: duration>microseconds ( duration -- x ) duration>seconds 1000000 * ; +: duration>nanoseconds ( duration -- x ) duration>seconds 1000000000 * ; GENERIC: time- ( time1 time2 -- time3 ) @@ -398,6 +402,10 @@ PRIVATE> : time-since-midnight ( timestamp -- duration ) dup midnight time- ; +: timeval>unix-time ( timeval -- timestamp ) + [ timeval-sec seconds ] [ timeval-usec microseconds ] bi + time+ unix-1970 time+ >local-time ; + M: timestamp sleep-until timestamp>millis sleep-until ; M: duration sleep hence sleep-until ; From 5c8de440852a2bcc927d0553518094961e8c90e3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 15:23:04 -0500 Subject: [PATCH 074/244] more unix ffi functions --- basis/unix/linux/linux.factor | 2 +- basis/unix/unix.factor | 16 +++++++++------- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/basis/unix/linux/linux.factor b/basis/unix/linux/linux.factor index 0c08cf0f2b..457d96c7d8 100644 --- a/basis/unix/linux/linux.factor +++ b/basis/unix/linux/linux.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: unix USING: alien.syntax ; +IN: unix ! Linux. diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 2011fa0dcb..4c572a6be0 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -1,12 +1,10 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. - -USING: alien alien.c-types alien.syntax kernel libc structs sequences - continuations byte-arrays strings - math namespaces system combinators vocabs.loader qualified - accessors stack-checker macros locals generalizations - unix.types debugger io prettyprint ; - +USING: alien alien.c-types alien.syntax kernel libc structs +sequences continuations byte-arrays strings math namespaces +system combinators vocabs.loader qualified accessors +stack-checker macros locals generalizations unix.types +debugger io prettyprint ; IN: unix TYPEDEF: uint in_addr_t @@ -109,8 +107,12 @@ FUNCTION: uid_t geteuid ; FUNCTION: gid_t getgid ; FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ; FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ; +FUNCTION: passwd* getpwent ( ) ; FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ; FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ; +FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ; + +FUNCTION: group* getgrent ; FUNCTION: int gethostname ( char* name, int len ) ; FUNCTION: int getsockname ( int socket, sockaddr* address, socklen_t* address_len ) ; FUNCTION: int getpeername ( int socket, sockaddr* address, socklen_t* address_len ) ; From 6d8bfa4bf4728514b4bbc0da639329e53bb23072 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 15:38:31 -0500 Subject: [PATCH 075/244] remove some dead usings --- basis/math/intervals/intervals.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 38d67aa043..213bfce354 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. ! Based on Slate's src/unfinished/interval.slate by Brian Rice. USING: accessors kernel sequences arrays math math.order -combinators generic random math.constants qualified ; -FROM: math.ranges => ; +combinators generic ; IN: math.intervals SYMBOL: empty-interval From 7bf5a3a077f74ca787c5805390fd819d18f25b6d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 16:41:42 -0500 Subject: [PATCH 076/244] remove unit test --- basis/random/random-tests.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor index 7300a0dac4..c6d88c5525 100644 --- a/basis/random/random-tests.factor +++ b/basis/random/random-tests.factor @@ -1,5 +1,5 @@ USING: random sequences tools.test kernel math math.functions -sets math.constants ; +sets ; IN: random.tests [ 4 ] [ 4 random-bytes length ] unit-test @@ -16,6 +16,4 @@ IN: random.tests [ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test -[ t ] [ pi random float? ] unit-test - [ 0 ] [ 0 random ] unit-test From ccdcacfd0419afabeb42fba76d4d1fbaaf8d5594 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 16:41:51 -0500 Subject: [PATCH 077/244] remove unit tests --- basis/math/intervals/intervals-tests.factor | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index 481b065a1c..ad2fb53dc4 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -334,13 +334,3 @@ IN: math.intervals.tests [ execute ] [ swapd execute ] 3bi = ] all? ] unit-test - -[ t ] [ 1.0 1.0 epsilon + [a,b] random float? ] unit-test -[ t ] [ 1.0 1.0 epsilon + [a,b) random float? ] unit-test -[ t ] [ 1.0 1.0 epsilon + (a,b] random float? ] unit-test -[ 1.0 1.0 (a,b) random float? ] must-fail - -[ 3 4 + (a,b) random ] must-fail -[ 3 ] [ 3 4 [a,b) random ] unit-test -[ 4 ] [ 3 4 (a,b] random ] unit-test -[ t ] [ 3 4 [a,b] random { 3 4 } member? ] unit-test From 94d7772c1352c5db0c57b5431d86dff47034e90c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 18:26:24 -0500 Subject: [PATCH 078/244] remove unused word, make some stuff compile --- basis/unicode/collation/collation-tests.factor | 6 +----- basis/unicode/collation/collation.factor | 9 ++++----- 2 files changed, 5 insertions(+), 10 deletions(-) diff --git a/basis/unicode/collation/collation-tests.factor b/basis/unicode/collation/collation-tests.factor index bf87c6b7da..be6af2d920 100644 --- a/basis/unicode/collation/collation-tests.factor +++ b/basis/unicode/collation/collation-tests.factor @@ -11,11 +11,7 @@ IN: unicode.collation.tests : test-two ( str1 str2 -- ) [ +lt+ ] -rot [ string<=> ] 2curry unit-test ; -: failures - parse-test dup 2 - [ string<=> +lt+ = not ] assoc-filter dup assoc-size ; - -: test-equality +: test-equality ( str1 str2 -- ) { primary= secondary= tertiary= quaternary= } [ execute ] with with each ; diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index 8e9e2963a8..65786ede5d 100644 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -100,8 +100,8 @@ ducet insert-helpers ] { } map-as concat ; : append-weights ( weights quot -- ) - swap [ ignorable?>> not ] filter - swap map [ zero? not ] filter % 0 , ; + [ [ ignorable?>> not ] filter ] dip + map [ zero? not ] filter % 0 , ; inline : variable-weight ( weight -- ) dup ignorable?>> [ primary>> ] [ drop HEX: FFFF ] if , ; @@ -135,7 +135,7 @@ PRIVATE> @@ -158,8 +158,7 @@ PRIVATE> PRIVATE> : sort-strings ( strings -- sorted ) - [ w/collation-key ] map - natural-sort values ; + [ w/collation-key ] map natural-sort values ; : string<=> ( str1 str2 -- <=> ) [ w/collation-key ] compare ; From a712fd3d0b4d6a0ebd52656ef8ea05976a3e6849 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sun, 5 Oct 2008 21:18:58 -0200 Subject: [PATCH 079/244] irc.client: Rename listeners to chats, rename some words, better handling of channel joins for chats attached before login, fixes, etc --- extra/irc/client/client-docs.factor | 75 ++++++------ extra/irc/client/client-tests.factor | 54 ++++----- extra/irc/client/client.factor | 167 ++++++++++++++------------- 3 files changed, 146 insertions(+), 150 deletions(-) diff --git a/extra/irc/client/client-docs.factor b/extra/irc/client/client-docs.factor index d150e6d36f..1b9204c4f1 100644 --- a/extra/irc/client/client-docs.factor +++ b/extra/irc/client/client-docs.factor @@ -3,11 +3,11 @@ IN: irc.client HELP: irc-client "IRC Client object" ; -HELP: irc-server-listener "Listener for server messages unmanaged by other listeners" ; +HELP: irc-server-chat "Chat for server messages unmanaged by other chats" ; -HELP: irc-channel-listener "Listener for irc channels" ; +HELP: irc-channel-chat "Chat for irc channels" ; -HELP: irc-nick-listener "Listener for irc users" ; +HELP: irc-nick-chat "Chat for irc users" ; HELP: irc-profile "IRC Client profile object" ; @@ -15,48 +15,43 @@ HELP: connect-irc "Connecting to an irc server" { $values { "irc-client" "an irc client object" } } { $description "Connects and logins " { $link irc-client } " using the settings specified on its " { $link irc-profile } "." } ; -HELP: add-listener "Listening to irc channels/users/etc" -{ $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } } -{ $description "Registers " { $snippet "irc-listener" } " with " { $snippet "irc-client" } " and starts listening." } ; +HELP: attach-chat "Chatting with irc channels/users/etc" +{ $values { "irc-chat" "an irc chat object" } { "irc-client" "an irc client object" } } +{ $description "Registers " { $snippet "irc-chat" } " with " { $snippet "irc-client" } " and starts listening." } ; -HELP: join-irc-channel "Joining channels" -{ $values { "irc-client-listener" "an irc client listener object" } } -{ $description "Joins to the channel being listened by " { $snippet "irc-listener" } "." } ; - -HELP: remove-listener "Stop an unregister listener" -{ $values { "irc-listener" "an irc listener object" } { "irc-client" "an irc client object" } } -{ $description "Unregisters " { $snippet "irc-listener" } " from " { $snippet "irc-client" } " and stops listening. This is how you part from a channel." } ; +HELP: dettach-chat "Stop an unregister chat" +{ $values { "irc-chat" "an irc chat object" } { "irc-client" "an irc client object" } } +{ $description "Unregisters " { $snippet "irc-chat" } " from " { $snippet "irc-client" } " and stops listening. This is how you part from a channel." } ; HELP: terminate-irc "Terminates an irc client" { $values { "irc-client" "an irc client object" } } -{ $description "Terminates all activity by " { $link irc-client } " cleaning up resources and notifying listeners." } ; +{ $description "Terminates all activity by " { $link irc-client } " cleaning up resources and notifying chats." } ; -HELP: write-message "Sends a message through a listener" -{ $values { "message" "a string or irc message object" } { "irc-listener" "an irc listener object" } } -{ $description "Sends " { $snippet "message" } " through " { $snippet "irc-listener" } ". Strings are automatically promoted to privmsg objects." } ; +HELP: speak "Sends a message through a chat" +{ $values { "message" "a string or irc message object" } { "irc-chat" "an irc chat object" } } +{ $description "Sends " { $snippet "message" } " through " { $snippet "irc-chat" } ". Strings are automatically promoted to privmsg objects." } ; -HELP: read-message "Reads a message from a listener" -{ $values { "irc-listener" "an irc listener object" } { "message" "an irc message object" } } -{ $description "Reads " { $snippet "message" } " from " { $snippet "irc-listener" } "." } ; +HELP: hear "Reads a message from a chat" +{ $values { "irc-chat" "an irc chat object" } { "message" "an irc message object" } } +{ $description "Reads " { $snippet "message" } " from " { $snippet "irc-chat" } "." } ; ARTICLE: "irc.client" "IRC Client" "An IRC Client library" { $heading "IRC objects:" } { $subsection irc-client } -{ $heading "Listener objects:" } -{ $subsection irc-server-listener } -{ $subsection irc-channel-listener } -{ $subsection irc-nick-listener } +{ $heading "Chat objects:" } +{ $subsection irc-server-chat } +{ $subsection irc-channel-chat } +{ $subsection irc-nick-chat } { $heading "Setup objects:" } { $subsection irc-profile } { $heading "Words:" } { $subsection connect-irc } { $subsection terminate-irc } -{ $subsection add-listener } -{ $subsection remove-listener } -{ $subsection join-irc-channel } -{ $subsection read-message } -{ $subsection write-message } +{ $subsection attach-chat } +{ $subsection dettach-chat } +{ $subsection hear } +{ $subsection speak } { $heading "IRC messages" } "Some of the RFC defined irc messages as objects:" { $table @@ -77,10 +72,10 @@ ARTICLE: "irc.client" "IRC Client" { $heading "Special messages" } "Some special messages that are created by the library and not by the irc server." { $table - { { $link irc-listener-end } "sent to a listener when it has been dettached from the client, the listener should stop after it receives this message. " } - { { $link irc-end } " sent when the client isn't running anymore, listeners should stop after it receives this message." } - { { $link irc-disconnected } " sent to notify listeners that connection was lost." } - { { $link irc-connected } " sent to notify listeners that a connection with the irc server was established." } } + { { $link irc-chat-end } "sent to a chat when it has been dettached from the client, the chat should stop after it receives this message. " } + { { $link irc-end } " sent when the client isn't running anymore, chats should stop after it receives this message." } + { { $link irc-disconnected } " sent to notify chats that connection was lost." } + { { $link irc-connected } " sent to notify chats that a connection with the irc server was established." } } { $heading "Example:" } { $code @@ -91,16 +86,14 @@ ARTICLE: "irc.client" "IRC Client" "\"irc.freenode.org\" irc-port \"mybot123\" f bot set" "! Connect to the server" "bot get connect-irc" - "! Create a channel listener" - "\"#mychannel123\" mychannel set" - "! Register and start listener (this joins the channel)" - "mychannel get bot get add-listener" - "! Join to the channel" - "mychannel get join-irc-channel" + "! Create a channel chat" + "\"#mychannel123\" mychannel set" + "! Register and start chat (this joins the channel)" + "mychannel get bot get attach-chat" "! Send a message to the channel" - "\"what's up?\" mychannel get write-message" + "\"what's up?\" mychannel get speak" "! Read a message from the channel" - "mychannel get read-message" + "mychannel get hear" } ; diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index acd5a783db..fe85d6c375 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -1,5 +1,5 @@ USING: kernel tools.test accessors arrays sequences qualified - io io.streams.duplex namespaces threads + io io.streams.duplex namespaces threads destructors calendar irc.client.private irc.client irc.messages.private concurrency.mailboxes classes assocs combinators ; EXCLUDE: irc.messages => join ; @@ -19,22 +19,23 @@ M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ; M: mb-writer stream-nl ( mb-writer -- ) [ [ last-line>> concat ] [ lines>> ] bi push ] keep V{ } clone >>last-line drop ; +M: mb-reader dispose drop ; +M: mb-writer dispose drop ; : spawn-client ( -- irc-client ) "someserver" irc-port "factorbot" f + t >>is-ready t >>is-running >>stream dup [ spawn-irc yield ] with-irc-client ; ! to be used inside with-irc-client quotations -: %add-named-listener ( listener -- ) irc> add-listener ; +: %add-named-chat ( chat -- ) irc> attach-chat ; : %push-line ( line -- ) irc> stream>> in>> push-line yield ; -: %join ( channel -- ) - - [ irc> add-listener ] [ join-irc-channel ] bi ; +: %join ( channel -- ) irc> attach-chat ; -: read-matching-message ( listener quot: ( msg -- ? ) -- irc-message ) +: read-matching-message ( chat quot: ( msg -- ? ) -- irc-message ) [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ; : with-irc ( quot: ( -- ) -- ) @@ -68,7 +69,8 @@ M: mb-writer stream-nl ( mb-writer -- ) { V{ "NICK factorbot" "USER factorbot hostname servername :irc.factor" } } [ "someserver" irc-port "factorbot" f [ 2drop t ] >>connect - [ connect-irc ] keep stream>> out>> lines>> + [ connect-irc ] keep + stream>> [ in>> [ f ] dip push-line ] [ out>> lines>> ] bi ] unit-test ! Test join @@ -79,7 +81,7 @@ M: mb-writer stream-nl ( mb-writer -- ) ] with-irc [ { join_ "#factortest" } [ - "#factortest" [ %add-named-listener ] keep + "#factortest" [ %add-named-chat ] keep { ":factorbot!n=factorbo@some.where JOIN :#factortest" ":ircserver.net 353 factorbot @ #factortest :@factorbot " ":ircserver.net 366 factorbot #factortest :End of /NAMES list." @@ -91,14 +93,14 @@ M: mb-writer stream-nl ( mb-writer -- ) ] with-irc [ { T{ participant-changed f "somebody" +join+ } } [ - "#factortest" [ %add-named-listener ] keep + "#factortest" [ %add-named-chat ] keep ":somebody!n=somebody@some.where JOIN :#factortest" %push-line [ participant-changed? ] read-matching-message ] unit-test ] with-irc [ { privmsg "#factortest" "hello" } [ - "#factortest" [ %add-named-listener ] keep + "#factortest" [ %add-named-chat ] keep ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line [ privmsg? ] read-matching-message [ class ] [ name>> ] [ trailing>> ] tri @@ -106,7 +108,7 @@ M: mb-writer stream-nl ( mb-writer -- ) ] with-irc [ { privmsg "factorbot" "hello" } [ - "ircuser" [ %add-named-listener ] keep + "ircuser" [ %add-named-chat ] keep ":ircuser!n=user@isp.net PRIVMSG factorbot :hello" %push-line [ privmsg? ] read-matching-message [ class ] [ name>> ] [ trailing>> ] tri @@ -114,7 +116,7 @@ M: mb-writer stream-nl ( mb-writer -- ) ] with-irc [ { mode } [ - "#factortest" [ %add-named-listener ] keep + "#factortest" [ %add-named-chat ] keep ":ircserver.net MODE #factortest +ns" %push-line [ mode? ] read-matching-message class ] unit-test @@ -122,46 +124,46 @@ M: mb-writer stream-nl ( mb-writer -- ) ! Participant lists tests [ { H{ { "ircuser" +normal+ } } } [ - "#factortest" [ %add-named-listener ] keep + "#factortest" [ %add-named-chat ] keep ":ircuser!n=user@isp.net JOIN :#factortest" %push-line participants>> ] unit-test ] with-irc [ { H{ { "ircuser2" +normal+ } } } [ - "#factortest" + "#factortest" H{ { "ircuser2" +normal+ } { "ircuser" +normal+ } } clone >>participants - [ %add-named-listener ] keep + [ %add-named-chat ] keep ":ircuser!n=user@isp.net PART #factortest" %push-line participants>> ] unit-test ] with-irc [ { H{ { "ircuser2" +normal+ } } } [ - "#factortest" + "#factortest" H{ { "ircuser2" +normal+ } { "ircuser" +normal+ } } clone >>participants - [ %add-named-listener ] keep + [ %add-named-chat ] keep ":ircuser!n=user@isp.net QUIT" %push-line participants>> ] unit-test ] with-irc [ { H{ { "ircuser2" +normal+ } } } [ - "#factortest" + "#factortest" H{ { "ircuser2" +normal+ } { "ircuser" +normal+ } } clone >>participants - [ %add-named-listener ] keep + [ %add-named-chat ] keep ":ircuser2!n=user2@isp.net KICK #factortest ircuser" %push-line participants>> ] unit-test ] with-irc [ { H{ { "ircuser2" +normal+ } } } [ - "#factortest" + "#factortest" H{ { "ircuser" +normal+ } } clone >>participants - [ %add-named-listener ] keep + [ %add-named-chat ] keep ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line participants>> ] unit-test @@ -169,7 +171,7 @@ M: mb-writer stream-nl ( mb-writer -- ) ! Namelist change notification [ { T{ participant-changed f f f f } } [ - "#factortest" [ %add-named-listener ] keep + "#factortest" [ %add-named-chat ] keep ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line [ participant-changed? ] read-matching-message @@ -177,18 +179,18 @@ M: mb-writer stream-nl ( mb-writer -- ) ] with-irc [ { T{ participant-changed f "ircuser" +part+ f } } [ - "#factortest" + "#factortest" H{ { "ircuser" +normal+ } } clone >>participants - [ %add-named-listener ] keep + [ %add-named-chat ] keep ":ircuser!n=user@isp.net QUIT" %push-line [ participant-changed? ] read-matching-message ] unit-test ] with-irc [ { T{ participant-changed f "ircuser" +nick+ "ircuser2" } } [ - "#factortest" + "#factortest" H{ { "ircuser" +normal+ } } clone >>participants - [ %add-named-listener ] keep + [ %add-named-chat ] keep ":ircuser!n=user2@isp.net NICK :ircuser2" %push-line [ participant-changed? ] read-matching-message ] unit-test diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 606a8206da..d40c7d400d 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -18,16 +18,16 @@ TUPLE: irc-profile server port nickname password ; C: irc-profile TUPLE: irc-client profile stream in-messages out-messages - listeners is-running nick connect reconnect-time ; + chats is-running nick connect reconnect-time is-ready ; : ( profile -- irc-client ) [ f H{ } clone f ] keep nickname>> - [ latin1 ] 15 seconds irc-client boa ; + [ latin1 ] 15 seconds f irc-client boa ; -TUPLE: irc-listener in-messages client ; -TUPLE: irc-server-listener < irc-listener ; -TUPLE: irc-channel-listener < irc-listener name password timeout participants ; -TUPLE: irc-nick-listener < irc-listener name ; -SYMBOL: +server-listener+ +TUPLE: irc-chat in-messages client ; +TUPLE: irc-server-chat < irc-chat ; +TUPLE: irc-channel-chat < irc-chat name password timeout participants ; +TUPLE: irc-nick-chat < irc-chat name ; +SYMBOL: +server-chat+ ! participant modes SYMBOL: +operator+ @@ -43,18 +43,16 @@ SYMBOL: +part+ SYMBOL: +mode+ SYMBOL: +nick+ -! listener objects -: ( -- irc-listener ) irc-listener boa ; +! chat objects +: ( -- irc-server-chat ) + f irc-server-chat boa ; -: ( -- irc-server-listener ) - f irc-server-listener boa ; - -: ( name -- irc-channel-listener ) +: ( name -- irc-channel-chat ) [ f ] dip f 60 seconds H{ } clone - irc-channel-listener boa ; + irc-channel-chat boa ; -: ( name -- irc-nick-listener ) - [ f ] dip irc-nick-listener boa ; +: ( name -- irc-nick-chat ) + [ f ] dip irc-nick-chat boa ; ! ====================================== ! Message objects @@ -63,15 +61,15 @@ SYMBOL: +nick+ TUPLE: participant-changed nick action parameter ; C: participant-changed -SINGLETON: irc-listener-end ! send to a listener to stop its execution +SINGLETON: irc-chat-end ! sent to a chat to stop its execution SINGLETON: irc-end ! sent when the client isn't running anymore SINGLETON: irc-disconnected ! sent when connection is lost SINGLETON: irc-connected ! sent when connection is established -SINGLETON: irc-ready ! sent after the client is logged in : terminate-irc ( irc-client -- ) [ is-running>> ] keep and [ f >>is-running + [ stream>> dispose ] keep [ in-messages>> ] [ out-messages>> ] bi 2array [ irc-end swap mailbox-put ] each ] when* ; @@ -85,66 +83,65 @@ SYMBOL: current-irc-client ! ====================================== : irc> ( -- irc-client ) current-irc-client get ; -: irc-stream> ( -- stream ) irc> stream>> ; -: irc-write ( s -- ) irc-stream> stream-write ; -: irc-print ( s -- ) irc-stream> [ stream-print ] keep stream-flush ; +: irc-write ( s -- ) irc> stream>> stream-write ; +: irc-print ( s -- ) irc> stream>> [ stream-print ] keep stream-flush ; : irc-send ( irc-message -- ) irc> out-messages>> mailbox-put ; -: listener> ( name -- listener/f ) irc> listeners>> at ; +: chat> ( name -- chat/f ) irc> chats>> at ; : channel-mode? ( mode -- ? ) name>> first "#&" member? ; : me? ( string -- ? ) irc> nick>> = ; -GENERIC: to-listener ( message obj -- ) +GENERIC: to-chat ( message obj -- ) -M: string to-listener - listener> [ +server-listener+ listener> ] unless* - [ to-listener ] [ drop ] if* ; +M: string to-chat + chat> [ +server-chat+ chat> ] unless* + [ to-chat ] [ drop ] if* ; -M: irc-listener to-listener in-messages>> mailbox-put ; +M: irc-chat to-chat in-messages>> mailbox-put ; -: unregister-listener ( name -- ) - irc> listeners>> - [ at [ irc-listener-end ] dip to-listener ] +: unregister-chat ( name -- ) + irc> chats>> + [ at [ irc-chat-end ] dip to-chat ] [ delete-at ] 2bi ; -: (remove-participant) ( nick listener -- ) +: (remove-participant) ( nick chat -- ) [ participants>> delete-at ] - [ [ +part+ f ] dip to-listener ] 2bi ; + [ [ +part+ f ] dip to-chat ] 2bi ; : remove-participant ( nick channel -- ) - listener> [ (remove-participant) ] [ drop ] if* ; + chat> [ (remove-participant) ] [ drop ] if* ; -: listeners-with-participant ( nick -- seq ) - irc> listeners>> values - [ [ irc-channel-listener? ] keep and [ participants>> key? ] [ drop f ] if* ] +: chats-with-participant ( nick -- seq ) + irc> chats>> values + [ [ irc-channel-chat? ] keep and [ participants>> key? ] [ drop f ] if* ] with filter ; -: to-listeners-with-participant ( message nickname -- ) - listeners-with-participant [ to-listener ] with each ; +: to-chats-with-participant ( message nickname -- ) + chats-with-participant [ to-chat ] with each ; : remove-participant-from-all ( nick -- ) - dup listeners-with-participant [ (remove-participant) ] with each ; + dup chats-with-participant [ (remove-participant) ] with each ; -: notify-rename ( newnick oldnick listener -- ) +: notify-rename ( newnick oldnick chat -- ) [ participant-changed new +nick+ >>action - [ (>>nick) ] [ (>>parameter) ] [ ] tri ] dip to-listener ; + [ (>>nick) ] [ (>>parameter) ] [ ] tri ] dip to-chat ; -: rename-participant ( newnick oldnick listener -- ) - [ participants>> [ delete-at* drop ] [ [ swap ] dip set-at ] bi ] +: rename-participant ( newnick oldnick chat -- ) + [ participants>> [ delete-at* drop ] [ swapd set-at ] bi ] [ notify-rename ] 3bi ; : rename-participant-in-all ( oldnick newnick -- ) - swap dup listeners-with-participant [ rename-participant ] with with each ; + swap dup chats-with-participant [ rename-participant ] with with each ; : add-participant ( mode nick channel -- ) - listener> + chat> [ participants>> set-at ] - [ [ +join+ f ] dip to-listener ] 2bi ; + [ [ +join+ f ] dip to-chat ] 2bi ; : change-participant-mode ( channel mode nick -- ) - rot listener> + rot chat> [ participants>> set-at ] - [ [ [ +mode+ ] dip ] dip to-listener ] 3bi ; ! FIXME + [ [ [ +mode+ ] dip ] dip to-chat ] 3bi ; ! FIXME DEFER: me? @@ -174,6 +171,10 @@ DEFER: me? ! Server message handling ! ====================================== +GENERIC: initialize-chat ( chat -- ) +M: irc-chat initialize-chat drop ; +M: irc-channel-chat initialize-chat [ name>> ] [ password>> ] bi /JOIN ; + GENERIC: forward-name ( irc-message -- name ) M: join forward-name trailing>> ; M: part forward-name channel>> ; @@ -187,32 +188,34 @@ UNION: broadcast-forward irc-end irc-disconnected irc-connected ; GENERIC: forward-message ( irc-message -- ) M: irc-message forward-message - +server-listener+ listener> [ to-listener ] [ drop ] if* ; + +server-chat+ chat> [ to-chat ] [ drop ] if* ; -M: single-forward forward-message dup forward-name to-listener ; +M: single-forward forward-message dup forward-name to-chat ; M: multiple-forward forward-message - dup irc-message-sender to-listeners-with-participant ; + dup irc-message-sender to-chats-with-participant ; M: broadcast-forward forward-message - irc> listeners>> values [ to-listener ] with each ; + irc> chats>> values [ to-chat ] with each ; GENERIC: process-message ( irc-message -- ) M: object process-message drop ; -M: logged-in process-message name>> irc> (>>nick) ; +M: logged-in process-message + name>> f irc> [ (>>is-ready) ] [ (>>nick) ] [ chats>> ] tri + values [ initialize-chat ] each ; M: ping process-message trailing>> /PONG ; M: nick-in-use process-message name>> "_" append /NICK ; M: join process-message [ drop +normal+ ] [ irc-message-sender ] [ trailing>> ] tri - dup listener> [ add-participant ] [ 3drop ] if ; + dup chat> [ add-participant ] [ 3drop ] if ; M: part process-message [ irc-message-sender ] [ channel>> ] bi remove-participant ; M: kick process-message [ [ who>> ] [ channel>> ] bi remove-participant ] - [ dup who>> me? [ unregister-listener ] [ drop ] if ] + [ dup who>> me? [ unregister-chat ] [ drop ] if ] bi ; M: quit process-message @@ -235,9 +238,9 @@ M: nick process-message [ >nick/mode 2array ] map >hashtable ; M: names-reply process-message - [ names-reply>participants ] [ channel>> listener> ] bi [ + [ names-reply>participants ] [ channel>> chat> ] bi [ [ (>>participants) ] - [ [ f f f ] dip name>> to-listener ] bi + [ [ f f f ] dip name>> to-chat ] bi ] [ drop ] if* ; ! ====================================== @@ -265,8 +268,8 @@ DEFER: (connect-irc) tri ; ! FIXME: do something with the exception, store somewhere to help debugging -: handle-disconnect ( error -- ) - drop irc> is-running>> [ (handle-disconnect) ] when ; +: handle-disconnect ( error -- ? ) + drop irc> is-running>> [ (handle-disconnect) t ] [ f ] if ; : (reader-loop) ( -- ? ) irc> stream>> [ @@ -278,7 +281,7 @@ DEFER: (connect-irc) ] with-destructors ; : reader-loop ( -- ? ) - [ (reader-loop) ] [ handle-disconnect t ] recover ; + [ (reader-loop) ] [ handle-disconnect ] recover ; : writer-loop ( -- ? ) irc> out-messages>> mailbox-get handle-outgoing-irc ; @@ -300,7 +303,7 @@ DEFER: (connect-irc) [ nip ] } cond ; -GENERIC: annotate-message ( listener object -- object ) +GENERIC: annotate-message ( chat object -- object ) M: object annotate-message nip ; M: part annotate-message swap name>> >>channel ; M: privmsg annotate-message swap name>> >>name ; @@ -312,25 +315,27 @@ M: string annotate-message [ name>> ] dip strings>privmsg ; [ in-multiplexer-loop ] "in-multiplexer-loop" spawn-server 3drop ; -GENERIC: (add-listener) ( irc-listener -- ) +GENERIC: (attach-chat) ( irc-chat -- ) +USE: prettyprint +M: irc-chat (attach-chat) + [ [ irc> >>client ] [ name>> ] bi irc> chats>> set-at ] + [ [ irc> is-ready>> ] dip and [ initialize-chat ] when* ] + bi ; -M: irc-listener (add-listener) - [ irc> >>client ] [ name>> ] bi irc> listeners>> set-at ; +M: irc-server-chat (attach-chat) + irc> >>client +server-chat+ irc> chats>> set-at ; -M: irc-server-listener (add-listener) - irc> >>client +server-listener+ irc> listeners>> set-at ; +GENERIC: (remove-chat) ( irc-chat -- ) -GENERIC: (remove-listener) ( irc-listener -- ) +M: irc-nick-chat (remove-chat) + name>> unregister-chat ; -M: irc-nick-listener (remove-listener) - name>> unregister-listener ; - -M: irc-channel-listener (remove-listener) +M: irc-channel-chat (remove-chat) [ part new annotate-message irc> out-messages>> mailbox-put ] keep - name>> unregister-listener ; + name>> unregister-chat ; -M: irc-server-listener (remove-listener) - drop +server-listener+ unregister-listener ; +M: irc-server-chat (remove-chat) + drop +server-chat+ unregister-chat ; : (connect-irc) ( irc-client -- ) { @@ -348,16 +353,12 @@ PRIVATE> : connect-irc ( irc-client -- ) dup [ [ (connect-irc) ] [ nick>> /LOGIN ] bi spawn-irc ] with-irc-client ; -: add-listener ( irc-listener irc-client -- ) - swap '[ _ (add-listener) ] with-irc-client ; +: attach-chat ( irc-chat irc-client -- ) [ (attach-chat) ] with-irc-client ; -: remove-listener ( irc-listener -- ) - [ client>> ] keep '[ _ (remove-listener) ] with-irc-client ; +: dettach-chat ( irc-chat -- ) + [ client>> ] keep '[ _ (remove-chat) ] with-irc-client ; -: join-irc-channel ( irc-channel-listener -- ) - dup client>> [ [ name>> ] [ password>> ] bi /JOIN ] with-irc-client ; - -: write-message ( message irc-listener -- ) +: speak ( message irc-chat -- ) [ swap annotate-message ] [ client>> out-messages>> mailbox-put ] bi ; -: read-message ( irc-listener -- message ) in-messages>> mailbox-get ; +: hear ( irc-chat -- message ) in-messages>> mailbox-get ; From 14dcf83993495b41e30c4a65aa42019af4d57ccc Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sun, 5 Oct 2008 21:33:53 -0200 Subject: [PATCH 080/244] irc.ui: Update to work with the latest irc.client changes --- extra/irc/ui/commands/commands.factor | 4 +-- extra/irc/ui/ui.factor | 44 ++++++++++++--------------- 2 files changed, 21 insertions(+), 27 deletions(-) diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor index 184a2b4de8..4bb77e7490 100755 --- a/extra/irc/ui/commands/commands.factor +++ b/extra/irc/ui/commands/commands.factor @@ -8,7 +8,7 @@ IN: irc.ui.commands : say ( string -- ) irc-tab get [ window>> client>> profile>> nickname>> print-irc ] - [ listener>> write-message ] 2bi ; + [ chat>> speak ] 2bi ; : join ( string -- ) irc-tab get window>> join-channel ; @@ -18,7 +18,7 @@ IN: irc.ui.commands : whois ( string -- ) "WHOIS" swap { } clone swap - irc-tab get listener>> write-message ; + irc-tab get listener>> speak ; : quote ( string -- ) drop ; ! THIS WILL CHANGE diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index c171fef0b6..50dc9378a2 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -15,7 +15,7 @@ RENAME: join sequences => sjoin IN: irc.ui -SYMBOL: listener +SYMBOL: chat SYMBOL: client @@ -24,7 +24,7 @@ TUPLE: ui-window < tabbed client ; M: ui-window ungraft* client>> terminate-irc ; -TUPLE: irc-tab < frame listener client window ; +TUPLE: irc-tab < frame chat client window ; : write-color ( str color -- ) foreground associate format ; @@ -117,7 +117,7 @@ M: irc-disconnected write-irc M: irc-connected write-irc drop "* Connected" dark-green write-color ; -M: irc-listener-end write-irc +M: irc-chat-end write-irc drop ; M: irc-message write-irc @@ -135,7 +135,7 @@ M: object time-happened drop now ; : send-message ( message -- ) [ print-irc ] - [ listener get write-message ] bi ; + [ chat get speak ] bi ; GENERIC: handle-inbox ( tab message -- ) @@ -150,7 +150,7 @@ M: object handle-inbox : display ( stream tab -- ) '[ _ [ [ t ] - [ _ dup listener>> read-message handle-inbox ] + [ _ dup chat>> hear handle-inbox ] [ ] while ] with-output-stream ] "ircv" spawn drop ; : ( tab -- tab pane ) @@ -175,33 +175,28 @@ irc-editor "general" f { { T{ key-down f f "ENTER" } editor-send } } define-command-map -: new-irc-tab ( listener ui-window class -- irc-tab ) +: new-irc-tab ( chat ui-window class -- irc-tab ) new-frame swap >>window - swap >>listener + swap >>chat [ @center grid-add ] keep @bottom grid-add ; -GENERIC: init-listener ( listener -- ) -M: object init-listener drop ; -M: irc-channel-listener init-listener join-irc-channel ; - M: irc-tab graft* - [ listener>> dup ] [ window>> client>> ] bi add-listener - init-listener ; + [ chat>> ] [ window>> client>> ] bi attach-chat ; M: irc-tab ungraft* - listener>> remove-listener ; + chat>> dettach-chat ; TUPLE: irc-channel-tab < irc-tab userlist ; -: ( listener ui-window -- irc-tab ) +: ( chat ui-window -- irc-tab ) irc-channel-tab new-irc-tab [ @right grid-add ] keep >>userlist ; : update-participants ( tab -- ) [ userlist>> [ clear-gadget ] keep ] - [ listener>> participants>> ] bi + [ chat>> participants>> ] bi [ +operator+ value-labels dark-green add-gadget-color ] [ +voice+ value-labels blue add-gadget-color ] [ +normal+ value-labels black add-gadget-color ] tri drop ; @@ -211,22 +206,22 @@ M: participant-changed handle-inbox TUPLE: irc-server-tab < irc-tab ; -: ( listener -- irc-tab ) +: ( chat -- irc-tab ) f irc-server-tab new-irc-tab ; -: ( listener ui-window -- irc-tab ) +: ( chat ui-window -- irc-tab ) irc-tab new-irc-tab ; M: irc-tab pref-dim* drop { 480 480 } ; : join-channel ( name ui-window -- ) - [ dup ] dip + [ dup ] dip [ swap ] keep add-page ; : query-nick ( nick ui-window -- ) - [ dup ] dip + [ dup ] dip [ swap ] keep add-page ; @@ -237,16 +232,15 @@ M: irc-tab pref-dim* : ui-connect ( profile -- ui-window ) - { [ [ ] dip add-listener ] - [ listeners>> +server-listener+ swap at dup + { [ [ ] dip attach-chat ] + [ chats>> +server-chat+ swap at dup "Server" associate ui-window new-tabbed [ swap (>>window) ] keep ] [ >>client ] [ connect-irc ] } cleave ; : server-open ( server port nick password channels -- ) - [ ui-connect [ irc-window ] keep ] dip 2drop ; -! FIXME: should join channels only after we have been logged in -! [ over join-channel ] each drop ; + [ ui-connect [ irc-window ] keep ] dip + [ over join-channel ] each drop ; : main-run ( -- ) run-ircui ; From a30dbec5fba4d68bd67c96bc450994c06564eb16 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 5 Oct 2008 18:36:56 -0500 Subject: [PATCH 081/244] remove dead code, add copyright --- basis/unicode/breaks/breaks.factor | 2 ++ basis/unicode/case/case.factor | 13 ++----------- basis/unicode/categories/categories.factor | 2 ++ basis/unicode/collation/collation.factor | 2 ++ basis/unicode/data/data.factor | 2 ++ basis/unicode/normalize/normalize.factor | 2 ++ basis/unicode/script/script.factor | 2 ++ basis/unicode/syntax/syntax.factor | 2 ++ 8 files changed, 16 insertions(+), 11 deletions(-) diff --git a/basis/unicode/breaks/breaks.factor b/basis/unicode/breaks/breaks.factor index 6aa3e60647..0f2e12119d 100644 --- a/basis/unicode/breaks/breaks.factor +++ b/basis/unicode/breaks/breaks.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: combinators.short-circuit unicode.categories kernel math combinators splitting sequences math.parser io.files io assocs arrays namespaces make math.ranges unicode.normalize values diff --git a/basis/unicode/case/case.factor b/basis/unicode/case/case.factor index 5e961e2d67..3def7b5f48 100644 --- a/basis/unicode/case/case.factor +++ b/basis/unicode/case/case.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: unicode.data sequences sequences.next namespaces make unicode.normalize math unicode.categories combinators assocs strings splitting kernel accessors ; @@ -70,17 +72,6 @@ SYMBOL: locale ! Just casing locale, or overall? : final-sigma ( string -- string ) HEX: 3A3 over member? [ sigma-map ] when ; -! : map-case ( string string-quot char-quot -- case ) -! [ -! rot [ -! -rot [ -! rot dup special-casing at -! [ -rot drop call % ] -! [ -rot nip call , ] ?if -! ] 2keep -! ] each 2drop -! ] "" make ; inline - : map-case ( string string-quot char-quot -- case ) [ [ diff --git a/basis/unicode/categories/categories.factor b/basis/unicode/categories/categories.factor index 4ba96fb9c4..0464e31b12 100644 --- a/basis/unicode/categories/categories.factor +++ b/basis/unicode/categories/categories.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: unicode.syntax ; IN: unicode.categories diff --git a/basis/unicode/collation/collation.factor b/basis/unicode/collation/collation.factor index 65786ede5d..7f445b8513 100644 --- a/basis/unicode/collation/collation.factor +++ b/basis/unicode/collation/collation.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: combinators.short-circuit sequences io.files io.encodings.ascii kernel values splitting accessors math.parser ascii io assocs strings math namespaces make sorting combinators diff --git a/basis/unicode/data/data.factor b/basis/unicode/data/data.factor index cd54b93f2a..31d0be799f 100644 --- a/basis/unicode/data/data.factor +++ b/basis/unicode/data/data.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: combinators.short-circuit assocs math kernel sequences io.files hashtables quotations splitting grouping arrays math.parser hash2 math.order byte-arrays words namespaces words diff --git a/basis/unicode/normalize/normalize.factor b/basis/unicode/normalize/normalize.factor index 53a38faed4..8d6f6e888a 100644 --- a/basis/unicode/normalize/normalize.factor +++ b/basis/unicode/normalize/normalize.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: sequences namespaces make unicode.data kernel math arrays locals sorting.insertion accessors ; IN: unicode.normalize diff --git a/basis/unicode/script/script.factor b/basis/unicode/script/script.factor index 103beb4d2a..9691797128 100644 --- a/basis/unicode/script/script.factor +++ b/basis/unicode/script/script.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: accessors values kernel sequences assocs io.files io.encodings ascii math.ranges io splitting math.parser namespaces make byte-arrays locals math sets io.encodings.ascii diff --git a/basis/unicode/syntax/syntax.factor b/basis/unicode/syntax/syntax.factor index 1ba76fd380..bf4610ab0d 100644 --- a/basis/unicode/syntax/syntax.factor +++ b/basis/unicode/syntax/syntax.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: unicode.data kernel math sequences parser lexer bit-arrays namespaces make sequences.private arrays quotations assocs classes.predicate math.order eval ; From 46c3f0def1ca86400df0ce7c82f2ed6ee8ef1a49 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 5 Oct 2008 20:31:48 -0500 Subject: [PATCH 082/244] Remove unused error class --- basis/random/random.factor | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/basis/random/random.factor b/basis/random/random.factor index 8a69b28171..b5f8ac48b8 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -51,13 +51,12 @@ M: sequence random ( seq -- elt ) [ length random-integer ] keep nth ] if-empty ; -ERROR: negative-random n ; M: integer random ( integer -- integer' ) - { - { [ dup 0 = ] [ ] } - { [ dup 0 < ] [ neg random-integer neg ] } - [ random-integer ] - } cond ; + dup sgn { + { 0 [ ] } + { -1 [ neg random-integer neg ] } + { 1 [ random-integer ] } + } case ; : delete-random ( seq -- elt ) [ length random-integer ] keep [ nth ] 2keep delete-nth ; From d5112a0ced6aebdde1cd76e388a1632cb352f1de Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 5 Oct 2008 21:30:29 -0500 Subject: [PATCH 083/244] Working on stack frame cleanup --- basis/compiler/generator/generator.factor | 7 +- .../cpu/ppc/architecture/architecture.factor | 27 ++--- basis/cpu/x86/32/32.factor | 106 ++++++++---------- basis/cpu/x86/64/64.factor | 32 +++--- .../cpu/x86/architecture/architecture.factor | 14 ++- 5 files changed, 88 insertions(+), 98 deletions(-) diff --git a/basis/compiler/generator/generator.factor b/basis/compiler/generator/generator.factor index 0a9885357e..2b398eaeea 100644 --- a/basis/compiler/generator/generator.factor +++ b/basis/compiler/generator/generator.factor @@ -296,16 +296,13 @@ M: #return-recursive generate-node : return-size ( ctype -- n ) #! Amount of space we reserve for a return value. - dup large-struct? [ heap-size ] [ drop 0 ] if ; + dup large-struct? [ heap-size ] [ drop 2 cells ] if ; : alien-stack-frame ( params -- n ) alien-parameters parameter-sizes drop ; : alien-invoke-frame ( params -- n ) - #! Two cells for temporary storage, temp@ and on x86.64, - #! small struct return value unpacking - [ return>> return-size ] [ alien-stack-frame ] bi - + 2 cells + ; + [ return>> return-size ] [ alien-stack-frame ] bi + ; : set-stack-frame ( n -- ) dup [ frame-required ] when* \ stack-frame set ; diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor index 80ee1802e1..aab104fa6e 100644 --- a/basis/cpu/ppc/architecture/architecture.factor +++ b/basis/cpu/ppc/architecture/architecture.factor @@ -44,7 +44,7 @@ IN: cpu.ppc.architecture : xt-save ( n -- i ) 2 cells - ; M: ppc stack-frame ( n -- i ) - local@ factor-area-size + 4 cells align ; + local@ factor-area-size + cell + 4 cells align ; M: temp-reg v>operand drop 11 ; @@ -166,11 +166,13 @@ M: float-regs %load-param-reg >r 1 rot local@ r> LF ; M: stack-params %load-param-reg ( stack reg reg-class -- ) drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ; +: next-param@ ( n -- x ) param@ stack-frame* + ; + M: stack-params %save-param-reg ( stack reg reg-class -- ) #! Funky. Read the parameter from the caller's stack frame. #! This word is used in callbacks drop - 0 1 rot param@ stack-frame* + LWZ + 0 1 rot next-param@ LWZ 0 1 rot local@ STW ; M: ppc %prepare-unbox ( -- ) @@ -197,10 +199,8 @@ M: ppc %unbox-long-long ( n func -- ) M: ppc %unbox-large-struct ( n c-type -- ) ! Value must be in r3 - ! Compute destination address - 4 1 roll local@ ADDI - ! Load struct size - heap-size 5 LI + ! Compute destination address and load struct size + [ 4 1 rot local@ ADDI ] [ heap-size 5 LI ] bi* ! Call the function "to_value_struct" f %alien-invoke ; @@ -218,9 +218,8 @@ M: ppc %box-long-long ( n func -- ) 4 1 rot cell + local@ LWZ ] when* r> f %alien-invoke ; -: temp@ ( m -- n ) stack-frame* factor-area-size - swap - ; - -: struct-return@ ( size n -- n ) [ local@ ] [ temp@ ] ?if ; +: struct-return@ ( size n -- n ) + [ local@ ] [ stack-frame* factor-area-size - swap - ] ?if ; M: ppc %prepare-box-struct ( size -- ) #! Compute target address for value struct return @@ -231,10 +230,8 @@ M: ppc %box-large-struct ( n c-type -- ) #! If n = f, then we're boxing a returned struct heap-size [ swap struct-return@ ] keep - ! Compute destination address - 3 1 roll ADDI - ! Load struct size - 4 LI + ! Compute destination address and load struct size + [ 3 1 rot ADDI ] [ 4 LI ] bi* ! Call the function "box_value_struct" f %alien-invoke ; @@ -256,10 +253,10 @@ M: ppc %alien-callback ( quot -- ) M: ppc %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke - 3 1 cell temp@ STW ; + 3 11 MR ; M: ppc %alien-indirect ( -- ) - 11 1 cell temp@ LWZ (%call) ; + (%call) ; M: ppc %callback-value ( ctype -- ) ! Save top of data stack diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 50d8025b38..1173b9e68e 100644 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -1,13 +1,12 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types arrays cpu.x86.assembler +USING: locals alien.c-types arrays cpu.x86.assembler cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot cpu.architecture kernel kernel.private math namespaces sequences -stack-checker.known-words -compiler.generator.registers compiler.generator.fixup -compiler.generator system layouts combinators -command-line compiler compiler.units io vocabs.loader accessors -init ; +stack-checker.known-words compiler.generator.registers +compiler.generator.fixup compiler.generator system layouts +combinators command-line compiler compiler.units io +vocabs.loader accessors init ; IN: cpu.x86.32 ! We implement the FFI for Linux, OS X and Windows all at once. @@ -18,7 +17,6 @@ IN: cpu.x86.32 M: x86.32 ds-reg ESI ; M: x86.32 rs-reg EDI ; M: x86.32 stack-reg ESP ; -M: x86.32 stack-save-reg EDX ; M: x86.32 temp-reg-1 EAX ; M: x86.32 temp-reg-2 ECX ; @@ -32,15 +30,20 @@ M: x86.32 struct-small-enough? ( size -- ? ) heap-size { 1 2 4 8 } member? os { linux netbsd solaris } member? not and ; +: struct-return@ ( size n -- operand ) + [ next-stack@ ] [ \ stack-frame get swap - stack@ ] ?if ; + ! On x86, parameters are never passed in registers. M: int-regs return-reg drop EAX ; M: int-regs param-regs drop { } ; M: int-regs vregs drop { EAX ECX EDX EBP } ; M: int-regs push-return-reg return-reg PUSH ; -: load/store-int-return ( n reg-class -- src dst ) - return-reg stack-reg rot [+] ; -M: int-regs load-return-reg load/store-int-return MOV ; -M: int-regs store-return-reg load/store-int-return swap MOV ; + +M: int-regs load-return-reg + return-reg swap next-stack@ MOV ; + +M: int-regs store-return-reg + [ stack@ ] [ return-reg ] bi* MOV ; M: float-regs param-regs drop { } ; M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ; @@ -48,14 +51,16 @@ M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ; : FSTP ( operand size -- ) 4 = [ FSTPS ] [ FSTPL ] if ; M: float-regs push-return-reg - stack-reg swap reg-size [ SUB stack-reg [] ] keep FSTP ; + stack-reg swap reg-size + [ SUB ] [ [ [] ] dip FSTP ] 2bi ; : FLD ( operand size -- ) 4 = [ FLDS ] [ FLDL ] if ; -: load/store-float-return ( n reg-class -- op size ) - [ stack@ ] [ reg-size ] bi* ; -M: float-regs load-return-reg load/store-float-return FLD ; -M: float-regs store-return-reg load/store-float-return FSTP ; +M: float-regs load-return-reg + [ next-stack@ ] [ reg-size ] bi* FLD ; + +M: float-regs store-return-reg + [ stack@ ] [ reg-size ] bi* FSTP ; : align-sub ( n -- ) dup 16 align swap - ESP swap SUB ; @@ -64,7 +69,8 @@ M: float-regs store-return-reg load/store-float-return FSTP ; 16 align ESP swap ADD ; : with-aligned-stack ( n quot -- ) - swap dup align-sub slip align-add ; inline + [ [ align-sub ] [ call ] bi* ] + [ [ align-add ] [ drop ] bi* ] 2bi ; inline M: x86.32 fixnum>slot@ 1 SHR ; @@ -77,57 +83,40 @@ M: object %load-param-reg 3drop ; M: object %save-param-reg 3drop ; -: box@ ( n reg-class -- stack@ ) - #! Used for callbacks; we want to box the values given to - #! us by the C function caller. Computes stack location of - #! nth parameter; note that we must go back one more stack - #! frame, since %box sets one up to call the one-arg boxer - #! function. The size of this stack frame so far depends on - #! the reg-class of the boxer's arg. - reg-size neg + stack-frame* + 20 + ; - : (%box) ( n reg-class -- ) #! If n is f, push the return register onto the stack; we #! are boxing a return value of a C function. If n is an #! integer, push [ESP+n] on the stack; we are boxing a #! parameter being passed to a callback from C. - over [ [ box@ ] keep [ load-return-reg ] keep ] [ nip ] if - push-return-reg ; + over [ load-return-reg ] [ 2drop ] if ; -M: x86.32 %box ( n reg-class func -- ) - over reg-size [ - >r (%box) r> f %alien-invoke +M:: x86.32 %box ( n reg-class func -- ) + n reg-class (%box) + reg-class reg-size [ + reg-class push-return-reg + func f %alien-invoke ] with-aligned-stack ; : (%box-long-long) ( n -- ) - #! If n is f, push the return registers onto the stack; we - #! are boxing a return value of a C function. If n is an - #! integer, push [ESP+n]:[ESP+n+4] on the stack; we are - #! boxing a parameter being passed to a callback from C. [ - int-regs box@ - EDX over stack@ MOV - EAX swap cell - stack@ MOV - ] when* - EDX PUSH - EAX PUSH ; + EDX over next-stack@ MOV + EAX swap cell - next-stack@ MOV + ] when* ; M: x86.32 %box-long-long ( n func -- ) + [ (%box-long-long) ] dip 8 [ - [ (%box-long-long) ] [ f %alien-invoke ] bi* + EDX PUSH + EAX PUSH + f %alien-invoke ] with-aligned-stack ; -: struct-return@ ( size n -- n ) - [ stack-frame* cell + + ] [ \ stack-frame get swap - ] ?if ; - -M: x86.32 %box-large-struct ( n c-type -- ) +M:: x86.32 %box-large-struct ( n c-type -- ) ! Compute destination address - heap-size - [ swap struct-return@ ] keep - ECX ESP roll [+] LEA + ECX c-type heap-size n struct-return@ LEA 8 [ ! Push struct size - PUSH + c-type heap-size PUSH ! Push destination address ECX PUSH ! Copy the struct from the C stack @@ -136,9 +125,9 @@ M: x86.32 %box-large-struct ( n c-type -- ) M: x86.32 %prepare-box-struct ( size -- ) ! Compute target address for value struct return - EAX ESP rot f struct-return@ [+] LEA + EAX swap f struct-return@ LEA ! Store it as the first parameter - ESP [] EAX MOV ; + 0 stack@ EAX MOV ; M: x86.32 %box-small-struct ( c-type -- ) #! Box a <= 8-byte struct returned in EAX:EDX. OS X only. @@ -207,13 +196,12 @@ M: x86 %unbox-small-struct ( size -- ) } case ; M: x86.32 %unbox-large-struct ( n c-type -- ) - #! Alien must be in EAX. - heap-size + ! Alien must be in EAX. ! Compute destination address - ECX ESP roll [+] LEA + ECX rot stack@ LEA 12 [ ! Push struct size - PUSH + heap-size PUSH ! Push destination address ECX PUSH ! Push source address @@ -224,10 +212,10 @@ M: x86.32 %unbox-large-struct ( n c-type -- ) M: x86.32 %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke - cell temp@ EAX MOV ; + EBP EAX MOV ; M: x86.32 %alien-indirect ( -- ) - cell temp@ CALL ; + EBP CALL ; M: x86.32 %alien-callback ( quot -- ) 4 [ @@ -239,7 +227,7 @@ M: x86.32 %alien-callback ( quot -- ) M: x86.32 %callback-value ( ctype -- ) ! Align C stack ESP 12 SUB - ! Save top of data stack + ! Save top of data stack in non-volatile register %prepare-unbox EAX PUSH ! Restore data/call/retain stacks diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 01b8935e39..8c9762630b 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -12,7 +12,6 @@ IN: cpu.x86.64 M: x86.64 ds-reg R14 ; M: x86.64 rs-reg R15 ; M: x86.64 stack-reg RSP ; -M: x86.64 stack-save-reg RSI ; M: x86.64 temp-reg-1 RAX ; M: x86.64 temp-reg-2 RCX ; @@ -46,7 +45,9 @@ M: stack-params %load-param-reg r> stack@ R11 MOV ; M: stack-params %save-param-reg - >r stack-frame* + cell + swap r> %load-param-reg ; + drop + R11 swap next-stack@ MOV + stack@ R11 MOV ; : with-return-regs ( quot -- ) [ @@ -121,7 +122,7 @@ M: x86.64 %unbox-large-struct ( n c-type -- ) ! Source is in RDI heap-size ! Load destination address - RSI RSP roll [+] LEA + RSI rot stack@ LEA ! Load structure size RDX swap MOV ! Copy the struct to the C stack @@ -145,7 +146,7 @@ M: x86.64 %box-long-long ( n func -- ) M: x86.64 struct-small-enough? ( size -- ? ) heap-size 2 cells <= ; -: box-struct-field@ ( i -- operand ) RSP swap 1+ cells [+] ; +: box-struct-field@ ( i -- operand ) 1+ cells stack@ ; : %box-struct-field ( c-type i -- ) box-struct-field@ swap reg-class>> { @@ -164,21 +165,22 @@ M: x86.64 %box-small-struct ( c-type -- ) ] with-return-regs ; : struct-return@ ( size n -- n ) - [ ] [ \ stack-frame get swap - ] ?if ; + [ ] [ \ stack-frame get swap - ] ?if stack@ ; M: x86.64 %box-large-struct ( n c-type -- ) ! Struct size is parameter 2 heap-size RSI over MOV ! Compute destination address - swap struct-return@ RDI RSP rot [+] LEA + RDI spin struct-return@ LEA ! Copy the struct from the C stack "box_value_struct" f %alien-invoke ; M: x86.64 %prepare-box-struct ( size -- ) - ! Compute target address for value struct return - RAX RSP rot f struct-return@ [+] LEA - RSP 0 [+] RAX MOV ; + ! Compute target address for value struct return, store it + ! as the first parameter + RAX swap f struct-return@ LEA + 0 stack@ RAX MOV ; M: x86.64 %prepare-var-args RAX RAX XOR ; @@ -192,10 +194,10 @@ M: x86.64 %alien-invoke M: x86.64 %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke - cell temp@ RAX MOV ; + RBP RAX MOV ; M: x86.64 %alien-indirect ( -- ) - cell temp@ CALL ; + RBP CALL ; M: x86.64 %alien-callback ( quot -- ) RDI load-indirect "c_to_factor" f %alien-invoke ; @@ -203,12 +205,14 @@ M: x86.64 %alien-callback ( quot -- ) M: x86.64 %callback-value ( ctype -- ) ! Save top of data stack %prepare-unbox - ! Put former top of data stack in RDI - cell temp@ RDI MOV + ! Save top of data stack + RSP 8 SUB + RDI PUSH ! Restore data/call/retain stacks "unnest_stacks" f %alien-invoke ! Put former top of data stack in RDI - RDI cell temp@ MOV + RDI POP + RSP 8 ADD ! Unbox former top of data stack to return registers unbox-return ; diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index c97552a649..4770400434 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -10,10 +10,16 @@ IN: cpu.x86.architecture HOOK: ds-reg cpu ( -- reg ) HOOK: rs-reg cpu ( -- reg ) HOOK: stack-reg cpu ( -- reg ) -HOOK: stack-save-reg cpu ( -- reg ) : stack@ ( n -- op ) stack-reg swap [+] ; +: next-stack@ ( n -- operand ) + #! nth parameter from the next stack frame. Used to box + #! input values to callbacks; the callback has its own + #! stack frame set up, and we want to read the frame + #! set up by the caller. + stack-frame* + cell + stack@ ; + : reg-stack ( n reg -- op ) swap cells neg [+] ; M: ds-loc v>operand n>> ds-reg reg-stack ; @@ -32,8 +38,8 @@ M: float-regs %save-param-reg >r >r stack@ r> r> MOVSS/D ; M: float-regs %load-param-reg >r swap stack@ r> MOVSS/D ; GENERIC: push-return-reg ( reg-class -- ) -GENERIC: load-return-reg ( stack@ reg-class -- ) -GENERIC: store-return-reg ( stack@ reg-class -- ) +GENERIC: load-return-reg ( n reg-class -- ) +GENERIC: store-return-reg ( n reg-class -- ) ! Only used by inline allocation HOOK: temp-reg-1 cpu ( -- reg ) @@ -137,8 +143,6 @@ M: x86 small-enough? ( n -- ? ) : %tag-fixnum ( reg -- ) tag-bits get SHL ; -: temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ; - M: x86 %return ( -- ) 0 %unwind ; ! Alien intrinsics From cf135e08b382e63c43f44905492ccc1598457556 Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Sun, 5 Oct 2008 22:00:35 -0500 Subject: [PATCH 084/244] Tweak deploy descriptor to speed up tools.deploy test --- basis/tools/deploy/test/6/deploy.factor | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/tools/deploy/test/6/deploy.factor b/basis/tools/deploy/test/6/deploy.factor index 410bb770be..e7d3764d39 100644 --- a/basis/tools/deploy/test/6/deploy.factor +++ b/basis/tools/deploy/test/6/deploy.factor @@ -1,15 +1,15 @@ USING: tools.deploy.config ; H{ - { deploy-threads? f } - { deploy-ui? f } - { deploy-io 1 } - { deploy-c-types? f } - { deploy-name "tools.deploy.test.6" } - { deploy-compiler? t } { deploy-reflection 1 } { deploy-word-props? f } + { deploy-io 1 } + { deploy-name "tools.deploy.test.6" } + { deploy-math? t } + { deploy-random? f } + { deploy-compiler? t } + { deploy-ui? f } + { deploy-c-types? f } { deploy-word-defs? f } { "stop-after-last-window?" t } - { deploy-random? f } - { deploy-math? f } + { deploy-threads? f } } From 66ae62638d74f983d923ba08daef139b64be838c Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Sun, 5 Oct 2008 22:00:52 -0500 Subject: [PATCH 085/244] Fix Windows deployment --- basis/tools/deploy/shaker/shaker.factor | 2 +- basis/tools/deploy/windows/windows.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) mode change 100644 => 100755 basis/tools/deploy/shaker/shaker.factor mode change 100644 => 100755 basis/tools/deploy/windows/windows.factor diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor old mode 100644 new mode 100755 index 7c02e87209..d9348bedd5 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -321,7 +321,7 @@ IN: tools.deploy.shaker ] [ drop ] if ; : strip-c-io ( -- ) - deploy-io get 2 = [ + deploy-io get 2 = os windows? or [ [ c-io-backend forget "io.streams.c" forget-vocab diff --git a/basis/tools/deploy/windows/windows.factor b/basis/tools/deploy/windows/windows.factor old mode 100644 new mode 100755 index ce4fee19d7..ad1b3cbd84 --- a/basis/tools/deploy/windows/windows.factor +++ b/basis/tools/deploy/windows/windows.factor @@ -14,7 +14,7 @@ IN: tools.deploy.windows "resource:freetype6.dll" "resource:zlib1.dll" } swap copy-files-into - ] when ; + ] [ drop ] if ; : create-exe-dir ( vocab bundle-name -- vm ) deploy-ui? get [ From 0cfedcdc8d788064abc544eeea946b41cc8b4fde Mon Sep 17 00:00:00 2001 From: "U-SLAVA-DFB8FF805\\Slava" Date: Sun, 5 Oct 2008 22:08:13 -0500 Subject: [PATCH 086/244] Fix deploy size regresson --- basis/random/random-docs.factor | 22 +++++++++++----------- basis/random/random.factor | 15 +++------------ 2 files changed, 14 insertions(+), 23 deletions(-) mode change 100644 => 100755 basis/random/random-docs.factor mode change 100644 => 100755 basis/random/random.factor diff --git a/basis/random/random-docs.factor b/basis/random/random-docs.factor old mode 100644 new mode 100755 index 51656a77dd..18c9ca781c --- a/basis/random/random-docs.factor +++ b/basis/random/random-docs.factor @@ -15,21 +15,18 @@ HELP: random-bytes* { $description "Generates a byte-array of random bytes." } ; HELP: random -{ $values { "obj" object } { "elt" "a random element" } } -{ $description "Outputs a random element of the input object. If the object is an integer, an input of zero always returns a zero, while any other integer integers yield a random integer in the interval between itself and zero, inclusive of zero. On a sequence, an empty sequence always outputs " { $link f } "." } +{ $values { "seq" sequence } { "elt" "a random element" } } +{ $description "Outputs a random element of the input sequence. Outputs " { $link f } " if the sequence is empty." } +{ $notes "Since integers are sequences, passing an integer " { $snippet "n" } " outputs an integer in the interval " { $snippet "[0,n)" } "." } { $examples { $unchecked-example "USING: random prettyprint ;" "10 random ." "3" } - { $example "USING: random prettyprint ;" - "0 random ." - "0" } { $unchecked-example "USING: random prettyprint ;" - "-10 random ." - "-8" } - { $unchecked-example "USING: random prettyprint ;" - "{ \"a\" \"b\" \"c\" } random ." - "\"a\"" } + "SYMBOL: heads" + "SYMBOL: tails" + "{ heads tails } random ." + "heads" } } ; HELP: random-bytes @@ -74,7 +71,10 @@ ARTICLE: "random-protocol" "Random protocol" { $subsection seed-random } ; ARTICLE: "random" "Generating random integers" -"The " { $vocab-link "random" } " vocabulary contains a protocol for generating random or pseudorandom numbers. The ``Mersenne Twister'' pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "." +"The " { $vocab-link "random" } " vocabulary contains a protocol for generating random or pseudorandom numbers." +$nl +"The ``Mersenne Twister'' pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "." +$nl "Generate a random object:" { $subsection random } "Combinators to change the random number generator:" diff --git a/basis/random/random.factor b/basis/random/random.factor old mode 100644 new mode 100755 index b5f8ac48b8..845f8e004f --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -33,10 +33,6 @@ M: f random-32* ( obj -- * ) no-random-number-generator ; random-generator get random-bytes* ] keep head ; -GENERIC: random ( obj -- elt ) - -: random-bits ( n -- r ) 2^ random ; - -M: sequence random ( seq -- elt ) +: random-bits ( n -- r ) 2^ random-integer ; + +: random ( seq -- elt ) [ f ] [ [ length random-integer ] keep nth ] if-empty ; -M: integer random ( integer -- integer' ) - dup sgn { - { 0 [ ] } - { -1 [ neg random-integer neg ] } - { 1 [ random-integer ] } - } case ; - : delete-random ( seq -- elt ) [ length random-integer ] keep [ nth ] 2keep delete-nth ; From a5fcb006fbd58d8d0dba442a70495cc33efcc1b4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 5 Oct 2008 22:17:56 -0500 Subject: [PATCH 087/244] Clean up x86 stack frame code a bit more --- basis/cpu/x86/architecture/architecture.factor | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index 4770400434..ea54ef85af 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -18,7 +18,7 @@ HOOK: stack-reg cpu ( -- reg ) #! input values to callbacks; the callback has its own #! stack frame set up, and we want to read the frame #! set up by the caller. - stack-frame* + cell + stack@ ; + stack-frame* + stack@ ; : reg-stack ( n reg -- op ) swap cells neg [+] ; @@ -52,20 +52,18 @@ HOOK: prepare-division cpu ( -- ) M: immediate load-literal v>operand swap v>operand MOV ; M: x86 stack-frame ( n -- i ) - 3 cells + 16 align cell - ; + 3 cells + 16 align ; M: x86 %save-word-xt ( -- ) temp-reg v>operand 0 MOV rc-absolute-cell rel-this ; -: factor-area-size ( -- n ) 4 cells ; - M: x86 %prologue ( n -- ) - dup cell + PUSH + dup PUSH temp-reg v>operand PUSH - stack-reg swap 2 cells - SUB ; + stack-reg swap 3 cells - SUB ; M: x86 %epilogue ( n -- ) - stack-reg swap ADD ; + stack-reg swap cell - ADD ; HOOK: %alien-global cpu ( symbol dll register -- ) From b0d57ead863995421f0a259294e3c53e5deed5ad Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 5 Oct 2008 23:09:10 -0500 Subject: [PATCH 088/244] Fix unit test --- basis/random/random-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/random/random-tests.factor b/basis/random/random-tests.factor index c6d88c5525..e686dd7301 100644 --- a/basis/random/random-tests.factor +++ b/basis/random/random-tests.factor @@ -16,4 +16,4 @@ IN: random.tests [ t ] [ 1000 [ 400 random ] replicate prune length 256 > ] unit-test -[ 0 ] [ 0 random ] unit-test +[ f ] [ 0 random ] unit-test From 33d775890cfe24d95fc295cfe6da4399b36c25fd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Oct 2008 00:20:00 -0500 Subject: [PATCH 089/244] More stack frame refactoring --- basis/compiler/generator/fixup/fixup.factor | 6 ++-- basis/compiler/generator/generator.factor | 31 +++++++++---------- basis/cpu/architecture/architecture.factor | 13 ++++---- .../cpu/ppc/architecture/architecture.factor | 20 ++++++------ basis/cpu/x86/32/32.factor | 16 +++++----- basis/cpu/x86/64/64.factor | 17 +++++----- .../cpu/x86/architecture/architecture.factor | 20 ++++++++---- 7 files changed, 63 insertions(+), 60 deletions(-) diff --git a/basis/compiler/generator/fixup/fixup.factor b/basis/compiler/generator/fixup/fixup.factor index ecc88a7a5e..e8bdc561b7 100644 --- a/basis/compiler/generator/fixup/fixup.factor +++ b/basis/compiler/generator/fixup/fixup.factor @@ -13,7 +13,7 @@ TUPLE: frame-required n ; : frame-required ( n -- ) \ frame-required boa , ; -: stack-frame-size ( code -- n ) +: compute-stack-frame-size ( code -- n ) no-stack-frame [ dup frame-required? [ n>> max ] [ drop ] if ] reduce ; @@ -37,7 +37,7 @@ M: label fixup* : if-stack-frame ( frame-size quot -- ) swap dup no-stack-frame = - [ 2drop ] [ stack-frame swap call ] if ; inline + [ 2drop ] [ stack-frame-size swap call ] if ; inline M: word fixup* { @@ -146,7 +146,7 @@ SYMBOL: literal-table : fixup ( code -- literals relocation labels code ) [ init-fixup - dup stack-frame-size swap [ fixup* ] each drop + dup compute-stack-frame-size swap [ fixup* ] each drop literal-table get >array relocation-table get >byte-array diff --git a/basis/compiler/generator/generator.factor b/basis/compiler/generator/generator.factor index 2b398eaeea..22de9d3587 100644 --- a/basis/compiler/generator/generator.factor +++ b/basis/compiler/generator/generator.factor @@ -299,18 +299,17 @@ M: #return-recursive generate-node dup large-struct? [ heap-size ] [ drop 2 cells ] if ; : alien-stack-frame ( params -- n ) - alien-parameters parameter-sizes drop ; + stack-frame new + swap + [ return>> return-size >>return ] + [ alien-parameters parameter-sizes drop >>params ] bi + dup [ params>> ] [ return>> ] bi + >>size + dup size>> stack-frame-size >>total-size ; -: alien-invoke-frame ( params -- n ) - [ return>> return-size ] [ alien-stack-frame ] bi + ; - -: set-stack-frame ( n -- ) - dup [ frame-required ] when* \ stack-frame set ; - -: with-stack-frame ( n quot -- ) - swap set-stack-frame +: with-stack-frame ( params quot -- ) + swap alien-stack-frame [ size>> frame-required ] [ stack-frame set ] bi call - f set-stack-frame ; inline + stack-frame off ; inline GENERIC: reg-size ( register-class -- n ) @@ -413,8 +412,8 @@ M: long-long-type flatten-value-type ( type -- types ) #! parameters. If the C function is returning a structure, #! the first parameter is an implicit target area pointer, #! so we need to use a different offset. - return>> dup large-struct? - [ heap-size %prepare-box-struct cell ] [ drop 0 ] if ; + return>> large-struct? + [ %prepare-box-struct cell ] [ 0 ] if ; : objects>registers ( params -- ) #! Generate code for unboxing a list of C types, then @@ -473,7 +472,7 @@ M: no-such-symbol compiler-error-type M: #alien-invoke generate-node params>> - dup alien-invoke-frame [ + dup [ end-basic-block %prepare-alien-invoke dup objects>registers @@ -487,7 +486,7 @@ M: #alien-invoke generate-node ! #alien-indirect M: #alien-indirect generate-node params>> - dup alien-invoke-frame [ + dup [ ! Flush registers end-basic-block ! Save registers for GC @@ -553,7 +552,7 @@ TUPLE: callback-context ; : callback-unwind ( params -- n ) { - { [ dup abi>> "stdcall" = ] [ alien-stack-frame ] } + { [ dup abi>> "stdcall" = ] [ drop stack-frame get params>> ] } { [ dup return>> large-struct? ] [ drop 4 ] } [ drop 0 ] } cond ; @@ -569,7 +568,7 @@ TUPLE: callback-context ; dup xt>> dup [ init-templates %prologue-later - dup alien-stack-frame [ + dup [ [ registers>objects ] [ wrap-callback-quot %alien-callback ] [ %callback-return ] diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 63c52d1025..f22d4a2a90 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays generic kernel kernel.private math memory -namespaces make sequences layouts system hashtables classes -alien byte-arrays combinators words sets ; +USING: accessors arrays generic kernel kernel.private math +memory namespaces make sequences layouts system hashtables +classes alien byte-arrays combinators words sets ; IN: cpu.architecture ! Register classes @@ -33,10 +33,9 @@ GENERIC# load-literal 1 ( obj vreg -- ) HOOK: load-indirect cpu ( obj reg -- ) -HOOK: stack-frame cpu ( frame-size -- n ) +HOOK: stack-frame-size cpu ( frame-size -- n ) -: stack-frame* ( -- n ) - \ stack-frame get stack-frame ; +TUPLE: stack-frame total-size size params return ; ! Set up caller stack frame HOOK: %prologue cpu ( n -- ) @@ -117,7 +116,7 @@ HOOK: %box cpu ( n reg-class func -- ) HOOK: %box-long-long cpu ( n func -- ) -HOOK: %prepare-box-struct cpu ( size -- ) +HOOK: %prepare-box-struct cpu ( -- ) HOOK: %box-small-struct cpu ( c-type -- ) diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor index aab104fa6e..357349193e 100644 --- a/basis/cpu/ppc/architecture/architecture.factor +++ b/basis/cpu/ppc/architecture/architecture.factor @@ -43,8 +43,8 @@ IN: cpu.ppc.architecture : xt-save ( n -- i ) 2 cells - ; -M: ppc stack-frame ( n -- i ) - local@ factor-area-size + cell + 4 cells align ; +M: ppc stack-frame-size ( n -- i ) + local@ factor-area-size + 4 cells align ; M: temp-reg v>operand drop 11 ; @@ -166,7 +166,7 @@ M: float-regs %load-param-reg >r 1 rot local@ r> LF ; M: stack-params %load-param-reg ( stack reg reg-class -- ) drop >r 0 1 rot local@ LWZ 0 1 r> param@ STW ; -: next-param@ ( n -- x ) param@ stack-frame* + ; +: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ; M: stack-params %save-param-reg ( stack reg reg-class -- ) #! Funky. Read the parameter from the caller's stack frame. @@ -218,20 +218,18 @@ M: ppc %box-long-long ( n func -- ) 4 1 rot cell + local@ LWZ ] when* r> f %alien-invoke ; -: struct-return@ ( size n -- n ) - [ local@ ] [ stack-frame* factor-area-size - swap - ] ?if ; +: struct-return@ ( n -- n ) + [ stack-frame get params>> ] unless* local@ ; -M: ppc %prepare-box-struct ( size -- ) +M: ppc %prepare-box-struct ( -- ) #! Compute target address for value struct return - 3 1 rot f struct-return@ ADDI + 3 1 f struct-return@ ADDI 3 1 0 local@ STW ; M: ppc %box-large-struct ( n c-type -- ) - #! If n = f, then we're boxing a returned struct - heap-size - [ swap struct-return@ ] keep + ! If n = f, then we're boxing a returned struct ! Compute destination address and load struct size - [ 3 1 rot ADDI ] [ 4 LI ] bi* + [ 3 1 rot struct-return@ ADDI ] [ heap-size 4 LI ] bi* ! Call the function "box_value_struct" f %alien-invoke ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 1173b9e68e..dc891a8178 100644 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -30,8 +30,8 @@ M: x86.32 struct-small-enough? ( size -- ? ) heap-size { 1 2 4 8 } member? os { linux netbsd solaris } member? not and ; -: struct-return@ ( size n -- operand ) - [ next-stack@ ] [ \ stack-frame get swap - stack@ ] ?if ; +: struct-return@ ( n -- operand ) + [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ; ! On x86, parameters are never passed in registers. M: int-regs return-reg drop EAX ; @@ -63,10 +63,10 @@ M: float-regs store-return-reg [ stack@ ] [ reg-size ] bi* FSTP ; : align-sub ( n -- ) - dup 16 align swap - ESP swap SUB ; + [ align-stack ] keep - decr-stack-reg ; : align-add ( n -- ) - 16 align ESP swap ADD ; + align-stack incr-stack-reg ; : with-aligned-stack ( n quot -- ) [ [ align-sub ] [ call ] bi* ] @@ -113,7 +113,7 @@ M: x86.32 %box-long-long ( n func -- ) M:: x86.32 %box-large-struct ( n c-type -- ) ! Compute destination address - ECX c-type heap-size n struct-return@ LEA + ECX n struct-return@ LEA 8 [ ! Push struct size c-type heap-size PUSH @@ -123,9 +123,9 @@ M:: x86.32 %box-large-struct ( n c-type -- ) "box_value_struct" f %alien-invoke ] with-aligned-stack ; -M: x86.32 %prepare-box-struct ( size -- ) +M: x86.32 %prepare-box-struct ( -- ) ! Compute target address for value struct return - EAX swap f struct-return@ LEA + EAX f struct-return@ LEA ! Store it as the first parameter 0 stack@ EAX MOV ; @@ -248,7 +248,7 @@ M: x86.32 %cleanup ( alien-node -- ) { { [ dup abi>> "stdcall" = ] - [ alien-stack-frame ESP swap SUB ] + [ drop ESP stack-frame get params>> SUB ] } { [ dup return>> large-struct? ] [ drop EAX PUSH ] diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 8c9762630b..5bcd733eaa 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -164,22 +164,21 @@ M: x86.64 %box-small-struct ( c-type -- ) "box_small_struct" f %alien-invoke ] with-return-regs ; -: struct-return@ ( size n -- n ) - [ ] [ \ stack-frame get swap - ] ?if stack@ ; +: struct-return@ ( n -- operand ) + [ stack-frame get params>> ] unless* stack@ ; M: x86.64 %box-large-struct ( n c-type -- ) ! Struct size is parameter 2 - heap-size - RSI over MOV + RSI swap heap-size MOV ! Compute destination address - RDI spin struct-return@ LEA + RDI swap struct-return@ LEA ! Copy the struct from the C stack "box_value_struct" f %alien-invoke ; -M: x86.64 %prepare-box-struct ( size -- ) - ! Compute target address for value struct return, store it - ! as the first parameter - RAX swap f struct-return@ LEA +M: x86.64 %prepare-box-struct ( -- ) + ! Compute target address for value struct return + RAX f struct-return@ LEA + ! Store it as the first parameter 0 stack@ RAX MOV ; M: x86.64 %prepare-var-args RAX RAX XOR ; diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index ea54ef85af..d10397de3b 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -18,7 +18,7 @@ HOOK: stack-reg cpu ( -- reg ) #! input values to callbacks; the callback has its own #! stack frame set up, and we want to read the frame #! set up by the caller. - stack-frame* + stack@ ; + stack-frame get total-size>> + stack@ ; : reg-stack ( n reg -- op ) swap cells neg [+] ; @@ -51,19 +51,27 @@ HOOK: prepare-division cpu ( -- ) M: immediate load-literal v>operand swap v>operand MOV ; -M: x86 stack-frame ( n -- i ) - 3 cells + 16 align ; +: align-stack ( n -- n' ) + os macosx? [ 16 align ] when ; + +M: x86 stack-frame-size ( n -- i ) + 3 cells + align-stack ; M: x86 %save-word-xt ( -- ) temp-reg v>operand 0 MOV rc-absolute-cell rel-this ; +: decr-stack-reg ( n -- ) + dup 0 = [ drop ] [ stack-reg swap SUB ] if ; + M: x86 %prologue ( n -- ) dup PUSH temp-reg v>operand PUSH - stack-reg swap 3 cells - SUB ; + 3 cells - decr-stack-reg ; -M: x86 %epilogue ( n -- ) - stack-reg swap cell - ADD ; +: incr-stack-reg ( n -- ) + dup 0 = [ ] [ stack-reg swap ADD ] if ; + +M: x86 %epilogue ( n -- ) cell - incr-stack-reg ; HOOK: %alien-global cpu ( symbol dll register -- ) From 4ca06ae50ff25eb93a5214914645eb1381393969 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Oct 2008 00:20:24 -0500 Subject: [PATCH 090/244] Typo --- basis/cpu/x86/architecture/architecture.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index d10397de3b..417f90c9f9 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -69,7 +69,7 @@ M: x86 %prologue ( n -- ) 3 cells - decr-stack-reg ; : incr-stack-reg ( n -- ) - dup 0 = [ ] [ stack-reg swap ADD ] if ; + dup 0 = [ drop ] [ stack-reg swap ADD ] if ; M: x86 %epilogue ( n -- ) cell - incr-stack-reg ; From 3c2caf948ae4c58a56d211597c7ab4fa9d284bd2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 6 Oct 2008 00:33:47 -0500 Subject: [PATCH 091/244] 16-align stack on x86-64 --- basis/cpu/x86/architecture/architecture.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index 417f90c9f9..01256fb4c5 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -52,7 +52,7 @@ HOOK: prepare-division cpu ( -- ) M: immediate load-literal v>operand swap v>operand MOV ; : align-stack ( n -- n' ) - os macosx? [ 16 align ] when ; + os macosx? cpu x86.64? or [ 16 align ] when ; M: x86 stack-frame-size ( n -- i ) 3 cells + align-stack ; From d142b3283772fa54998f4f4c6c709a51d45f6503 Mon Sep 17 00:00:00 2001 From: erg Date: Mon, 6 Oct 2008 14:54:27 -0500 Subject: [PATCH 092/244] cleaner irc.messages --- extra/irc/messages/messages.factor | 168 +++++++++++++++++------------ 1 file changed, 98 insertions(+), 70 deletions(-) diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 882cec5c8d..14c8633f6f 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -4,7 +4,6 @@ USING: kernel fry splitting ascii calendar accessors combinators qualified arrays classes.tuple math.order ; RENAME: join sequences => sjoin EXCLUDE: sequences => join ; -EXCLUDE: inverse => _ ; IN: irc.messages TUPLE: irc-message line prefix command parameters trailing timestamp ; @@ -17,75 +16,99 @@ TUPLE: nick < irc-message ; TUPLE: privmsg < irc-message name ; TUPLE: kick < irc-message channel who ; TUPLE: roomlist < irc-message channel names ; -TUPLE: nick-in-use < irc-message name ; +TUPLE: nick-in-use < irc-message asterisk name ; TUPLE: notice < irc-message type ; TUPLE: mode < irc-message name mode parameter ; TUPLE: names-reply < irc-message who channel ; TUPLE: unhandled < irc-message ; : ( command parameters trailing -- irc-message ) - irc-message new now >>timestamp - [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ; + irc-message new + now >>timestamp + swap >>trailing + swap >>parameters + swap >>command ; > ( irc-message -- string ) -M: irc-message command-string>> command>> ; -M: ping command-string>> drop "PING" ; -M: join command-string>> drop "JOIN" ; -M: part command-string>> drop "PART" ; -M: quit command-string>> drop "QUIT" ; -M: nick command-string>> drop "NICK" ; -M: privmsg command-string>> drop "PRIVMSG" ; -M: notice command-string>> drop "NOTICE" ; -M: mode command-string>> drop "MODE" ; -M: kick command-string>> drop "KICK" ; +M: irc-message command-string>> ( irc-message -- string ) command>> ; +M: ping command-string>> ( ping -- string ) drop "PING" ; +M: join command-string>> ( join -- string ) drop "JOIN" ; +M: part command-string>> ( part -- string ) drop "PART" ; +M: quit command-string>> ( quit -- string ) drop "QUIT" ; +M: nick command-string>> ( nick -- string ) drop "NICK" ; +M: privmsg command-string>> ( privmsg -- string ) drop "PRIVMSG" ; +M: notice command-string>> ( notice -- string ) drop "NOTICE" ; +M: mode command-string>> ( mode -- string ) drop "MODE" ; +M: kick command-string>> ( kick -- string ) drop "KICK" ; GENERIC: command-parameters>> ( irc-message -- seq ) -M: irc-message command-parameters>> parameters>> ; -M: ping command-parameters>> drop { } ; -M: join command-parameters>> drop { } ; -M: part command-parameters>> channel>> 1array ; -M: quit command-parameters>> drop { } ; -M: nick command-parameters>> drop { } ; -M: privmsg command-parameters>> name>> 1array ; -M: notice command-parameters>> type>> 1array ; -M: kick command-parameters>> [ channel>> ] [ who>> ] bi 2array ; -M: mode command-parameters>> [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; +M: irc-message command-parameters>> ( irc-message -- seq ) parameters>> ; +M: ping command-parameters>> ( ping -- seq ) drop { } ; +M: join command-parameters>> ( join -- seq ) drop { } ; +M: part command-parameters>> ( part -- seq ) channel>> 1array ; +M: quit command-parameters>> ( quit -- seq ) drop { } ; +M: nick command-parameters>> ( nick -- seq ) drop { } ; +M: privmsg command-parameters>> ( privmsg -- seq ) name>> 1array ; +M: notice command-parameters>> ( norice -- seq ) type>> 1array ; +M: kick command-parameters>> ( kick -- seq ) + [ channel>> ] [ who>> ] bi 2array ; +M: mode command-parameters>> ( mode -- seq ) + [ name>> ] [ channel>> ] [ mode>> ] tri 3array ; -GENERIC: (>>command-parameters) ( params irc-message -- ) +GENERIC# >>command-parameters 1 ( irc-message params -- irc-message ) -M: irc-message (>>command-parameters) 2drop ; -M: logged-in (>>command-parameters) [ first ] dip (>>name) ; -M: privmsg (>>command-parameters) [ first ] dip (>>name) ; -M: notice (>>command-parameters) [ first ] dip (>>type) ; -M: part (>>command-parameters) [ first ] dip (>>channel) ; -M: nick-in-use (>>command-parameters) [ second ] dip (>>name) ; -M: kick (>>command-parameters) - [ first2 ] dip [ (>>who) ] [ (>>channel) ] bi ; -M: names-reply (>>command-parameters) - [ [ first ] dip (>>who) ] [ [ third ] dip (>>channel) ] 2bi ; -M: mode (>>command-parameters) - { { [ >r 2array r> ] [ [ (>>mode) ] [ (>>name) ] bi ] } - { [ >r 3array r> ] [ [ (>>parameter) ] [ (>>mode) ] [ (>>name) ] tri ] } - } switch ; +M: irc-message >>command-parameters ( irc-message params -- irc-message ) + drop ; + +M: logged-in >>command-parameters ( part params -- part ) + first >>name ; + +M: privmsg >>command-parameters ( privmsg params -- privmsg ) + first >>name ; + +M: notice >>command-parameters ( notice params -- notice ) + first >>type ; + +M: part >>command-parameters ( part params -- part ) + first >>channel ; + +M: kick >>command-parameters ( kick params -- kick ) + first2 [ >>channel ] [ >>who ] bi* ; + +M: nick-in-use >>command-parameters ( nick-in-use params -- nick-in-use ) + second >>name ; + +M: names-reply >>command-parameters ( names-reply params -- names-reply ) + first3 nip [ >>who ] [ >>channel ] bi* ; + +M: mode >>command-parameters ( mode params -- mode ) + dup length 3 = [ + first3 [ >>name ] [ >>mode ] [ >>parameter ] tri* + ] [ + first2 [ >>name ] [ >>mode ] bi* + ] if ; PRIVATE> GENERIC: irc-message>client-line ( irc-message -- string ) -M: irc-message irc-message>client-line +M: irc-message irc-message>client-line ( irc-message -- string ) [ command-string>> ] [ command-parameters>> " " sjoin ] [ trailing>> [ CHAR: : prefix ] [ "" ] if* ] tri 3array " " sjoin ; GENERIC: irc-message>server-line ( irc-message -- string ) -M: irc-message irc-message>server-line drop "not implemented yet" ; + +M: irc-message irc-message>server-line ( irc-message -- string ) + drop "not implemented yet" ; server-line drop "not implemented yet" ; : split-at-first ( seq separators -- before after ) dupd '[ _ member? ] find [ cut 1 tail ] [ swap ] if ; -: remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ; +: remove-heading-: ( seq -- seq ) + ":" ?head drop ; : parse-name ( string -- string ) remove-heading-: "!" split-at-first drop ; : split-prefix ( string -- string/f string ) dup ":" head? - [ remove-heading-: " " split1 ] - [ f swap ] - if ; + [ remove-heading-: " " split1 ] [ f swap ] if ; : split-trailing ( string -- string string/f ) ":" split1 ; -: copy-message-in ( origin dest -- ) - { [ [ parameters>> ] dip [ (>>command-parameters) ] [ (>>parameters) ] 2bi ] - [ [ line>> ] dip (>>line) ] - [ [ prefix>> ] dip (>>prefix) ] - [ [ command>> ] dip (>>command) ] - [ [ trailing>> ] dip (>>trailing) ] - [ [ timestamp>> ] dip (>>timestamp) ] - } 2cleave ; +: copy-message-in ( command irc-message -- command ) + { + [ parameters>> [ >>parameters ] [ >>command-parameters ] bi ] + [ line>> >>line ] + [ prefix>> >>prefix ] + [ command>> >>command ] + [ trailing>> >>trailing ] + [ timestamp>> >>timestamp ] + } cleave ; PRIVATE> UNION: sender-in-prefix privmsg join part quit kick mode nick ; GENERIC: irc-message-sender ( irc-message -- sender ) -M: sender-in-prefix irc-message-sender prefix>> parse-name ; +M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender ) + prefix>> parse-name ; : string>irc-message ( string -- object ) dup split-prefix split-trailing [ [ blank? ] trim " " split unclip swap ] dip now irc-message boa ; +: irc-message>command ( irc-message -- command ) + [ + command>> { + { "PING" [ ping ] } + { "NOTICE" [ notice ] } + { "001" [ logged-in ] } + { "433" [ nick-in-use ] } + { "353" [ names-reply ] } + { "JOIN" [ join ] } + { "PART" [ part ] } + { "NICK" [ nick ] } + { "PRIVMSG" [ privmsg ] } + { "QUIT" [ quit ] } + { "MODE" [ mode ] } + { "KICK" [ kick ] } + [ drop unhandled ] + } case new + ] keep copy-message-in ; + : parse-irc-line ( string -- message ) - string>irc-message - dup command>> { - { "PING" [ ping ] } - { "NOTICE" [ notice ] } - { "001" [ logged-in ] } - { "433" [ nick-in-use ] } - { "353" [ names-reply ] } - { "JOIN" [ join ] } - { "PART" [ part ] } - { "NICK" [ nick ] } - { "PRIVMSG" [ privmsg ] } - { "QUIT" [ quit ] } - { "MODE" [ mode ] } - { "KICK" [ kick ] } - [ drop unhandled ] - } case new [ copy-message-in ] keep ; + string>irc-message irc-message>command ; From e42a2d8825a7a280a11610ca9910de643576654d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 15:01:01 -0500 Subject: [PATCH 093/244] clean up constructor --- extra/irc/client/client.factor | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index d40c7d400d..463e35f415 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -19,9 +19,16 @@ C: irc-profile TUPLE: irc-client profile stream in-messages out-messages chats is-running nick connect reconnect-time is-ready ; + : ( profile -- irc-client ) - [ f H{ } clone f ] keep nickname>> - [ latin1 ] 15 seconds f irc-client boa ; + irc-client new + swap >>profile + >>in-messages + >>out-messages + H{ } clone >>chats + dup profile>> nickname>> >>nick + [ latin1 ] >>connect + 15 seconds >>reconnect-time ; TUPLE: irc-chat in-messages client ; TUPLE: irc-server-chat < irc-chat ; From 03043a7cfdba7ee943c5adadd210e3cbb83ca1e7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 15:25:17 -0500 Subject: [PATCH 094/244] remove slot --- extra/irc/messages/messages.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/irc/messages/messages.factor b/extra/irc/messages/messages.factor index 14c8633f6f..32533c102a 100755 --- a/extra/irc/messages/messages.factor +++ b/extra/irc/messages/messages.factor @@ -16,7 +16,7 @@ TUPLE: nick < irc-message ; TUPLE: privmsg < irc-message name ; TUPLE: kick < irc-message channel who ; TUPLE: roomlist < irc-message channel names ; -TUPLE: nick-in-use < irc-message asterisk name ; +TUPLE: nick-in-use < irc-message name ; TUPLE: notice < irc-message type ; TUPLE: mode < irc-message name mode parameter ; TUPLE: names-reply < irc-message who channel ; From a0a17646c5e4f4b16be73556570336d6dfc346fd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 15:56:54 -0500 Subject: [PATCH 095/244] dettach -> detach (spelling), fix docs --- extra/irc/client/client-docs.factor | 10 +++++----- extra/irc/client/client.factor | 2 +- extra/irc/ui/ui.factor | 2 +- 3 files changed, 7 insertions(+), 7 deletions(-) diff --git a/extra/irc/client/client-docs.factor b/extra/irc/client/client-docs.factor index 1b9204c4f1..6d4fae9b83 100644 --- a/extra/irc/client/client-docs.factor +++ b/extra/irc/client/client-docs.factor @@ -19,8 +19,8 @@ HELP: attach-chat "Chatting with irc channels/users/etc" { $values { "irc-chat" "an irc chat object" } { "irc-client" "an irc client object" } } { $description "Registers " { $snippet "irc-chat" } " with " { $snippet "irc-client" } " and starts listening." } ; -HELP: dettach-chat "Stop an unregister chat" -{ $values { "irc-chat" "an irc chat object" } { "irc-client" "an irc client object" } } +HELP: detach-chat "Stop an unregister chat" +{ $values { "irc-chat" "an irc chat object" } } { $description "Unregisters " { $snippet "irc-chat" } " from " { $snippet "irc-client" } " and stops listening. This is how you part from a channel." } ; HELP: terminate-irc "Terminates an irc client" @@ -49,7 +49,7 @@ ARTICLE: "irc.client" "IRC Client" { $subsection connect-irc } { $subsection terminate-irc } { $subsection attach-chat } -{ $subsection dettach-chat } +{ $subsection detach-chat } { $subsection hear } { $subsection speak } { $heading "IRC messages" } @@ -72,7 +72,7 @@ ARTICLE: "irc.client" "IRC Client" { $heading "Special messages" } "Some special messages that are created by the library and not by the irc server." { $table - { { $link irc-chat-end } "sent to a chat when it has been dettached from the client, the chat should stop after it receives this message. " } + { { $link irc-chat-end } "sent to a chat when it has been detached from the client, the chat should stop after it receives this message. " } { { $link irc-end } " sent when the client isn't running anymore, chats should stop after it receives this message." } { { $link irc-disconnected } " sent to notify chats that connection was lost." } { { $link irc-connected } " sent to notify chats that a connection with the irc server was established." } } @@ -97,4 +97,4 @@ ARTICLE: "irc.client" "IRC Client" } ; -ABOUT: "irc.client" \ No newline at end of file +ABOUT: "irc.client" diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 463e35f415..ce7a6e5373 100755 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -362,7 +362,7 @@ PRIVATE> : attach-chat ( irc-chat irc-client -- ) [ (attach-chat) ] with-irc-client ; -: dettach-chat ( irc-chat -- ) +: detach-chat ( irc-chat -- ) [ client>> ] keep '[ _ (remove-chat) ] with-irc-client ; : speak ( message irc-chat -- ) diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 50dc9378a2..e854d285b7 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -186,7 +186,7 @@ M: irc-tab graft* [ chat>> ] [ window>> client>> ] bi attach-chat ; M: irc-tab ungraft* - chat>> dettach-chat ; + chat>> detach-chat ; TUPLE: irc-channel-tab < irc-tab userlist ; From e0d6aadc8e7c8af2819907f4156f9dd7db7528fc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:17:14 -0500 Subject: [PATCH 096/244] complete file-info across *bsd, linux --- basis/io/unix/files/files.factor | 71 +++++++++++++++------- basis/io/unix/files/freebsd/freebsd.factor | 17 ++++++ basis/io/unix/files/freebsd/tags.txt | 1 + basis/io/unix/files/macosx/macosx.factor | 16 +++++ basis/io/unix/files/macosx/tags.txt | 1 + basis/io/unix/files/netbsd/netbsd.factor | 17 ++++++ basis/io/unix/files/netbsd/tags.txt | 1 + basis/io/unix/files/openbsd/openbsd.factor | 17 ++++++ basis/io/unix/files/openbsd/tags.txt | 1 + basis/io/unix/files/unique/unique.factor | 2 + 10 files changed, 123 insertions(+), 21 deletions(-) create mode 100644 basis/io/unix/files/freebsd/freebsd.factor create mode 100644 basis/io/unix/files/freebsd/tags.txt create mode 100644 basis/io/unix/files/macosx/macosx.factor create mode 100644 basis/io/unix/files/macosx/tags.txt create mode 100644 basis/io/unix/files/netbsd/netbsd.factor create mode 100644 basis/io/unix/files/netbsd/tags.txt create mode 100644 basis/io/unix/files/openbsd/openbsd.factor create mode 100644 basis/io/unix/files/openbsd/tags.txt diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index c6eda50855..4319b6c8de 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -4,7 +4,7 @@ USING: io.backend io.ports io.unix.backend io.files io unix unix.stat unix.time kernel math continuations math.bitwise byte-arrays alien combinators calendar io.encodings.binary accessors sequences strings system -io.files.private destructors ; +io.files.private destructors vocabs.loader ; IN: io.unix.files @@ -74,26 +74,14 @@ M: unix copy-file ( from to -- ) [ swap file-info permissions>> chmod io-error ] 2bi ; -: stat>type ( stat -- type ) - stat-st_mode S_IFMT bitand { - { S_IFREG [ +regular-file+ ] } - { S_IFDIR [ +directory+ ] } - { S_IFCHR [ +character-device+ ] } - { S_IFBLK [ +block-device+ ] } - { S_IFIFO [ +fifo+ ] } - { S_IFLNK [ +symbolic-link+ ] } - { S_IFSOCK [ +socket+ ] } - [ drop +unknown+ ] - } case ; +HOOK: stat>file-info os ( stat -- file-info ) -: stat>file-info ( stat -- info ) - { - [ stat>type ] - [ stat-st_size ] - [ stat-st_mode ] - [ stat-st_mtim timespec-sec seconds unix-1970 time+ ] - } cleave - \ file-info boa ; +HOOK: stat>type os ( stat -- file-info ) + +HOOK: new-file-info os ( -- class ) + +TUPLE: unix-file-info < file-info uid gid dev ino +nlink rdev blocks blocksize ; M: unix file-info ( path -- info ) normalize-path file-status stat>file-info ; @@ -105,4 +93,45 @@ M: unix make-link ( path1 path2 -- ) normalize-path symlink io-error ; M: unix read-link ( path -- path' ) - normalize-path read-symbolic-link ; \ No newline at end of file + normalize-path read-symbolic-link ; + +M: unix new-file-info ( -- class ) unix-file-info new ; + +M: unix stat>file-info ( stat -- file-info ) + [ new-file-info ] dip + { + [ stat>type >>type ] + [ stat-st_size >>size ] + [ stat-st_mode >>permissions ] + [ stat-st_ctim timespec>unix-time >>created ] + [ stat-st_mtim timespec>unix-time >>modified ] + [ stat-st_atim timespec>unix-time >>accessed ] + [ stat-st_uid >>uid ] + [ stat-st_gid >>gid ] + [ stat-st_dev >>dev ] + [ stat-st_ino >>ino ] + [ stat-st_nlink >>nlink ] + [ stat-st_rdev >>rdev ] + [ stat-st_blocks >>blocks ] + [ stat-st_blksize >>blocksize ] + } cleave ; + +M: unix stat>type ( stat -- type ) + stat-st_mode S_IFMT bitand { + { S_IFREG [ +regular-file+ ] } + { S_IFDIR [ +directory+ ] } + { S_IFCHR [ +character-device+ ] } + { S_IFBLK [ +block-device+ ] } + { S_IFIFO [ +fifo+ ] } + { S_IFLNK [ +symbolic-link+ ] } + { S_IFSOCK [ +socket+ ] } + [ drop +unknown+ ] + } case ; + +! Linux has no extra fields in its stat struct +os { + { macosx [ "io.unix.files.macosx" require ] } + { freebsd [ "io.unix.files.freebsd" require ] } + { netbsd [ "io.unix.files.netbsd" require ] } + { openbsd [ "io.unix.files.openbsd" require ] } +} case diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor new file mode 100644 index 0000000000..14d15bc93d --- /dev/null +++ b/basis/io/unix/files/freebsd/freebsd.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel alien.syntax math io.unix.files system +unix.stat accessors combinators calendar ; +IN: io.unix.files.freebsd + +TUPLE: freebsd-file-info < unix-file-info birth-time flags gen ; + +M: freebsd new-file-info ( -- class ) freebsd-file-info new ; + +M: freebsd stat>file-info ( stat -- file-info ) + [ call-next-method ] keep + { + [ stat-st_flags >>flags ] + [ stat-st_gen >>gen ] + [ stat-st_birthtimepsec timespec>timestamp >>birth-time ] + } cleave ; diff --git a/basis/io/unix/files/freebsd/tags.txt b/basis/io/unix/files/freebsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/freebsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/macosx/macosx.factor b/basis/io/unix/files/macosx/macosx.factor new file mode 100644 index 0000000000..4173123e45 --- /dev/null +++ b/basis/io/unix/files/macosx/macosx.factor @@ -0,0 +1,16 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel alien.syntax math io.unix.files system +unix.stat accessors combinators ; +IN: io.unix.files.macosx + +TUPLE: macosx-file-info < unix-file-info flags gen ; + +M: macosx new-file-info ( -- class ) macosx-file-info new ; + +M: macosx stat>file-info ( stat -- file-info ) + [ call-next-method ] keep + { + [ stat-st_flags >>flags ] + [ stat-st_gen >>gen ] + } cleave ; diff --git a/basis/io/unix/files/macosx/tags.txt b/basis/io/unix/files/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/macosx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor new file mode 100644 index 0000000000..c61304c128 --- /dev/null +++ b/basis/io/unix/files/netbsd/netbsd.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel alien.syntax math io.unix.files system +unix.stat accessors combinators calendar ; +IN: io.unix.files.netbsd + +TUPLE: netbsd-file-info < unix-file-info birth-time flags gen ; + +M: netbsd new-file-info ( -- class ) netbsd-file-info new ; + +M: netbsd stat>file-info ( stat -- file-info ) + [ call-next-method ] keep + { + [ stat-st_flags >>flags ] + [ stat-st_gen >>gen ] + [ stat-st_birthtim timespec>timestamp >>birth-time ] + } cleave ; diff --git a/basis/io/unix/files/netbsd/tags.txt b/basis/io/unix/files/netbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/netbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor new file mode 100644 index 0000000000..e1473eed4d --- /dev/null +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel alien.syntax math io.unix.files system +unix.stat accessors combinators calendar ; +IN: io.unix.files.openbsd + +TUPLE: openbsd-file-info < unix-file-info birth-time flags gen ; + +M: openbsd new-file-info ( -- class ) openbsd-file-info new ; + +M: openbsd stat>file-info ( stat -- file-info ) + [ call-next-method ] keep + { + [ stat-st_flags >>flags ] + [ stat-st_gen >>gen ] + [ stat-st_birthtim timespec>timestamp >>birth-time ] + } cleave ; diff --git a/basis/io/unix/files/openbsd/tags.txt b/basis/io/unix/files/openbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/openbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/io/unix/files/unique/unique.factor b/basis/io/unix/files/unique/unique.factor index 95e321fd93..e47ac6a2e3 100644 --- a/basis/io/unix/files/unique/unique.factor +++ b/basis/io/unix/files/unique/unique.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: kernel io.ports io.unix.backend math.bitwise unix io.files.unique.backend system ; IN: io.unix.files.unique From b168d75a46747ccc64f45dc18ee02b0f6d6c1825 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:17:49 -0500 Subject: [PATCH 097/244] add timespec>timestamp word --- basis/calendar/calendar.factor | 9 ++++++++- basis/structs/structs.factor | 10 ++++++++++ basis/unix/time/time.factor | 12 ------------ 3 files changed, 18 insertions(+), 13 deletions(-) diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 31c835aada..8a27a46aa2 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -402,9 +402,16 @@ PRIVATE> : time-since-midnight ( timestamp -- duration ) dup midnight time- ; +: since-1970 ( time -- timestamp ) + unix-1970 time+ >local-time ; + : timeval>unix-time ( timeval -- timestamp ) [ timeval-sec seconds ] [ timeval-usec microseconds ] bi - time+ unix-1970 time+ >local-time ; + time+ since-1970 ; + +: timespec>unix-time ( timeval -- timestamp ) + [ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi + time+ since-1970 ; M: timestamp sleep-until timestamp>millis sleep-until ; diff --git a/basis/structs/structs.factor b/basis/structs/structs.factor index f54917dc47..51ac517af3 100644 --- a/basis/structs/structs.factor +++ b/basis/structs/structs.factor @@ -10,3 +10,13 @@ C-STRUCT: timeval "timeval" [ set-timeval-usec ] keep [ set-timeval-sec ] keep ; + +C-STRUCT: timespec + { "time_t" "sec" } + { "long" "nsec" } ; + +: make-timespec ( ms -- timespec ) + 1000 /mod 1000000 * + "timespec" + [ set-timespec-nsec ] keep + [ set-timespec-sec ] keep ; diff --git a/basis/unix/time/time.factor b/basis/unix/time/time.factor index 4fbb20dca0..26b42ddfe7 100644 --- a/basis/unix/time/time.factor +++ b/basis/unix/time/time.factor @@ -1,6 +1,4 @@ - USING: kernel alien.syntax alien.c-types math ; - IN: unix.time TYPEDEF: uint time_t @@ -18,16 +16,6 @@ C-STRUCT: tm { "long" "gmtoff" } ! Seconds: 0-59 (K&R says 0-61?) { "char*" "zone" } ; -C-STRUCT: timespec - { "time_t" "sec" } - { "long" "nsec" } ; - -: make-timespec ( ms -- timespec ) - 1000 /mod 1000000 * - "timespec" - [ set-timespec-nsec ] keep - [ set-timespec-sec ] keep ; - FUNCTION: time_t time ( time_t* t ) ; FUNCTION: tm* localtime ( time_t* clock ) ; FUNCTION: int gettimeofday ( timespec* TP, void* TZP ) ; From 9459eaab4b81c1a9f060393c2cef594b72873523 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:28:11 -0500 Subject: [PATCH 098/244] all platforms support the file-info structure --- core/io/files/files.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 1634b7a3f1..bc84aa5d21 100644 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -153,7 +153,7 @@ PRIVATE> "." last-split1 nip ; ! File info -TUPLE: file-info type size permissions modified ; +TUPLE: file-info type size permissions created modified accessed ; HOOK: file-info io-backend ( path -- info ) From 0294308c4c40e3ed49f446b1e45e5e1370bd008e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:28:42 -0500 Subject: [PATCH 099/244] work on windows file-info --- basis/io/windows/files/files.factor | 41 ++++++++++++++++++----------- 1 file changed, 25 insertions(+), 16 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index 40e7e17402..f4bb3c71dc 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -147,18 +147,18 @@ SYMBOLS: +read-only+ +hidden+ +system+ FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) + [ file-info new ] dip { - [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ] + [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ] [ [ WIN32_FIND_DATA-nFileSizeLow ] - [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit + [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size ] - [ WIN32_FIND_DATA-dwFileAttributes ] - ! [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp ] - [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp ] - ! [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp ] - } cleave - \ file-info boa ; + [ WIN32_FIND_DATA-dwFileAttributes >>mode ] + [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ] + [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ] + [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ] + } cleave ; : find-first-file-stat ( path -- WIN32_FIND_DATA ) "WIN32_FIND_DATA" [ @@ -168,23 +168,32 @@ SYMBOLS: +read-only+ +hidden+ +system+ ] keep ; : BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info ) + [ file-info new ] dip { - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] [ [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] - [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit + [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size + ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>mode ] + [ + BY_HANDLE_FILE_INFORMATION-ftCreationTime + FILETIME>timestamp >>created + ] + [ + BY_HANDLE_FILE_INFORMATION-ftLastWriteTime + FILETIME>timestamp >>modified + ] + [ + BY_HANDLE_FILE_INFORMATION-ftLastAccessTime + FILETIME>timestamp >>accessed ] - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes ] - ! [ BY_HANDLE_FILE_INFORMATION-ftCreationTime FILETIME>timestamp ] - [ BY_HANDLE_FILE_INFORMATION-ftLastWriteTime FILETIME>timestamp ] - ! [ BY_HANDLE_FILE_INFORMATION-ftLastAccessTime FILETIME>timestamp ] ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ] ! [ ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ] ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit ! ] - } cleave - \ file-info boa ; + } cleave ; : get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION ) [ From 847205432fe1d234f028aa6f2527d8713f17c4de Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:34:58 -0500 Subject: [PATCH 100/244] fix load error --- basis/structs/structs.factor | 2 +- basis/unix/time/time.factor | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/structs/structs.factor b/basis/structs/structs.factor index 51ac517af3..6aef757eb4 100644 --- a/basis/structs/structs.factor +++ b/basis/structs/structs.factor @@ -1,4 +1,4 @@ -USING: alien.c-types alien.syntax kernel math ; +USING: alien.c-types alien.syntax kernel math unix.types ; IN: structs C-STRUCT: timeval diff --git a/basis/unix/time/time.factor b/basis/unix/time/time.factor index 26b42ddfe7..67611ae193 100644 --- a/basis/unix/time/time.factor +++ b/basis/unix/time/time.factor @@ -1,8 +1,8 @@ -USING: kernel alien.syntax alien.c-types math ; +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel alien.syntax alien.c-types math unix.types ; IN: unix.time -TYPEDEF: uint time_t - C-STRUCT: tm { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?) { "int" "min" } ! Minutes: 0-59 From 1d25db2a6e6c7ad968cafb1228b7486ec20c2ec0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:54:50 -0500 Subject: [PATCH 101/244] empty case for linux --- basis/io/unix/files/files.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 4319b6c8de..fafc56154b 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -134,4 +134,5 @@ os { { freebsd [ "io.unix.files.freebsd" require ] } { netbsd [ "io.unix.files.netbsd" require ] } { openbsd [ "io.unix.files.openbsd" require ] } + { linux [ ] } } case From 9f6a7bfd87723f7a294687b0c1917c84f57a302a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:56:12 -0500 Subject: [PATCH 102/244] typo --- basis/io/unix/files/freebsd/freebsd.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor index 14d15bc93d..42857d1132 100644 --- a/basis/io/unix/files/freebsd/freebsd.factor +++ b/basis/io/unix/files/freebsd/freebsd.factor @@ -13,5 +13,5 @@ M: freebsd stat>file-info ( stat -- file-info ) { [ stat-st_flags >>flags ] [ stat-st_gen >>gen ] - [ stat-st_birthtimepsec timespec>timestamp >>birth-time ] + [ stat-st_birthtimespec timespec>timestamp >>birth-time ] } cleave ; From f949f6ee1a678f81e8354ddbe3530ba9dc770618 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 17:59:20 -0500 Subject: [PATCH 103/244] move basis/structs to calendar.unix --- basis/calendar/unix/unix.factor | 24 ++++++++++++++++++++++-- basis/structs/authors.txt | 1 - basis/structs/structs.factor | 22 ---------------------- basis/structs/summary.txt | 1 - 4 files changed, 22 insertions(+), 26 deletions(-) delete mode 100755 basis/structs/authors.txt delete mode 100644 basis/structs/structs.factor delete mode 100644 basis/structs/summary.txt diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index 1da554e0f1..e811abcab8 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -1,7 +1,27 @@ -USING: alien alien.c-types arrays calendar kernel structs -math unix.time namespaces system ; +USING: alien alien.c-types alien.syntax arrays calendar +kernel structs math unix.time namespaces system ; IN: calendar.unix +C-STRUCT: timeval + { "long" "sec" } + { "long" "usec" } ; + +: make-timeval ( ms -- timeval ) + 1000 /mod 1000 * + "timeval" + [ set-timeval-usec ] keep + [ set-timeval-sec ] keep ; + +C-STRUCT: timespec + { "time_t" "sec" } + { "long" "nsec" } ; + +: make-timespec ( ms -- timespec ) + 1000 /mod 1000000 * + "timespec" + [ set-timespec-nsec ] keep + [ set-timespec-sec ] keep ; + : get-time ( -- alien ) f time localtime ; diff --git a/basis/structs/authors.txt b/basis/structs/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/structs/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/basis/structs/structs.factor b/basis/structs/structs.factor deleted file mode 100644 index 6aef757eb4..0000000000 --- a/basis/structs/structs.factor +++ /dev/null @@ -1,22 +0,0 @@ -USING: alien.c-types alien.syntax kernel math unix.types ; -IN: structs - -C-STRUCT: timeval - { "long" "sec" } - { "long" "usec" } ; - -: make-timeval ( ms -- timeval ) - 1000 /mod 1000 * - "timeval" - [ set-timeval-usec ] keep - [ set-timeval-sec ] keep ; - -C-STRUCT: timespec - { "time_t" "sec" } - { "long" "nsec" } ; - -: make-timespec ( ms -- timespec ) - 1000 /mod 1000000 * - "timespec" - [ set-timespec-nsec ] keep - [ set-timespec-sec ] keep ; diff --git a/basis/structs/summary.txt b/basis/structs/summary.txt deleted file mode 100644 index 86d6ad349e..0000000000 --- a/basis/structs/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Cross-platform C structs From 5e57f68814b87acf25e2ccc89477b3eacd46b213 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 18:01:53 -0500 Subject: [PATCH 104/244] use calendar.unix --- basis/io/unix/files/freebsd/freebsd.factor | 2 +- basis/io/unix/files/netbsd/netbsd.factor | 2 +- basis/io/unix/files/openbsd/openbsd.factor | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor index 42857d1132..e6fff4dfe0 100644 --- a/basis/io/unix/files/freebsd/freebsd.factor +++ b/basis/io/unix/files/freebsd/freebsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators calendar ; +unix.stat accessors combinators calendar.unix ; IN: io.unix.files.freebsd TUPLE: freebsd-file-info < unix-file-info birth-time flags gen ; diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor index c61304c128..6a41e6e18a 100644 --- a/basis/io/unix/files/netbsd/netbsd.factor +++ b/basis/io/unix/files/netbsd/netbsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators calendar ; +unix.stat accessors combinators calendar.unix ; IN: io.unix.files.netbsd TUPLE: netbsd-file-info < unix-file-info birth-time flags gen ; diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor index e1473eed4d..5723827481 100644 --- a/basis/io/unix/files/openbsd/openbsd.factor +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators calendar ; +unix.stat accessors combinators calendar.unix ; IN: io.unix.files.openbsd TUPLE: openbsd-file-info < unix-file-info birth-time flags gen ; From c4fdad4df6e30fe5a88e1d36245795dc4401d50e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 18:02:07 -0500 Subject: [PATCH 105/244] move structs around AGAIN --- basis/calendar/unix/unix.factor | 10 +--------- basis/unix/unix.factor | 11 ++++++++++- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index e811abcab8..4a1b7d49ef 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -1,21 +1,13 @@ USING: alien alien.c-types alien.syntax arrays calendar -kernel structs math unix.time namespaces system ; +kernel structs math unix unix.time namespaces system ; IN: calendar.unix -C-STRUCT: timeval - { "long" "sec" } - { "long" "usec" } ; - : make-timeval ( ms -- timeval ) 1000 /mod 1000 * "timeval" [ set-timeval-usec ] keep [ set-timeval-sec ] keep ; -C-STRUCT: timespec - { "time_t" "sec" } - { "long" "nsec" } ; - : make-timespec ( ms -- timespec ) 1000 /mod 1000000 * "timespec" diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 4c572a6be0..8ccc14f44d 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types alien.syntax kernel libc structs +USING: alien alien.c-types alien.syntax kernel libc sequences continuations byte-arrays strings math namespaces system combinators vocabs.loader qualified accessors stack-checker macros locals generalizations unix.types @@ -29,6 +29,15 @@ C-STRUCT: group { "int" "gr_gid" } { "char**" "gr_mem" } ; +C-STRUCT: timeval + { "long" "sec" } + { "long" "usec" } ; + +C-STRUCT: timespec + { "time_t" "sec" } + { "long" "nsec" } ; + + LIBRARY: factor FUNCTION: void clear_err_no ( ) ; From 0ba6d93626a1283b7d63b6981830b726af15f6cd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 18:02:52 -0500 Subject: [PATCH 106/244] remove using --- basis/calendar/calendar.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 8a27a46aa2..719f0f6e9f 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -2,8 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel math math.functions namespaces sequences strings system vocabs.loader threads accessors combinators -locals classes.tuple math.order summary structs -combinators.short-circuit ; +locals classes.tuple math.order summary combinators.short-circuit ; IN: calendar HOOK: gmt-offset os ( -- hours minutes seconds ) From 4734b62dd8d1086a89c5df09cab91b0fab6a6c10 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 18:03:56 -0500 Subject: [PATCH 107/244] things in the wrong place still, probably will have some using errors now.. --- basis/calendar/calendar.factor | 8 -------- basis/calendar/unix/unix.factor | 8 ++++++++ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 719f0f6e9f..d5824768f4 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -404,14 +404,6 @@ PRIVATE> : since-1970 ( time -- timestamp ) unix-1970 time+ >local-time ; -: timeval>unix-time ( timeval -- timestamp ) - [ timeval-sec seconds ] [ timeval-usec microseconds ] bi - time+ since-1970 ; - -: timespec>unix-time ( timeval -- timestamp ) - [ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi - time+ since-1970 ; - M: timestamp sleep-until timestamp>millis sleep-until ; M: duration sleep hence sleep-until ; diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index 4a1b7d49ef..679cc69fad 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -14,6 +14,14 @@ IN: calendar.unix [ set-timespec-nsec ] keep [ set-timespec-sec ] keep ; +: timeval>unix-time ( timeval -- timestamp ) + [ timeval-sec seconds ] [ timeval-usec microseconds ] bi + time+ since-1970 ; + +: timespec>unix-time ( timeval -- timestamp ) + [ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi + time+ since-1970 ; + : get-time ( -- alien ) f time localtime ; From dd56cd4a4fc39ea9089fff5abd49552110c62dff Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 18:07:40 -0500 Subject: [PATCH 108/244] fix typo --- basis/io/windows/files/files.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index f4bb3c71dc..fdb75c72f0 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -154,7 +154,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ [ WIN32_FIND_DATA-nFileSizeLow ] [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size ] - [ WIN32_FIND_DATA-dwFileAttributes >>mode ] + [ WIN32_FIND_DATA-dwFileAttributes >>permissions ] [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ] [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ] [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ] @@ -175,7 +175,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ] [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size ] - [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>mode ] + [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ] [ BY_HANDLE_FILE_INFORMATION-ftCreationTime FILETIME>timestamp >>created From 4eb3f734839ccb02ce5fb0004ec53d39dd0eeee5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 18:18:33 -0500 Subject: [PATCH 109/244] moving structs around --- basis/calendar/unix/unix.factor | 4 +++- basis/unix/time/time.factor | 8 ++++++++ basis/unix/unix.factor | 9 --------- 3 files changed, 11 insertions(+), 10 deletions(-) diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index 679cc69fad..fcdfcc8a67 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -1,5 +1,7 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax arrays calendar -kernel structs math unix unix.time namespaces system ; +kernel math unix unix.time namespaces system ; IN: calendar.unix : make-timeval ( ms -- timeval ) diff --git a/basis/unix/time/time.factor b/basis/unix/time/time.factor index 67611ae193..b6471e9892 100644 --- a/basis/unix/time/time.factor +++ b/basis/unix/time/time.factor @@ -3,6 +3,14 @@ USING: kernel alien.syntax alien.c-types math unix.types ; IN: unix.time +C-STRUCT: timeval + { "long" "sec" } + { "long" "usec" } ; + +C-STRUCT: timespec + { "time_t" "sec" } + { "long" "nsec" } ; + C-STRUCT: tm { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?) { "int" "min" } ! Minutes: 0-59 diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 8ccc14f44d..a68274f09b 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -29,15 +29,6 @@ C-STRUCT: group { "int" "gr_gid" } { "char**" "gr_mem" } ; -C-STRUCT: timeval - { "long" "sec" } - { "long" "usec" } ; - -C-STRUCT: timespec - { "time_t" "sec" } - { "long" "nsec" } ; - - LIBRARY: factor FUNCTION: void clear_err_no ( ) ; From f1205587a1b52e92047d59f96cfaa014f337ea12 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 19 Sep 2008 18:33:28 -0500 Subject: [PATCH 110/244] fix error from having tuple and generic with same name. annoying... --- basis/io/windows/files/files.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/windows/files/files.factor b/basis/io/windows/files/files.factor index fdb75c72f0..dbe16f0a6e 100644 --- a/basis/io/windows/files/files.factor +++ b/basis/io/windows/files/files.factor @@ -147,7 +147,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ FILE_ATTRIBUTE_DIRECTORY mask? +directory+ +regular-file+ ? ; : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info ) - [ file-info new ] dip + [ \ file-info new ] dip { [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ] [ @@ -168,7 +168,7 @@ SYMBOLS: +read-only+ +hidden+ +system+ ] keep ; : BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info ) - [ file-info new ] dip + [ \ file-info new ] dip { [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ] [ From 2c1f6ee3dd37c8ef92b6df2ad34928d55b8984cc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 19 Sep 2008 22:06:28 -0500 Subject: [PATCH 111/244] apply p1dzkl's patch to let the windows ui cascade new windows instead of putting them all on top of each other. thanks! --- basis/ui/windows/windows.factor | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor index 345c73bcb9..3e600d2e3c 100644 --- a/basis/ui/windows/windows.factor +++ b/basis/ui/windows/windows.factor @@ -420,15 +420,25 @@ M: windows-ui-backend do-events style 0 ex-style AdjustWindowRectEx win32-error=0/f ; : make-RECT ( world -- RECT ) - dup window-loc>> { 40 40 } vmax dup rot rect-dim v+ + dup window-loc>> dup rot rect-dim v+ "RECT" over first over set-RECT-right swap second over set-RECT-bottom over first over set-RECT-left swap second over set-RECT-top ; +: default-position-RECT ( RECT -- ) + dup get-RECT-dimensions [ 2drop ] 2dip + CW_USEDEFAULT + pick set-RECT-bottom + CW_USEDEFAULT + over set-RECT-right + CW_USEDEFAULT over set-RECT-left + CW_USEDEFAULT swap set-RECT-top ; + : make-adjusted-RECT ( rect -- RECT ) - make-RECT dup adjust-RECT ; + make-RECT + dup get-RECT-top-left [ zero? ] both? swap + dup adjust-RECT + swap [ dup default-position-RECT ] when ; : create-window ( rect -- hwnd ) make-adjusted-RECT From ded36a2279397c32ff33ff652416df0bfbea9206 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 28 Sep 2008 21:55:40 -0500 Subject: [PATCH 112/244] Fix GC bug --- vm/types.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/vm/types.c b/vm/types.c index 3097ee73f8..ccc7cbdba3 100755 --- a/vm/types.c +++ b/vm/types.c @@ -470,6 +470,7 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill) UNREGISTER_UNTAGGED(new_string); UNREGISTER_UNTAGGED(string); + write_barrier((CELL)new_string); new_string->aux = tag_object(new_aux); F_BYTE_ARRAY *aux = untag_object(string->aux); @@ -477,7 +478,9 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill) } REGISTER_UNTAGGED(string); + REGISTER_UNTAGGED(new_string); fill_string(new_string,to_copy,capacity,fill); + UNREGISTER_UNTAGGED(new_string); UNREGISTER_UNTAGGED(string); return new_string; From e62f068db7203dec4a6eb851a2f683e060cce38e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 04:09:02 -0500 Subject: [PATCH 113/244] html.streams now emits clickable URLs for $url markup elements --- basis/help/markup/markup.factor | 5 ++++- basis/html/streams/streams-docs.factor | 6 +++--- basis/html/streams/streams-tests.factor | 4 ++-- basis/html/streams/streams.factor | 9 ++++++--- basis/io/styles/styles.factor | 2 ++ 5 files changed, 17 insertions(+), 9 deletions(-) diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index b5e074b598..1eae56cfcc 100755 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -71,7 +71,10 @@ ALIAS: $slot $snippet [ strong-style get print-element* ] ($span) ; : $url ( children -- ) - [ url-style get print-element* ] ($span) ; + [ + dup first href associate url-style get assoc-union + print-element* + ] ($span) ; : $nl ( children -- ) nl nl drop ; diff --git a/basis/html/streams/streams-docs.factor b/basis/html/streams/streams-docs.factor index d7638a2817..f05eeb30fc 100644 --- a/basis/html/streams/streams-docs.factor +++ b/basis/html/streams/streams-docs.factor @@ -13,13 +13,13 @@ HELP: { $values { "stream" "an output stream" } { "html-stream" html-stream } } { $description "Creates a new formatted output stream which emits HTML markup on " { $snippet "stream" } "." } ; -HELP: with-html-stream +HELP: with-html-writer { $values { "quot" quotation } } { $description "Calls the quotation in a new dynamic scope with " { $link output-stream } " rebound to an " { $link html-stream } " wrapping the current " { $link output-stream } "." } { $examples { $example "USING: io io.styles html.streams ;" - "[ \"Hello\" { { font-style bold } } format nl ] with-html-stream" + "[ \"Hello\" { { font-style bold } } format nl ] with-html-writer" "Hello
" } } ; @@ -28,6 +28,6 @@ ARTICLE: "html.streams" "HTML streams" "The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "styles" } " by writing HTML markup to the wrapped stream." { $subsection html-stream } { $subsection } -{ $subsection with-html-stream } ; +{ $subsection with-html-writer } ; ABOUT: "html.streams" diff --git a/basis/html/streams/streams-tests.factor b/basis/html/streams/streams-tests.factor index b5707c158f..94229b3aea 100644 --- a/basis/html/streams/streams-tests.factor +++ b/basis/html/streams/streams-tests.factor @@ -4,7 +4,7 @@ xml.writer sbufs sequences inspector colors ; IN: html.streams.tests : make-html-string - [ with-html-stream ] with-string-writer ; inline + [ with-html-writer ] with-string-writer ; inline [ [ ] make-html-string ] must-infer @@ -71,4 +71,4 @@ M: funky browser-link-href [ H{ } [ ] with-nesting nl ] make-html-string ] unit-test -[ ] [ [ { 1 2 3 } describe ] with-html-stream ] unit-test +[ ] [ [ { 1 2 3 } describe ] with-html-writer ] unit-test diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor index 7d0fe9b17c..6874dc2edd 100755 --- a/basis/html/streams/streams.factor +++ b/basis/html/streams/streams.factor @@ -22,7 +22,7 @@ TUPLE: html-stream stream last-div ; : not-a-div ( stream -- stream ) f >>last-div ; inline -: a-div ( stream -- straem ) +: a-div ( stream -- stream ) t >>last-div ; inline : ( stream -- html-stream ) @@ -48,6 +48,9 @@ TUPLE: html-sub-stream < html-stream style parent ; ] [ call ] if* ] [ call ] if* ; inline +: href-link-tag ( style quot -- ) + href pick at [ call ] [ call ] if* ; inline + : hex-color, ( color -- ) [ red>> ] [ green>> ] [ blue>> ] tri [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] tri@ ; @@ -95,7 +98,7 @@ TUPLE: html-sub-stream < html-stream style parent ; : format-html-span ( string style stream -- ) stream>> [ - [ [ drop write ] span-tag ] object-link-tag + [ [ [ drop write ] span-tag ] href-link-tag ] object-link-tag ] with-output-stream* ; TUPLE: html-span-stream < html-sub-stream ; @@ -192,5 +195,5 @@ M: html-stream stream-write-table M: html-stream dispose stream>> dispose ; -: with-html-stream ( quot -- ) +: with-html-writer ( quot -- ) output-stream get swap with-output-stream* ; inline diff --git a/basis/io/styles/styles.factor b/basis/io/styles/styles.factor index b0eb327927..c9ba8f66df 100644 --- a/basis/io/styles/styles.factor +++ b/basis/io/styles/styles.factor @@ -20,6 +20,8 @@ SYMBOL: presented SYMBOL: presented-path SYMBOL: presented-printer +SYMBOL: href + ! Paragraph styles SYMBOL: page-color SYMBOL: border-color From df88e5a974ad05415b51aeff49b5b42c8ec1e0e9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 04:09:13 -0500 Subject: [PATCH 114/244] Add :error word --- basis/debugger/debugger.factor | 3 +++ 1 file changed, 3 insertions(+) diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 20e0703ce0..ec93a01c19 100755 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -22,6 +22,9 @@ M: tuple error-help class ; M: string error. print ; +: :error ( -- ) + error get error. ; + : :s ( -- ) error-continuation get data>> stack. ; From 46a530c58ea5ae23460d30127e506fb87681c35d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 04:09:21 -0500 Subject: [PATCH 115/244] Add limits to see --- basis/prettyprint/prettyprint.factor | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index d41a68f0c4..c7be48084f 100755 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -230,10 +230,14 @@ M: word declarations. : pprint-; ( -- ) \ ; pprint-word ; : (see) ( spec -- ) - - dup definer nip [ pprint-word ] when* declarations. - block> ; + [ + 12 nesting-limit set + 100 length-limit set + + dup definer nip [ pprint-word ] when* declarations. + block> + ] with-scope ; M: object see [ (see) ] with-use nl ; From dc1d7c76b7d656760511a4e1b13ce7f4549cdf34 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 04:10:00 -0500 Subject: [PATCH 116/244] Clean up some web framework code --- basis/furnace/chloe-tags/chloe-tags.factor | 11 ++++++-- basis/html/components/components-docs.factor | 2 +- basis/html/components/components-tests.factor | 2 +- basis/html/components/components.factor | 8 +++--- basis/html/elements/elements.factor | 11 +++++--- basis/html/templates/chloe/chloe-docs.factor | 16 +++++------ basis/html/templates/chloe/chloe.factor | 27 +++++++++---------- .../chloe/components/components.factor | 18 +++++-------- basis/http/server/server.factor | 4 +-- basis/http/server/static/static.factor | 2 +- 10 files changed, 52 insertions(+), 49 deletions(-) diff --git a/basis/furnace/chloe-tags/chloe-tags.factor b/basis/furnace/chloe-tags/chloe-tags.factor index 0cd1d6bd38..697c885a01 100644 --- a/basis/furnace/chloe-tags/chloe-tags.factor +++ b/basis/furnace/chloe-tags/chloe-tags.factor @@ -59,8 +59,12 @@ CHLOE: write-atom drop [ write-atom-feeds ] [code] ; attrs>> '[ [ [ _ ] dip link-attr ] each-responder ] [code] ; : a-start-tag ( tag -- ) - [ compile-link-attrs ] [ compile-a-url ] bi - [ ] [code] ; + [ ] [code] ; : a-end-tag ( tag -- ) drop [ ] [code] ; @@ -70,6 +74,9 @@ CHLOE: a [ a-start-tag ] [ compile-children ] [ a-end-tag ] tri ] compile-with-scope ; +CHLOE: base + compile-a-url [ ] [code] ; + : compile-hidden-form-fields ( for -- ) '[
diff --git a/basis/html/components/components-docs.factor b/basis/html/components/components-docs.factor index d7690b30e2..d131cc3e03 100644 --- a/basis/html/components/components-docs.factor +++ b/basis/html/components/components-docs.factor @@ -29,7 +29,7 @@ HELP: textarea { $class-description "Text area components display a multi-line editor for a string value. The " { $slot "rows" } " and " { $slot "cols" } " properties determine the size of the text area." } ; HELP: link -{ $description "Link components render a link to an object stored at a value, with the link title and URL determined by the " { $link link-title } " and " { $link link-href } " generic words." } ; +{ $description "Link components render a link to an object stored at a value, with the link title and URL determined by the " { $link link-title } " and " { $link link-href } " generic words. The optional " { $slot "target" } " slot is a target frame to open the link in." } ; HELP: link-title { $values { "obj" object } { "string" string } } diff --git a/basis/html/components/components-tests.factor b/basis/html/components/components-tests.factor index 56c7118ab9..c0b7eec914 100644 --- a/basis/html/components/components-tests.factor +++ b/basis/html/components/components-tests.factor @@ -163,7 +163,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ t ] [ [ "object" inspector render ] with-string-writer - [ "object" value [ describe ] with-html-stream ] with-string-writer + [ "object" value [ describe ] with-html-writer ] with-string-writer = ] unit-test diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index 18e1aad9eb..dafc9dd06b 100644 --- a/basis/html/components/components.factor +++ b/basis/html/components/components.factor @@ -126,11 +126,11 @@ M: string link-href ; M: url link-title ; M: url link-href ; -SINGLETON: link +TUPLE: link target ; M: link render* - 2drop - + nip + > [ =target ] when* dup link-href =href a> link-title present escape-string write ; @@ -169,7 +169,7 @@ M: farkup render* SINGLETON: inspector M: inspector render* - 2drop [ describe ] with-html-stream ; + 2drop [ describe ] with-html-writer ; ! Diff component SINGLETON: comparison diff --git a/basis/html/elements/elements.factor b/basis/html/elements/elements.factor index c7281df54d..0ee6955e29 100644 --- a/basis/html/elements/elements.factor +++ b/basis/html/elements/elements.factor @@ -113,6 +113,7 @@ SYMBOL: html "hr" "link" "img" + "base" ] [ define-open-html-word ] each ! Define some attributes @@ -124,7 +125,7 @@ SYMBOL: html "width" "selected" "onsubmit" "xmlns" "lang" "xml:lang" "media" "title" "multiple" "checked" "summary" "cellspacing" "align" "scope" "abbr" - "nofollow" "alt" + "nofollow" "alt" "target" ] [ define-attribute-word ] each >> @@ -133,12 +134,16 @@ SYMBOL: html "" write-html "" write-html ; -: simple-page ( title quot -- ) +: simple-page ( title head-quot body-quot -- ) #! Call the quotation, with all output going to the #! body of an html page with the given title. + spin xhtml-preamble - swap write + + write + call + call ; inline diff --git a/basis/html/templates/chloe/chloe-docs.factor b/basis/html/templates/chloe/chloe-docs.factor index b97a4c5c35..f390aad238 100644 --- a/basis/html/templates/chloe/chloe-docs.factor +++ b/basis/html/templates/chloe/chloe-docs.factor @@ -27,13 +27,9 @@ HELP: CHLOE: { $values { "name" "the tag name" } { "definition" "a quotation with stack effect " { $snippet "( tag -- )" } } } { $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ; -HELP: CHLOE-SINGLETON: -{ $syntax "CHLOE-SINGLETON: name" } -{ $description "Defines a Chloe tag named " { $snippet "name" } " rendering an HTML component with singleton class word " { $snippet "name" } ". See " { $link "html.components" } "." } ; - -HELP: CHLOE-TUPLE: -{ $syntax "CHLOE-TUPLE: name" } -{ $description "Defines a Chloe tag named " { $snippet "name" } " rendering an HTML component with tuple class word " { $snippet "name" } ". See " { $link "html.components" } "." } ; +HELP: COMPONENT: +{ $syntax "COMPONENT: name" } +{ $description "Defines a Chloe tag named " { $snippet "name" } " rendering the HTML component with class word " { $snippet "name" } ". See " { $link "html.components" } "." } ; HELP: reset-cache { $description "Resets the compiled template cache. Chloe automatically recompiles templates when their file changes on disk, however other when redefining Chloe tags or words which they call, the cache may have to be reset manually for the changes to take effect." } ; @@ -135,6 +131,7 @@ ARTICLE: "html.templates.chloe.tags.form" "Chloe link and form tags" "s" } } } + { { $snippet "t:base" } { "Outputs an HTML " { $snippet "" } " tag. The attributes are interpreted in the same manner as the attributes of " { $snippet "t:a" } "." } } { { $snippet "t:form" } { "Renders a form; extends the standard XHTML " { $snippet "form" } " tag by providing some integration with other web framework features, for example by adding hidden fields for authentication credentials and session management allowing those features to work with form submission transparently. The following attributes are supported:" { $list @@ -264,14 +261,13 @@ ARTICLE: "html.templates.chloe.extend.components.example" "An example of a custo "Now we define a method on the " { $link render* } " generic word which renders the image using " { $vocab-link "html.elements" } ":" { $code "M: image render* 2drop ;" } "Finally, we can define a Chloe component:" -{ $code "CHLOE-SINGLETON: image" } +{ $code "COMPONENT: image" } "We can use it as follows, assuming the current form has a value named " { $snippet "image" } ":" { $code "" } ; ARTICLE: "html.templates.chloe.extend.components" "Extending Chloe with custom components" "Custom HTML components implementing the " { $link render* } " word can be wired up with Chloe using the following syntax from " { $vocab-link "html.templates.chloe.components" } ":" -{ $subsection POSTPONE: CHLOE-SINGLETON: } -{ $subsection POSTPONE: CHLOE-TUPLE: } +{ $subsection POSTPONE: COMPONENT: } { $subsection "html.templates.chloe.extend.components.example" } ; ARTICLE: "html.templates.chloe" "Chloe templates" diff --git a/basis/html/templates/chloe/chloe.factor b/basis/html/templates/chloe/chloe.factor index e83040b00d..1bc4684d5c 100644 --- a/basis/html/templates/chloe/chloe.factor +++ b/basis/html/templates/chloe/chloe.factor @@ -78,20 +78,19 @@ CHLOE: call-next-template CHLOE: if dup if>quot [ swap when ] append process-children ; -CHLOE-SINGLETON: label -CHLOE-SINGLETON: link -CHLOE-SINGLETON: inspector -CHLOE-SINGLETON: comparison -CHLOE-SINGLETON: html -CHLOE-SINGLETON: hidden - -CHLOE-TUPLE: farkup -CHLOE-TUPLE: field -CHLOE-TUPLE: textarea -CHLOE-TUPLE: password -CHLOE-TUPLE: choice -CHLOE-TUPLE: checkbox -CHLOE-TUPLE: code +COMPONENT: label +COMPONENT: link +COMPONENT: inspector +COMPONENT: comparison +COMPONENT: html +COMPONENT: hidden +COMPONENT: farkup +COMPONENT: field +COMPONENT: textarea +COMPONENT: password +COMPONENT: choice +COMPONENT: checkbox +COMPONENT: code SYMBOL: template-cache diff --git a/basis/html/templates/chloe/components/components.factor b/basis/html/templates/chloe/components/components.factor index 77d7c937be..3041120d43 100644 --- a/basis/html/templates/chloe/components/components.factor +++ b/basis/html/templates/chloe/components/components.factor @@ -1,35 +1,31 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs sequences kernel parser fry quotations -classes.tuple +classes.tuple classes.singleton html.components html.templates.chloe.compiler html.templates.chloe.syntax ; IN: html.templates.chloe.components + +GENERIC: component-tag ( tag class -- ) -: singleton-component-tag ( tag class -- ) +M: singleton-class component-tag ( tag class -- ) [ "name" required-attr compile-attr ] [ literalize [ render ] [code-with] ] bi* ; -: CHLOE-SINGLETON: - scan-word - [ name>> ] [ '[ _ singleton-component-tag ] ] bi - define-chloe-tag ; - parsing - : compile-component-attrs ( tag class -- ) [ attrs>> [ drop main>> "name" = not ] assoc-filter ] dip [ all-slots swap '[ name>> _ at compile-attr ] each ] [ [ boa ] [code-with] ] bi ; -: tuple-component-tag ( tag class -- ) +M: tuple-class component-tag ( tag class -- ) [ drop "name" required-attr compile-attr ] [ compile-component-attrs ] 2bi [ render ] [code] ; -: CHLOE-TUPLE: +: COMPONENT: scan-word - [ name>> ] [ '[ _ tuple-component-tag ] ] bi + [ name>> ] [ '[ _ component-tag ] ] bi define-chloe-tag ; parsing diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 64c85a24d2..518081899e 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -153,8 +153,8 @@ main-responder global [ <404> or ] change-at [ add-responder-nesting ] [ call-responder* ] 2bi ; : http-error. ( error -- ) - "Internal server error" [ - [ print-error nl :c ] with-html-stream + "Internal server error" [ ] [ + [ print-error nl :c ] with-html-writer ] simple-page ; : <500> ( error -- response ) diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index abb504ed94..5ae18156b0 100755 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -60,7 +60,7 @@ TUPLE: file-responder root hook special allow-listings ; dup escape-string write ; : directory. ( path -- ) - dup file-name [ + dup file-name [ ] [ [

file-name escape-string write

] [
    From edc7aa3908bd7cd76a636f45a851d1a13bbd627a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 04:10:20 -0500 Subject: [PATCH 117/244] Working on help webapp --- basis/help/html/html-tests.factor | 5 ++ basis/help/html/html.factor | 101 ++++++++++++++++++++++++++++++ basis/help/html/stylesheet.css | 4 ++ extra/webapps/help/help.factor | 38 +++++++++++ extra/webapps/help/help.xml | 20 ++++++ extra/webapps/help/search.xml | 53 ++++++++++++++++ 6 files changed, 221 insertions(+) create mode 100644 basis/help/html/html-tests.factor create mode 100644 basis/help/html/stylesheet.css create mode 100644 extra/webapps/help/help.factor create mode 100644 extra/webapps/help/help.xml create mode 100644 extra/webapps/help/search.xml diff --git a/basis/help/html/html-tests.factor b/basis/help/html/html-tests.factor new file mode 100644 index 0000000000..475b2114b3 --- /dev/null +++ b/basis/help/html/html-tests.factor @@ -0,0 +1,5 @@ +IN: help.html.tests +USING: html.streams classes.predicate help.topics help.markup +io.streams.string accessors prettyprint kernel tools.test ; + +[ ] [ [ [ \ predicate-instance? def>> . ] with-html-writer ] with-string-writer drop ] unit-test diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index b1bf8958a8..1e5d672658 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -1,5 +1,106 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary +io.files html.streams html.elements html.components help kernel +assocs sequences make words accessors arrays help.topics vocabs +tools.vocabs tools.vocabs.browser namespaces prettyprint io +vocabs.loader serialize fry memoize unicode.case ; IN: help.html +: escape-char ( ch -- ) + dup H{ + { CHAR: " "__quote__" } + { CHAR: * "__star__" } + { CHAR: : "__colon__" } + { CHAR: < "__lt__" } + { CHAR: > "__gt__" } + { CHAR: ? "__question__" } + { CHAR: \\ "__backslash__" } + { CHAR: | "__pipe__" } + { CHAR: _ "__underscore__" } + { CHAR: / "__slash__" } + { CHAR: \\ "__backslash__" } + { CHAR: , "__comma__" } + } at [ % ] [ , ] ?if ; +: escape-filename ( string -- filename ) + [ [ escape-char ] each ] "" make ; + +GENERIC: topic>filename* ( topic -- name prefix ) + +M: word topic>filename* [ name>> ] [ vocabulary>> ] bi 2array "word" ; +M: link topic>filename* name>> "article" ; +M: word-link topic>filename* name>> topic>filename* ; +M: vocab-spec topic>filename* vocab-name "vocab" ; +M: vocab-tag topic>filename* name>> "tag" ; +M: vocab-author topic>filename* name>> "author" ; + +: topic>filename ( topic -- filename ) + [ + topic>filename* % "-" % + dup array? + [ [ escape-filename ] map "," join ] + [ escape-filename ] + if % ".html" % + ] "" make ; + +M: topic browser-link-href topic>filename ; + +: help-stylesheet ( -- ) + "resource:basis/help/html/stylesheet.css" ascii file-contents write ; + +: help>html ( topic -- ) + dup topic>filename utf8 [ + dup article-title + [ ] + [ [ help ] with-html-writer ] simple-page + ] with-file-writer ; + +: all-vocabs-really ( -- seq ) + #! Hack. + all-vocabs values concat + vocabs [ find-vocab-root not ] filter [ vocab ] map append ; + +: all-topics ( -- topics ) + [ + ! articles get keys [ >link ] map % + ! all-words [ >link ] map % + ! all-authors [ ] map % + all-tags [ ] map % + ! all-vocabs-really % + ] { } make ; + +: serialize-index ( index file -- ) + [ [ [ topic>filename ] dip ] { } assoc-map-as object>bytes ] dip + binary set-file-contents ; + +: generate-indices ( -- ) + articles get keys [ [ >link ] [ article-title ] bi ] { } map>assoc "articles.idx" serialize-index + all-words [ dup name>> ] { } map>assoc "words.idx" serialize-index + all-vocabs-really [ dup vocab-name ] { } map>assoc "vocabs.idx" serialize-index ; + +: generate-help ( -- ) + all-topics [ help>html ] each ; + +MEMO: load-index ( name -- index ) + binary file-contents bytes>object ; + +TUPLE: result title href ; + +M: result link-title title>> ; + +M: result link-href href>> ; + +: offline-apropos ( string index -- results ) + load-index swap >lower + '[ [ drop _ ] dip >lower subseq? ] assoc-filter + [ swap result boa ] { } assoc>map ; + +: article-apropos ( string -- results ) + "articles.idx" offline-apropos ; + +: word-apropos ( string -- results ) + "words.idx" offline-apropos ; + +: vocab-apropos ( string -- results ) + "vocabs.idx" offline-apropos ; diff --git a/basis/help/html/stylesheet.css b/basis/help/html/stylesheet.css new file mode 100644 index 0000000000..ff657d634e --- /dev/null +++ b/basis/help/html/stylesheet.css @@ -0,0 +1,4 @@ +a:link { text-decoration: none; color: #00004c; } +a:visited { text-decoration: none; color: #00004c; } +a:active { text-decoration: none; color: #00004c; } +a:hover { text-decoration: underline; color: #00004c; } diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor new file mode 100644 index 0000000000..e9b6a48634 --- /dev/null +++ b/extra/webapps/help/help.factor @@ -0,0 +1,38 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors http.server.dispatchers +http.server.static furnace.actions furnace.redirection urls +validators locals io.files html.forms help.html ; +IN: webapps.help + +TUPLE: help-webapp < dispatcher ; + +:: ( help-dir -- action ) + + { help-webapp "search" } >>template + + [ + { + { "search" [ 2 v-min-length 50 v-max-length v-one-line ] } + } validate-params + + help-dir set-current-directory + + "search" value article-apropos "articles" set-value + "search" value word-apropos "words" set-value + "search" value vocab-apropos "vocabs" set-value + + { help-webapp "search" } + ] >>submit ; + +: ( -- action ) + + { help-webapp "help" } >>template ; + +: ( help-dir -- webapp ) + help-webapp new-dispatcher + "" add-responder + over "search" add-responder + swap "content" add-responder ; + + diff --git a/extra/webapps/help/help.xml b/extra/webapps/help/help.xml new file mode 100644 index 0000000000..f71db15e19 --- /dev/null +++ b/extra/webapps/help/help.xml @@ -0,0 +1,20 @@ + + + + + + + + Factor Documentation + + + + + + + + + + diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml new file mode 100644 index 0000000000..b763f11f88 --- /dev/null +++ b/extra/webapps/help/search.xml @@ -0,0 +1,53 @@ + + + + + + + + + + + + +

    Factor documentation

    + + + + + + + +

    Articles

    + +
      + +
      • +       +
    +     + + +

    Vocabularies

    + +
      + +
      • +       +
    +     + + +

    Words

    + +
      + +
      • +       +
    +     + + + + +     From 55f46957afa4bd2f28169ca35ffcbd59223862ad Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 04:10:29 -0500 Subject: [PATCH 118/244] Update --- extra/websites/concatenative/concatenative.factor | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index cc2b960f9f..4e6baa7271 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -38,6 +38,10 @@ IN: websites.concatenative TUPLE: factor-website < dispatcher ; +: ( responder -- responder' ) + + { factor-website "page" } >>template ; + : ( responder -- responder' ) "Factor website" "Factor website" >>name @@ -45,8 +49,6 @@ TUPLE: factor-website < dispatcher ; allow-password-recovery allow-edit-profile allow-deactivation - - { factor-website "page" } >>template test-db ; : ( -- responder ) @@ -74,15 +76,16 @@ SYMBOL: dh-file "pastebin" add-responder "planet" add-responder + main-responder set-global ; : init-production ( -- ) common-configuration - "concatenative.org" add-responder - "paste.factorcode.org" add-responder - "planet.factorcode.org" add-responder + "concatenative.org" add-responder + "paste.factorcode.org" add-responder + "planet.factorcode.org" add-responder main-responder set-global ; From bbd8c8cb899f4f33f19084c82df277fb324e32ee Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 04:23:42 -0500 Subject: [PATCH 119/244] Finishing up with help.html --- basis/help/html/html.factor | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 1e5d672658..763cc68c42 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -63,11 +63,11 @@ M: topic browser-link-href topic>filename ; : all-topics ( -- topics ) [ - ! articles get keys [ >link ] map % - ! all-words [ >link ] map % - ! all-authors [ ] map % + articles get keys [ >link ] map % + all-words [ >link ] map % + all-authors [ ] map % all-tags [ ] map % - ! all-vocabs-really % + all-vocabs-really % ] { } make ; : serialize-index ( index file -- ) @@ -79,9 +79,19 @@ M: topic browser-link-href topic>filename ; all-words [ dup name>> ] { } map>assoc "words.idx" serialize-index all-vocabs-really [ dup vocab-name ] { } map>assoc "vocabs.idx" serialize-index ; -: generate-help ( -- ) +: generate-help-files ( -- ) all-topics [ help>html ] each ; +: generate-help ( -- ) + { "resource:core" "resource:basis" "resource:extra" } vocab-roots [ + load-everything + + "/tmp/docs/" [ + generate-indices + generate-help-files + ] with-directory + ] with-variable ; + MEMO: load-index ( name -- index ) binary file-contents bytes>object ; From a75622f8136af702156343493b9eb4be0ca0133c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 05:03:05 -0500 Subject: [PATCH 120/244] Tweaking help webapp --- basis/help/html/html.factor | 2 ++ extra/webapps/help/help.xml | 2 +- extra/webapps/help/search.xml | 28 ++++++++++++++++++++++++---- 3 files changed, 27 insertions(+), 5 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 763cc68c42..d14db69c5a 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -86,6 +86,8 @@ M: topic browser-link-href topic>filename ; { "resource:core" "resource:basis" "resource:extra" } vocab-roots [ load-everything + "/tmp/docs/" make-directory + "/tmp/docs/" [ generate-indices generate-help-files diff --git a/extra/webapps/help/help.xml b/extra/webapps/help/help.xml index f71db15e19..f4262a6f6a 100644 --- a/extra/webapps/help/help.xml +++ b/extra/webapps/help/help.xml @@ -11,7 +11,7 @@ - + diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index b763f11f88..b5c6eb3fac 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -7,18 +7,34 @@ + + -

    Factor documentation

    +

    Factor help

    +

    This documentation was generated offline from a Factor + image where load-everything was run.

    + +

    You may search article titles below.

    + -

    Articles

    +
    + +

    Articles

      @@ -28,7 +44,9 @@ -

      Vocabularies

      +
      + +

      Vocabularies

        @@ -38,7 +56,9 @@ -

        Words

        +
        + +

        Words

          From 6faa17289558a845ef0776a2c6d390ffca23cefa Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 05:08:16 -0500 Subject: [PATCH 121/244] Sort search results, better template --- basis/help/html/html.factor | 6 ++++-- extra/webapps/help/search.xml | 8 +++++--- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index d14db69c5a..525db1352f 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -4,7 +4,8 @@ USING: io.encodings.utf8 io.encodings.ascii io.encodings.binary io.files html.streams html.elements html.components help kernel assocs sequences make words accessors arrays help.topics vocabs tools.vocabs tools.vocabs.browser namespaces prettyprint io -vocabs.loader serialize fry memoize unicode.case ; +vocabs.loader serialize fry memoize unicode.case math.order +sorting ; IN: help.html : escape-char ( ch -- ) @@ -106,7 +107,8 @@ M: result link-href href>> ; : offline-apropos ( string index -- results ) load-index swap >lower '[ [ drop _ ] dip >lower subseq? ] assoc-filter - [ swap result boa ] { } assoc>map ; + [ swap result boa ] { } assoc>map + [ [ title>> ] compare ] sort ; : article-apropos ( string -- results ) "articles.idx" offline-apropos ; diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index b5c6eb3fac..5569698dc6 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -19,10 +19,12 @@

          Factor help

          + target="content">Factor documentation -

          This documentation was generated offline from a Factor - image where load-everything was run.

          +

          This is the Factor + documentation, generated offline from a + load-everything image. The Factor UI also + includes a documentation browser tool.

          You may search article titles below.

          From b1ad927d6935c4746f4bd8a4bd719aa6aabb5c63 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 05:13:44 -0500 Subject: [PATCH 122/244] Add help --- extra/websites/concatenative/concatenative.factor | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 4e6baa7271..1be59e9868 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -20,7 +20,8 @@ furnace.redirection webapps.pastebin webapps.planet webapps.wiki -webapps.user-admin ; +webapps.user-admin +webapps.help ; IN: websites.concatenative : test-db ( -- params db ) "resource:test.db" sqlite-db ; @@ -76,6 +77,7 @@ SYMBOL: dh-file "pastebin" add-responder "planet" add-responder + "docs" add-responder main-responder set-global ; @@ -86,6 +88,7 @@ SYMBOL: dh-file "concatenative.org" add-responder "paste.factorcode.org" add-responder "planet.factorcode.org" add-responder + "docs.factorcode.org" add-responder main-responder set-global ; From cdc39718fdf3322bab2b37859d4348a5e6ba7d48 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 05:14:34 -0500 Subject: [PATCH 123/244] Fix stack effect --- extra/websites/concatenative/concatenative.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 1be59e9868..71fc1116b3 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -77,7 +77,7 @@ SYMBOL: dh-file "pastebin" add-responder "planet" add-responder - "docs" add-responder + "/tmp/docs/" "docs" add-responder main-responder set-global ; @@ -88,7 +88,7 @@ SYMBOL: dh-file "concatenative.org" add-responder "paste.factorcode.org" add-responder "planet.factorcode.org" add-responder - "docs.factorcode.org" add-responder + home "docs" append-path "docs.factorcode.org" add-responder main-responder set-global ; From 372d7d49f9ab2d8aa92ad97591f13d5597a9836a Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 29 Sep 2008 11:41:01 -0700 Subject: [PATCH 124/244] Fix typos in basis/ui/grids/grids-docs. --- basis/ui/gadgets/grids/grids-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/ui/gadgets/grids/grids-docs.factor b/basis/ui/gadgets/grids/grids-docs.factor index 64e14c4961..1c00bedea8 100755 --- a/basis/ui/gadgets/grids/grids-docs.factor +++ b/basis/ui/gadgets/grids/grids-docs.factor @@ -6,7 +6,7 @@ ARTICLE: "ui-grid-layout" "Grid layouts" { $subsection grid } "Creating grids from a fixed set of gadgets:" { $subsection } -"Managing chidren:" +"Managing children:" { $subsection grid-add } { $subsection grid-remove } { $subsection grid-child } ; From 0476ca0eb15827122259c14718b52cfdef9696fd Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 29 Sep 2008 15:10:56 -0700 Subject: [PATCH 125/244] Cleaning up some bubble-chamber docs. --- .../bubble-chamber/bubble-chamber-docs.factor | 56 +++++++------------ 1 file changed, 19 insertions(+), 37 deletions(-) diff --git a/extra/bubble-chamber/bubble-chamber-docs.factor b/extra/bubble-chamber/bubble-chamber-docs.factor index 47331efd7e..72ffb63848 100644 --- a/extra/bubble-chamber/bubble-chamber-docs.factor +++ b/extra/bubble-chamber/bubble-chamber-docs.factor @@ -55,48 +55,30 @@ HELP: axion ARTICLE: "bubble-chamber" "Bubble Chamber" - { $subsection "bubble-chamber-introduction" } - { $subsection "bubble-chamber-particles" } - { $subsection "bubble-chamber-author" } - { $subsection "bubble-chamber-running" } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -ARTICLE: "bubble-chamber-introduction" "Introduction" - -"The Bubble Chamber is a generative painting system of imaginary " +"The " { $vocab-link "bubble-chamber" } +" is a generative painting system of imaginary " "colliding particles. A single super-massive collision produces a " "discrete universe of four particle types. Particles draw their " -"positions over time as pixel exposures. " ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -ARTICLE: "bubble-chamber-particles" "Particles" - +"positions over time as pixel exposures.\n" +"\n" "Four types of particles exist. The behavior and graphic appearance of " -"each particle type is unique." - +"each particle type is unique.\n" { $subsection muon } { $subsection quark } { $subsection hadron } - { $subsection axion } ; + { $subsection axion } +"\n" +"After you run the vocabulary, a window will appear. Click the " +"mouse in a random area to fire 11 particles of each type. " +"Another way to fire particles is to press the " +"spacebar. This fires all the particles.\n" +"\n" +"Bubble Chamber was created by Jared Tarbell. " +"It was originally implemented in Processing. " +"It was ported to Factor by Eduardo Cavazos. " +"The original work is on display here: " +{ $url +"http://www.complexification.net/gallery/machines/bubblechamber/" } ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +ABOUT: "bubble-chamber" -ARTICLE: "bubble-chamber-author" "Author" - - "Bubble Chamber was created by Jared Tarbell. " - "It was originally implemented in Processing. " - "It was ported to Factor by Eduardo Cavazos. " - "The original work is on display here: " - { $url - "http://www.complexification.net/gallery/machines/bubblechamber/" } ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -ARTICLE: "bubble-chamber-running" "How to use" - - "After you run the vocabulary, a window will appear. Click the " - "mouse in a random area to fire 11 particles of each type. " - "Another way to fire particles is to press the " - "spacebar. This fires all the particles." ; \ No newline at end of file From 011726f86345c031512577ff56b3f2b8fb892a7b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 17:15:03 -0500 Subject: [PATCH 126/244] Counter fix --- extra/webapps/counter/counter.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor index f49d8f008e..a5c9fbc6b9 100644 --- a/extra/webapps/counter/counter.factor +++ b/extra/webapps/counter/counter.factor @@ -27,8 +27,7 @@ M: counter-app init-session* drop 0 count sset ; counter-app new-dispatcher [ 1+ ] "inc" add-responder [ 1- ] "dec" add-responder - "" add-responder - ; + "" add-responder ; ! Deployment example USING: db.sqlite furnace.alloy namespaces ; From 27c565c5ea9181f544ef39040424350311f8961e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 17:16:47 -0500 Subject: [PATCH 127/244] Minor template fixes --- extra/webapps/help/search.xml | 2 +- extra/webapps/pastebin/pastebin-common.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index 5569698dc6..8335725ce5 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -21,7 +21,7 @@

          Factor documentation

          -

          This is the Factor +

          This is the Factor documentation, generated offline from a load-everything image. The Factor UI also includes a documentation browser tool.

          diff --git a/extra/webapps/pastebin/pastebin-common.xml b/extra/webapps/pastebin/pastebin-common.xml index b95f3f7b64..6d524ad86f 100644 --- a/extra/webapps/pastebin/pastebin-common.xml +++ b/extra/webapps/pastebin/pastebin-common.xml @@ -8,7 +8,7 @@
          - Pastes + Pastes | New Paste From 85b6e32681c3856eb72669e60b8c8f49feed2b46 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 19:43:04 -0500 Subject: [PATCH 128/244] Split off urls.encoding, fix query encoding --- basis/urls/encoding/authors.txt | 1 + basis/urls/encoding/encoding-docs.factor | 57 ++++++++++++++ basis/urls/encoding/encoding-tests.factor | 26 ++++++ basis/urls/encoding/encoding.factor | 96 +++++++++++++++++++++++ basis/urls/encoding/summary.txt | 1 + basis/urls/encoding/tags.txt | 1 + basis/urls/urls-docs.factor | 59 +------------- basis/urls/urls-tests.factor | 24 ------ basis/urls/urls.factor | 92 +--------------------- 9 files changed, 187 insertions(+), 170 deletions(-) create mode 100644 basis/urls/encoding/authors.txt create mode 100644 basis/urls/encoding/encoding-docs.factor create mode 100644 basis/urls/encoding/encoding-tests.factor create mode 100644 basis/urls/encoding/encoding.factor create mode 100644 basis/urls/encoding/summary.txt create mode 100644 basis/urls/encoding/tags.txt diff --git a/basis/urls/encoding/authors.txt b/basis/urls/encoding/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/urls/encoding/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/urls/encoding/encoding-docs.factor b/basis/urls/encoding/encoding-docs.factor new file mode 100644 index 0000000000..5ba94ea1bc --- /dev/null +++ b/basis/urls/encoding/encoding-docs.factor @@ -0,0 +1,57 @@ +IN: urls.encoding +USING: strings help.markup help.syntax assocs multiline ; + +HELP: url-decode +{ $values { "str" string } { "decoded" string } } +{ $description "Decodes a URL-encoded string." } ; + +HELP: url-encode +{ $values { "str" string } { "encoded" string } } +{ $description "URL-encodes a string." } ; + +HELP: url-quotable? +{ $values { "ch" "a character" } { "?" "a boolean" } } +{ $description "Tests if a character be used without URL-encoding in a URL." } ; + +HELP: assoc>query +{ $values { "assoc" assoc } { "str" string } } +{ $description "Converts an assoc of query parameters into a query string, performing URL encoding." } +{ $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP client to encode POST requests." } +{ $examples + { $example + "USING: io urls ;" + "{ { \"from\" \"Lead\" } { \"to\" \"Gold, please\" } }" + "assoc>query print" + "from=Lead&to=Gold%2c+please" + } +} ; + +HELP: query>assoc +{ $values { "query" string } { "assoc" assoc } } +{ $description "Parses a URL query string and URL-decodes each component." } +{ $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP server to parse POST requests." } +{ $examples + { $unchecked-example + "USING: prettyprint urls ;" + "\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\"" + "query>assoc ." + <" H{ + { "gender" "female" } + { "agefrom" "22" } + { "ageto" "28" } + { "location" "Omaha NE" } +}"> + } +} ; + +ARTICLE: "url-encoding" "URL encoding and decoding" +"URL encoding and decoding strings:" +{ $subsection url-encode } +{ $subsection url-decode } +{ $subsection url-quotable? } +"Encoding and decoding queries:" +{ $subsection assoc>query } +{ $subsection query>assoc } +"See " { $url "http://en.wikipedia.org/wiki/Percent-encoding" } " for a description of URL encoding." ; + +ABOUT: "url-encoding" diff --git a/basis/urls/encoding/encoding-tests.factor b/basis/urls/encoding/encoding-tests.factor new file mode 100644 index 0000000000..2217ec8a28 --- /dev/null +++ b/basis/urls/encoding/encoding-tests.factor @@ -0,0 +1,26 @@ +IN: urls.encoding.tests +USING: urls.encoding tools.test arrays kernel assocs present accessors ; + +[ "~hello world" ] [ "%7ehello world" url-decode ] unit-test +[ f ] [ "%XX%XX%XX" url-decode ] unit-test +[ f ] [ "%XX%XX%X" url-decode ] unit-test + +[ "hello world" ] [ "hello%20world" url-decode ] unit-test +[ " ! " ] [ "%20%21%20" url-decode ] unit-test +[ "hello world" ] [ "hello world%" url-decode ] unit-test +[ "hello world" ] [ "hello world%x" url-decode ] unit-test +[ "hello%20world" ] [ "hello world" url-encode ] unit-test + +[ "hello world" ] [ "hello+world" query-decode ] unit-test + +[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test + +[ "a=b&a=c" ] [ { { "a" { "b" "c" } } } assoc>query ] unit-test + +[ H{ { "a" "b" } } ] [ "a=b" query>assoc ] unit-test + +[ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test + +[ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test + +[ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test diff --git a/basis/urls/encoding/encoding.factor b/basis/urls/encoding/encoding.factor new file mode 100644 index 0000000000..2f89084488 --- /dev/null +++ b/basis/urls/encoding/encoding.factor @@ -0,0 +1,96 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel ascii combinators combinators.short-circuit +sequences splitting fry namespaces make assocs arrays strings +io.sockets io.sockets.secure io.encodings.string +io.encodings.utf8 math math.parser accessors hashtables present ; +IN: urls.encoding + +: url-quotable? ( ch -- ? ) + { + [ letter? ] + [ LETTER? ] + [ digit? ] + [ "/_-.:" member? ] + } 1|| ; foldable + +hex 2 CHAR: 0 pad-left % ] each ; + +PRIVATE> + +: url-encode ( str -- encoded ) + [ + [ dup url-quotable? [ , ] [ push-utf8 ] if ] each + ] "" make ; + += [ + 2drop + ] [ + [ 1+ dup 2 + ] dip subseq hex> [ , ] when* + ] if ; + +: url-decode-% ( index str -- index str ) + 2dup url-decode-hex ; + +: url-decode-iter ( index str -- ) + 2dup length >= [ + 2drop + ] [ + 2dup nth dup CHAR: % = [ + drop url-decode-% [ 3 + ] dip + ] [ + , [ 1+ ] dip + ] if url-decode-iter + ] if ; + +PRIVATE> + +: url-decode ( str -- decoded ) + [ 0 swap url-decode-iter ] "" make utf8 decode ; + +: query-decode ( str -- decoded ) + [ dup CHAR: + = [ drop "%20" ] [ 1string ] if ] { } map-as + concat url-decode ; + + + +: query>assoc ( query -- assoc ) + dup [ + "&" split H{ } clone [ + [ + [ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip + add-query-param + ] curry each + ] keep + ] when ; + +: assoc>query ( assoc -- str ) + [ + dup array? [ [ present ] map ] [ present 1array ] if + ] assoc-map + [ + [ + [ url-encode ] dip + [ url-encode "=" swap 3append , ] with each + ] assoc-each + ] { } make "&" join ; diff --git a/basis/urls/encoding/summary.txt b/basis/urls/encoding/summary.txt new file mode 100644 index 0000000000..d156e44c56 --- /dev/null +++ b/basis/urls/encoding/summary.txt @@ -0,0 +1 @@ +URL and form encoding/decoding diff --git a/basis/urls/encoding/tags.txt b/basis/urls/encoding/tags.txt new file mode 100644 index 0000000000..c0772185a0 --- /dev/null +++ b/basis/urls/encoding/tags.txt @@ -0,0 +1 @@ +web diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor index 166ad9d586..03ffaded05 100644 --- a/basis/urls/urls-docs.factor +++ b/basis/urls/urls-docs.factor @@ -46,37 +46,6 @@ HELP: URL" } } ; -HELP: assoc>query -{ $values { "assoc" assoc } { "str" string } } -{ $description "Converts an assoc of query parameters into a query string, performing URL encoding." } -{ $notes "This word is used to implement the " { $link present } " method on URLs; it is also used by the HTTP client to encode POST requests." } -{ $examples - { $example - "USING: io urls ;" - "{ { \"from\" \"Lead\" } { \"to\" \"Gold, please\" } }" - "assoc>query print" - "from=Lead&to=Gold%2c+please" - } -} ; - -HELP: query>assoc -{ $values { "query" string } { "assoc" assoc } } -{ $description "Parses a URL query string and URL-decodes each component." } -{ $notes "This word is used to implement " { $link >url } ". It is also used by the HTTP server to parse POST requests." } -{ $examples - { $unchecked-example - "USING: prettyprint urls ;" - "\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\"" - "query>assoc ." - <" H{ - { "gender" "female" } - { "agefrom" "22" } - { "ageto" "28" } - { "location" "Omaha NE" } -}"> - } -} ; - HELP: derive-url { $values { "base" url } { "url" url } { "url'" url } } { $description "Builds a URL by filling in missing components of " { $snippet "url" } " from " { $snippet "base" } "." } @@ -192,28 +161,7 @@ HELP: url-append-path { $values { "path1" string } { "path2" string } { "path" string } } { $description "Like " { $link append-path } ", but intended for use with URL paths and not filesystem paths." } ; -HELP: url-decode -{ $values { "str" string } { "decoded" string } } -{ $description "Decodes a URL-encoded string." } ; - -HELP: url-encode -{ $values { "str" string } { "encoded" string } } -{ $description "URL-encodes a string." } ; - -HELP: url-quotable? -{ $values { "ch" "a character" } { "?" "a boolean" } } -{ $description "Tests if a character be used without URL-encoding in a URL." } ; - -ARTICLE: "url-encoding" "URL encoding and decoding" -"URL encoding and decoding strings:" -{ $subsection url-encode } -{ $subsection url-decode } -{ $subsection url-quotable? } -"The URL implemention encodes and decodes components of " { $link url } " instances automatically, but sometimes it is required for non-URL strings. See " { $url "http://en.wikipedia.org/wiki/Percent-encoding" } " for a description of URL encoding." ; - ARTICLE: "url-utilities" "URL implementation utilities" -{ $subsection assoc>query } -{ $subsection query>assoc } { $subsection parse-host } { $subsection secure-protocol? } { $subsection url-append-path } ; @@ -240,8 +188,9 @@ $nl { $subsection set-query-param } "Creating " { $link "network-addressing" } " from URLs:" { $subsection url-addr } -"Additional topics:" -{ $subsection "url-utilities" } -{ $subsection "url-encoding" } ; +"The URL implemention encodes and decodes components of " { $link url } " instances automatically, but sometimes this functionality is needed for non-URL strings." +{ $subsection "url-encoding" } +"Utility words used by the URL implementation:" +{ $subsection "url-utilities" } ; ABOUT: "urls" diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index b0bf950178..cac206bf3c 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -2,30 +2,6 @@ IN: urls.tests USING: urls urls.private tools.test arrays kernel assocs present accessors ; -[ "hello+world" ] [ "hello world" url-encode ] unit-test -[ "hello world" ] [ "hello%20world" url-decode ] unit-test -[ "~hello world" ] [ "%7ehello+world" url-decode ] unit-test -[ f ] [ "%XX%XX%XX" url-decode ] unit-test -[ f ] [ "%XX%XX%X" url-decode ] unit-test - -[ "hello world" ] [ "hello+world" url-decode ] unit-test -[ "hello world" ] [ "hello%20world" url-decode ] unit-test -[ " ! " ] [ "%20%21%20" url-decode ] unit-test -[ "hello world" ] [ "hello world%" url-decode ] unit-test -[ "hello world" ] [ "hello world%x" url-decode ] unit-test -[ "hello+world" ] [ "hello world" url-encode ] unit-test -[ "+%21+" ] [ " ! " url-encode ] unit-test - -[ "\u001234hi\u002045" ] [ "\u001234hi\u002045" url-encode url-decode ] unit-test - -[ "a=b&a=c" ] [ { { "a" { "b" "c" } } } assoc>query ] unit-test - -[ H{ { "a" "b" } } ] [ "a=b" query>assoc ] unit-test - -[ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test - -[ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test - : urls { { diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 5fe9bbb5a0..5ebcabede8 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -5,99 +5,9 @@ sequences splitting fry namespaces make assocs arrays strings io.sockets io.sockets.secure io.encodings.string io.encodings.utf8 math math.parser accessors parser strings.parser lexer prettyprint.backend hashtables present -peg.ebnf ; +peg.ebnf urls.encoding ; IN: urls -: url-quotable? ( ch -- ? ) - { - [ letter? ] - [ LETTER? ] - [ digit? ] - [ "/_-.:" member? ] - } 1|| ; foldable - -hex 2 CHAR: 0 pad-left % ] each - ] if ; - -PRIVATE> - -: url-encode ( str -- encoded ) - [ - [ dup url-quotable? [ , ] [ push-utf8 ] if ] each - ] "" make ; - -= [ - 2drop - ] [ - [ 1+ dup 2 + ] dip subseq hex> [ , ] when* - ] if ; - -: url-decode-% ( index str -- index str ) - 2dup url-decode-hex [ 3 + ] dip ; - -: url-decode-+-or-other ( index str ch -- index str ) - dup CHAR: + = [ drop CHAR: \s ] when , [ 1+ ] dip ; - -: url-decode-iter ( index str -- ) - 2dup length >= [ - 2drop - ] [ - 2dup nth dup CHAR: % = [ - drop url-decode-% - ] [ - url-decode-+-or-other - ] if url-decode-iter - ] if ; - -PRIVATE> - -: url-decode ( str -- decoded ) - [ 0 swap url-decode-iter ] "" make utf8 decode ; - - - -: query>assoc ( query -- assoc ) - dup [ - "&" split H{ } clone [ - [ - [ "=" split1 [ dup [ url-decode ] when ] bi@ swap ] dip - add-query-param - ] curry each - ] keep - ] when ; - -: assoc>query ( assoc -- str ) - [ - dup array? [ [ present ] map ] [ present 1array ] if - ] assoc-map - [ - [ - [ url-encode ] dip - [ url-encode "=" swap 3append , ] with each - ] assoc-each - ] { } make "&" join ; - TUPLE: url protocol username password host port path query anchor ; : ( -- url ) url new ; From 399824edad892887d25e61d59110c82689c4a696 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 19:43:15 -0500 Subject: [PATCH 129/244] Remove reundant usings --- basis/farkup/farkup.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 959d53c904..73b0cba4d0 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators html.elements io -io.streams.string kernel math memoize namespaces peg peg.ebnf +io.streams.string kernel math namespaces peg peg.ebnf sequences sequences.deep strings xml.entities -vectors splitting xmode.code2html urls ; +vectors splitting xmode.code2html urls.encoding ; IN: farkup SYMBOL: relative-link-prefix From 2cf2dde83cd71bbd01406b932b267b6bc998eabe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 19:43:45 -0500 Subject: [PATCH 130/244] Don't boilerplate error pages --- basis/furnace/boilerplate/boilerplate.factor | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/basis/furnace/boilerplate/boilerplate.factor b/basis/furnace/boilerplate/boilerplate.factor index 59f71b1524..946372e1f8 100644 --- a/basis/furnace/boilerplate/boilerplate.factor +++ b/basis/furnace/boilerplate/boilerplate.factor @@ -17,16 +17,13 @@ TUPLE: boilerplate < filter-responder template init ; [ ] >>init ; : wrap-boilerplate? ( response -- ? ) - { - [ code>> { [ 200 = ] [ 400 499 between? ] } 1|| ] - [ content-type>> "text/html" = ] - } 1&& ; + { [ code>> 200 = ] [ content-type>> "text/html" = ] } 1&& ; M:: boilerplate call-responder* ( path responder -- ) begin-form path responder call-next-method responder init>> call - dup content-type>> "text/html" = [ + dup wrap-boilerplate? [ clone [| body | [ body From f9670ef3667c7a343d091bc588730493615ae0b0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 19:43:59 -0500 Subject: [PATCH 131/244] Fix HTML doc generation bugs --- basis/help/html/html.factor | 25 ++++++++++++++++--------- basis/html/streams/streams.factor | 8 +++++--- 2 files changed, 21 insertions(+), 12 deletions(-) diff --git a/basis/help/html/html.factor b/basis/help/html/html.factor index 525db1352f..386dca9576 100644 --- a/basis/help/html/html.factor +++ b/basis/help/html/html.factor @@ -29,21 +29,28 @@ IN: help.html GENERIC: topic>filename* ( topic -- name prefix ) -M: word topic>filename* [ name>> ] [ vocabulary>> ] bi 2array "word" ; -M: link topic>filename* name>> "article" ; +M: word topic>filename* + dup vocabulary>> [ + [ name>> ] [ vocabulary>> ] bi 2array "word" + ] [ drop f f ] if ; + +M: link topic>filename* name>> dup [ "article" ] [ topic>filename* ] if ; M: word-link topic>filename* name>> topic>filename* ; M: vocab-spec topic>filename* vocab-name "vocab" ; M: vocab-tag topic>filename* name>> "tag" ; M: vocab-author topic>filename* name>> "author" ; +M: f topic>filename* drop \ f topic>filename* ; : topic>filename ( topic -- filename ) - [ - topic>filename* % "-" % - dup array? - [ [ escape-filename ] map "," join ] - [ escape-filename ] - if % ".html" % - ] "" make ; + topic>filename* dup [ + [ + % "-" % + dup array? + [ [ escape-filename ] map "," join ] + [ escape-filename ] + if % ".html" % + ] "" make + ] [ 2drop f ] if ; M: topic browser-link-href topic>filename ; diff --git a/basis/html/streams/streams.factor b/basis/html/streams/streams.factor index 6874dc2edd..fa81a69bb4 100755 --- a/basis/html/streams/streams.factor +++ b/basis/html/streams/streams.factor @@ -4,7 +4,7 @@ USING: combinators generic assocs help http io io.styles io.files continuations io.streams.string kernel math math.order math.parser namespaces make quotations assocs sequences strings words html.elements xml.entities sbufs continuations destructors -accessors arrays ; +accessors arrays urls.encoding ; IN: html.streams GENERIC: browser-link-href ( presented -- href ) @@ -44,12 +44,14 @@ TUPLE: html-sub-stream < html-stream style parent ; : object-link-tag ( style quot -- ) presented pick at [ browser-link-href [ - call + call ] [ call ] if* ] [ call ] if* ; inline : href-link-tag ( style quot -- ) - href pick at [ call ] [ call ] if* ; inline + href pick at [ + call + ] [ call ] if* ; inline : hex-color, ( color -- ) [ red>> ] [ green>> ] [ blue>> ] tri From 9b045043acd434a0d224cb91455a4d8eaa3e34e6 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 19:48:12 -0500 Subject: [PATCH 132/244] Fixing bugs, cleaning up --- basis/html/components/components-tests.factor | 2 +- basis/prettyprint/prettyprint.factor | 13 ++++--------- 2 files changed, 5 insertions(+), 10 deletions(-) diff --git a/basis/html/components/components-tests.factor b/basis/html/components/components-tests.factor index c0b7eec914..b4247e6e30 100644 --- a/basis/html/components/components-tests.factor +++ b/basis/html/components/components-tests.factor @@ -134,7 +134,7 @@ M: link-test link-href drop "http://www.apple.com/foo&bar" ; [ ] [ link-test "link" set-value ] unit-test [ "<Link Title>" ] [ - [ "link" link render ] with-string-writer + [ "link" link new render ] with-string-writer ] unit-test [ ] [ diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor index c7be48084f..f63ce44c71 100755 --- a/basis/prettyprint/prettyprint.factor +++ b/basis/prettyprint/prettyprint.factor @@ -229,7 +229,7 @@ M: word declarations. : pprint-; ( -- ) \ ; pprint-word ; -: (see) ( spec -- ) +M: object see [ 12 nesting-limit set 100 length-limit set @@ -237,10 +237,7 @@ M: word declarations. dup definer nip [ pprint-word ] when* declarations. block> - ] with-scope ; - -M: object see - [ (see) ] with-use nl ; + ] with-use nl ; GENERIC: see-class* ( word -- ) @@ -328,10 +325,8 @@ M: word see dup class? over symbol? not and [ nl ] when - dup class? over symbol? and not [ - [ dup (see) ] with-use nl - ] when - drop ; + dup [ class? ] [ symbol? ] bi and + [ drop ] [ call-next-method ] if ; : see-all ( seq -- ) natural-sort [ nl ] [ see ] interleave ; From 845c30496d13ec492ee4c94f5bc1890029064d4d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 19:49:17 -0500 Subject: [PATCH 133/244] Update usings --- basis/http/client/client.factor | 2 +- basis/http/server/cgi/cgi.factor | 3 ++- basis/http/server/server.factor | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index e473ef4e26..174c4e1b3a 100755 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -10,7 +10,7 @@ io.encodings.ascii io.encodings.8-bit io.encodings.binary io.streams.duplex -fry debugger summary ascii urls present +fry debugger summary ascii urls urls.encoding present http http.parsers ; IN: http.client diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index 0a3cb5cff3..fb24fec8d9 100755 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs io.files io.streams.duplex combinators arrays io.launcher io http.server.static http.server -http accessors sequences strings math.parser fry urls ; +http accessors sequences strings math.parser fry urls +urls.encoding ; IN: http.server.cgi : cgi-variables ( script-path -- assoc ) diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 518081899e..547e1b69fb 100755 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -14,7 +14,7 @@ io.encodings.binary io.streams.limited io.servers.connection io.timeouts -fry logging logging.insomniac calendar urls +fry logging logging.insomniac calendar urls urls.encoding http http.parsers http.server.responses From 97c532414202db52272a87d60acd37632b5654fe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 20:09:31 -0500 Subject: [PATCH 134/244] Fix laod error --- basis/http/client/client-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/http/client/client-docs.factor b/basis/http/client/client-docs.factor index adab7caa44..ed846320c3 100644 --- a/basis/http/client/client-docs.factor +++ b/basis/http/client/client-docs.factor @@ -1,6 +1,6 @@ USING: http help.markup help.syntax io.files io.streams.string io.encodings.8-bit io.encodings.binary kernel strings urls -byte-arrays strings assocs sequences ; +urls.encoding byte-arrays strings assocs sequences ; IN: http.client HELP: download-failed From ff9610f99aa4b2cd8bcd0fb4a173930cfdfbb55d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 29 Sep 2008 20:19:47 -0500 Subject: [PATCH 135/244] moved sql to unfinished --- unfinished/sql/sql-tests.factor | 42 ++++++++ unfinished/sql/sql.factor | 172 ++++++++++++++++++++++++++++++++ 2 files changed, 214 insertions(+) create mode 100644 unfinished/sql/sql-tests.factor create mode 100755 unfinished/sql/sql.factor diff --git a/unfinished/sql/sql-tests.factor b/unfinished/sql/sql-tests.factor new file mode 100644 index 0000000000..0b57c2d8fa --- /dev/null +++ b/unfinished/sql/sql-tests.factor @@ -0,0 +1,42 @@ +USING: kernel namespaces db.sql sequences math ; +IN: db.sql.tests + +! TUPLE: person name age ; +: insert-1 + { insert + { + { table "person" } + { columns "name" "age" } + { values "erg" 26 } + } + } ; + +: update-1 + { update "person" + { set { "name" "erg" } + { "age" 6 } } + { where { "age" 6 } } + } ; + +: select-1 + { select + { columns + "branchno" + { count "staffno" as "mycount" } + { sum "salary" as "mysum" } } + { from "staff" "lol" } + { where + { "salary" > all + { select + { columns "salary" } + { from "staff" } + { where { "branchno" = "b003" } } + } + } + { "branchno" > 3 } } + { group-by "branchno" "lol2" } + { having { count "staffno" > 1 } } + { order-by "branchno" } + { offset 40 } + { limit 20 } + } ; diff --git a/unfinished/sql/sql.factor b/unfinished/sql/sql.factor new file mode 100755 index 0000000000..ba0673ae24 --- /dev/null +++ b/unfinished/sql/sql.factor @@ -0,0 +1,172 @@ +USING: kernel parser quotations classes.tuple words math.order +nmake namespaces sequences arrays combinators +prettyprint strings math.parser math symbols db ; +IN: db.sql + +SYMBOLS: insert update delete select distinct columns from as +where group-by having order-by limit offset is-null desc all +any count avg table values ; + +: input-spec, ( obj -- ) 1, ; +: output-spec, ( obj -- ) 2, ; +: input, ( obj -- ) 3, ; +: output, ( obj -- ) 4, ; + +DEFER: sql% + +: (sql-interleave) ( seq sep -- ) + [ sql% ] curry [ sql% ] interleave ; + +: sql-interleave ( seq str sep -- ) + swap sql% (sql-interleave) ; + +: sql-function, ( seq function -- ) + sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ; + +: sql-where, ( seq -- ) + [ + [ second 0, ] + [ first 0, ] + [ third 1, \ ? 0, ] tri + ] each ; + +HOOK: sql-create db ( object -- ) +M: db sql-create ( object -- ) + drop + "create table" sql% ; + +HOOK: sql-drop db ( object -- ) +M: db sql-drop ( object -- ) + drop + "drop table" sql% ; + +HOOK: sql-insert db ( object -- ) +M: db sql-insert ( object -- ) + drop + "insert into" sql% ; + +HOOK: sql-update db ( object -- ) +M: db sql-update ( object -- ) + drop + "update" sql% ; + +HOOK: sql-delete db ( object -- ) +M: db sql-delete ( object -- ) + drop + "delete" sql% ; + +HOOK: sql-select db ( object -- ) +M: db sql-select ( object -- ) + "select" sql% "," (sql-interleave) ; + +HOOK: sql-columns db ( object -- ) +M: db sql-columns ( object -- ) + "," (sql-interleave) ; + +HOOK: sql-from db ( object -- ) +M: db sql-from ( object -- ) + "from" "," sql-interleave ; + +HOOK: sql-where db ( object -- ) +M: db sql-where ( object -- ) + "where" 0, sql-where, ; + +HOOK: sql-group-by db ( object -- ) +M: db sql-group-by ( object -- ) + "group by" "," sql-interleave ; + +HOOK: sql-having db ( object -- ) +M: db sql-having ( object -- ) + "having" "," sql-interleave ; + +HOOK: sql-order-by db ( object -- ) +M: db sql-order-by ( object -- ) + "order by" "," sql-interleave ; + +HOOK: sql-offset db ( object -- ) +M: db sql-offset ( object -- ) + "offset" sql% sql% ; + +HOOK: sql-limit db ( object -- ) +M: db sql-limit ( object -- ) + "limit" sql% sql% ; + +! GENERIC: sql-subselect db ( object -- ) +! M: db sql-subselectselect ( object -- ) + ! "(select" sql% sql% ")" sql% ; + +HOOK: sql-table db ( object -- ) +M: db sql-table ( object -- ) + sql% ; + +HOOK: sql-set db ( object -- ) +M: db sql-set ( object -- ) + "set" "," sql-interleave ; + +HOOK: sql-values db ( object -- ) +M: db sql-values ( object -- ) + "values(" sql% "," (sql-interleave) ")" sql% ; + +HOOK: sql-count db ( object -- ) +M: db sql-count ( object -- ) + "count" sql-function, ; + +HOOK: sql-sum db ( object -- ) +M: db sql-sum ( object -- ) + "sum" sql-function, ; + +HOOK: sql-avg db ( object -- ) +M: db sql-avg ( object -- ) + "avg" sql-function, ; + +HOOK: sql-min db ( object -- ) +M: db sql-min ( object -- ) + "min" sql-function, ; + +HOOK: sql-max db ( object -- ) +M: db sql-max ( object -- ) + "max" sql-function, ; + +: sql-array% ( array -- ) + unclip + { + { \ create [ sql-create ] } + { \ drop [ sql-drop ] } + { \ insert [ sql-insert ] } + { \ update [ sql-update ] } + { \ delete [ sql-delete ] } + { \ select [ sql-select ] } + { \ columns [ sql-columns ] } + { \ from [ sql-from ] } + { \ where [ sql-where ] } + { \ group-by [ sql-group-by ] } + { \ having [ sql-having ] } + { \ order-by [ sql-order-by ] } + { \ offset [ sql-offset ] } + { \ limit [ sql-limit ] } + { \ table [ sql-table ] } + { \ set [ sql-set ] } + { \ values [ sql-values ] } + { \ count [ sql-count ] } + { \ sum [ sql-sum ] } + { \ avg [ sql-avg ] } + { \ min [ sql-min ] } + { \ max [ sql-max ] } + [ sql% [ sql% ] each ] + } case ; + +ERROR: no-sql-match ; +: sql% ( obj -- ) + { + { [ dup string? ] [ 0, ] } + { [ dup array? ] [ sql-array% ] } + { [ dup number? ] [ number>string sql% ] } + { [ dup symbol? ] [ unparse sql% ] } + { [ dup word? ] [ unparse sql% ] } + { [ dup quotation? ] [ call ] } + [ no-sql-match ] + } cond ; + +: parse-sql ( obj -- sql in-spec out-spec in out ) + [ [ sql% ] each ] { { } { } { } } nmake + [ " " join ] 2dip ; From 932d59747dc4cdbe7c0c18fafe0fca6173636814 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 29 Sep 2008 20:20:43 -0500 Subject: [PATCH 136/244] fix typo --- basis/locals/locals-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 748c206cc0..c07255547f 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -85,7 +85,7 @@ HELP: MEMO:: { POSTPONE: MEMO: POSTPONE: MEMO:: } related-words ARTICLE: "locals-mutable" "Mutable locals" -"In the list of bindings supplied to " { $link POSTPONE: :: } ", " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } " or " { $link POSTPONE: [| } ", a mutable binding may be introduced by suffixing its named with " { $snippet "!" } ". Mutable bindings are read by giving their name as usual; the suffix is not part of the binding's name. To write to a mutable binding, use the binding's with the " { $snippet "!" } " suffix." +"In the list of bindings supplied to " { $link POSTPONE: :: } ", " { $link POSTPONE: [let } ", " { $link POSTPONE: [let* } " or " { $link POSTPONE: [| } ", a mutable binding may be introduced by suffixing its named with " { $snippet "!" } ". Mutable bindings are read by giving their name as usual; the suffix is not part of the binding's name. To write to a mutable binding, use the binding's name with the " { $snippet "!" } " suffix." $nl "Here is a example word which outputs a pair of quotations which increment and decrement an internal counter, and then return the new value. The quotations are closed over the counter and each invocation of the word yields new quotations with their unique internal counter:" { $code From 908d41a305c03507e12b5e22d4169293925e5836 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 29 Sep 2008 20:21:12 -0500 Subject: [PATCH 137/244] minor change --- extra/html/parser/analyzer/analyzer.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 47cd4dbbc6..273b39e714 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -8,8 +8,8 @@ IN: html.parser.analyzer TUPLE: link attributes clickable ; -: scrape-html ( url -- vector ) - http-get nip parse-html ; +: scrape-html ( url -- headers vector ) + http-get parse-html ; : find-all ( seq quot -- alist ) [ >alist ] [ '[ second @ ] ] bi* filter ; inline From eaa2b43ca725aa4f09c7f56b93af280624bd8e8b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 20:32:52 -0500 Subject: [PATCH 138/244] Fix load error --- extra/html/parser/analyzer/analyzer.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 47cd4dbbc6..5c640c6fb9 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -3,7 +3,7 @@ USING: assocs html.parser kernel math sequences strings ascii arrays generalizations shuffle unicode.case namespaces make splitting http accessors io combinators http.client urls -fry sequences.lib ; +urls.encoding fry sequences.lib ; IN: html.parser.analyzer TUPLE: link attributes clickable ; From 57c9012d49ada75296009eeed37a48f88b4ddb21 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 21:18:37 -0500 Subject: [PATCH 139/244] Debug CGI --- basis/http/server/cgi/cgi.factor | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/basis/http/server/cgi/cgi.factor b/basis/http/server/cgi/cgi.factor index fb24fec8d9..e618249ff4 100755 --- a/basis/http/server/cgi/cgi.factor +++ b/basis/http/server/cgi/cgi.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs io.files io.streams.duplex -combinators arrays io.launcher io http.server.static http.server -http accessors sequences strings math.parser fry urls -urls.encoding ; +combinators arrays io.launcher io.encodings.binary io +http.server.static http.server http accessors sequences strings +math.parser fry urls urls.encoding calendar ; IN: http.server.cgi : cgi-variables ( script-path -- assoc ) @@ -44,14 +44,15 @@ IN: http.server.cgi : ( name -- desc ) over 1array >>command - swap cgi-variables >>environment ; + swap cgi-variables >>environment + 1 minutes >>timeout ; : serve-cgi ( name -- response ) 200 >>code "CGI output follows" >>message swap '[ - _ output-stream get swap [ + _ output-stream get swap binary [ post-request? [ request get post-data>> raw>> write flush ] when input-stream get swap (stream-copy) ] with-stream From ff48e56837d5fb1026699ac6dab1f4d78486e4a8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 21:18:49 -0500 Subject: [PATCH 140/244] Deploying gitweb --- .../websites/concatenative/concatenative.factor | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 71fc1116b3..72eb483066 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -8,6 +8,8 @@ html.templates.chloe http.server http.server.dispatchers http.server.redirection +http.server.static +http.server.cgi furnace.alloy furnace.auth.login furnace.auth.providers.db @@ -82,14 +84,19 @@ SYMBOL: dh-file main-responder set-global ; +: ( path -- responder ) + + swap enable-cgi >>default + URL" /gitweb.cgi" "" add-responder ; + : init-production ( -- ) common-configuration - "concatenative.org" add-responder - "paste.factorcode.org" add-responder - "planet.factorcode.org" add-responder - home "docs" append-path "docs.factorcode.org" add-responder - + "concatenative.org" add-responder + "paste.factorcode.org" add-responder + "planet.factorcode.org" add-responder + home "docs" append-path "docs.factorcode.org" add-responder + home "cgi" append-path "gitweb.factorcode.org" add-responder main-responder set-global ; : ( -- config ) From fd7b7511f54036d35b90af60bc39dbeeaa7c7828 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 21:19:02 -0500 Subject: [PATCH 141/244] Support ; separator for query params, record raw-query --- basis/urls/encoding/encoding-tests.factor | 2 ++ basis/urls/encoding/encoding.factor | 2 +- basis/urls/urls-tests.factor | 5 +++++ basis/urls/urls.factor | 6 +++--- 4 files changed, 11 insertions(+), 4 deletions(-) diff --git a/basis/urls/encoding/encoding-tests.factor b/basis/urls/encoding/encoding-tests.factor index 2217ec8a28..87b1812ef8 100644 --- a/basis/urls/encoding/encoding-tests.factor +++ b/basis/urls/encoding/encoding-tests.factor @@ -21,6 +21,8 @@ USING: urls.encoding tools.test arrays kernel assocs present accessors ; [ H{ { "a" { "b" "c" } } } ] [ "a=b&a=c" query>assoc ] unit-test +[ H{ { "a" { "b" "c" } } } ] [ "a=b;a=c" query>assoc ] unit-test + [ H{ { "text" "hello world" } } ] [ "text=hello+world" query>assoc ] unit-test [ "a=3" ] [ { { "a" 3 } } assoc>query ] unit-test diff --git a/basis/urls/encoding/encoding.factor b/basis/urls/encoding/encoding.factor index 2f89084488..a4519c99b0 100644 --- a/basis/urls/encoding/encoding.factor +++ b/basis/urls/encoding/encoding.factor @@ -76,7 +76,7 @@ PRIVATE> : query>assoc ( query -- assoc ) dup [ - "&" split H{ } clone [ + "&;" split H{ } clone [ [ [ "=" split1 [ dup [ query-decode ] when ] bi@ swap ] dip add-query-param diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index cac206bf3c..c98802657b 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -10,6 +10,7 @@ arrays kernel assocs present accessors ; { host "www.apple.com" } { port 1234 } { path "/a/path" } + { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -20,6 +21,7 @@ arrays kernel assocs present accessors ; { protocol "http" } { host "www.apple.com" } { path "/a/path" } + { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -57,6 +59,7 @@ arrays kernel assocs present accessors ; { T{ url { path "bar" } + { raw-query "a=b" } { query H{ { "a" "b" } } } } "bar?a=b" @@ -210,6 +213,7 @@ urls [ T{ url { protocol "http" } { host "localhost" } + { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } @@ -220,6 +224,7 @@ urls [ T{ url { protocol "http" } { host "localhost" } + { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 5ebcabede8..fb56e274da 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present peg.ebnf urls.encoding ; IN: urls -TUPLE: url protocol username password host port path query anchor ; +TUPLE: url protocol username password host port path raw-query query anchor ; : ( -- url ) url new ; @@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]] username = [^/:@#?]+ => [[ url-decode ]] password = [^/:@#?]+ => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]] -query = [^#]+ => [[ query>assoc ]] +query = [^#]+ => [[ >string ]] anchor = .+ => [[ url-decode ]] hostname = [^/#?]+ => [[ url-decode ]] @@ -80,7 +80,7 @@ M: string >url ] [ f f f f f ] if* ] [ second ] ! pathname - [ third ] ! query + [ third dup query>assoc ] ! query [ fourth ] ! anchor } cleave url boa dup host>> [ [ "/" or ] change-path ] when ; From 90eaffe40cb2e068794842a498076f21db135f33 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:16:55 -0500 Subject: [PATCH 142/244] Fix help lint --- basis/urls/encoding/encoding-docs.factor | 6 +++--- basis/urls/encoding/encoding.factor | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/urls/encoding/encoding-docs.factor b/basis/urls/encoding/encoding-docs.factor index 5ba94ea1bc..f8b435441f 100644 --- a/basis/urls/encoding/encoding-docs.factor +++ b/basis/urls/encoding/encoding-docs.factor @@ -19,10 +19,10 @@ HELP: assoc>query { $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP client to encode POST requests." } { $examples { $example - "USING: io urls ;" + "USING: io urls.encoding ;" "{ { \"from\" \"Lead\" } { \"to\" \"Gold, please\" } }" "assoc>query print" - "from=Lead&to=Gold%2c+please" + "from=Lead&to=Gold%2c%20please" } } ; @@ -32,7 +32,7 @@ HELP: query>assoc { $notes "This word is used by the implementation of " { $link "urls" } ". It is also used by the HTTP server to parse POST requests." } { $examples { $unchecked-example - "USING: prettyprint urls ;" + "USING: prettyprint urls.encoding ;" "\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\"" "query>assoc ." <" H{ diff --git a/basis/urls/encoding/encoding.factor b/basis/urls/encoding/encoding.factor index a4519c99b0..fa882609a5 100644 --- a/basis/urls/encoding/encoding.factor +++ b/basis/urls/encoding/encoding.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel ascii combinators combinators.short-circuit sequences splitting fry namespaces make assocs arrays strings -io.sockets io.sockets.secure io.encodings.string -io.encodings.utf8 math math.parser accessors hashtables present ; +io.encodings.string io.encodings.utf8 math math.parser accessors +hashtables present ; IN: urls.encoding : url-quotable? ( ch -- ? ) From 4b219373a5b4ed1fc7ca82fde1c8d36f2965cde8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:33:06 -0500 Subject: [PATCH 143/244] Tweaks --- basis/furnace/actions/actions.factor | 2 +- extra/webapps/help/help.factor | 2 +- extra/websites/concatenative/concatenative.factor | 5 ++--- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 2a63489299..7505b3c612 100755 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -79,7 +79,7 @@ TUPLE: action rest authorize init display validate submit ; : revalidate-url ( -- url/f ) revalidate-url-key param - dup [ >url [ same-host? ] keep and ] when ; + dup [ >url ensure-port [ same-host? ] keep and ] when ; : validation-failed ( -- * ) post-request? revalidate-url and [ diff --git a/extra/webapps/help/help.factor b/extra/webapps/help/help.factor index e9b6a48634..c209fe222e 100644 --- a/extra/webapps/help/help.factor +++ b/extra/webapps/help/help.factor @@ -13,7 +13,7 @@ TUPLE: help-webapp < dispatcher ; [ { - { "search" [ 2 v-min-length 50 v-max-length v-one-line ] } + { "search" [ 1 v-min-length 50 v-max-length v-one-line ] } } validate-params help-dir set-current-directory diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 72eb483066..0af8eb31d7 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -77,10 +77,9 @@ SYMBOL: dh-file "password" key-password set-global common-configuration - "pastebin" add-responder - "planet" add-responder + "pastebin" add-responder + "planet" add-responder "/tmp/docs/" "docs" add-responder - main-responder set-global ; From e84dec38ef2c40f185368f7c9790503d89013e87 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:39:53 -0500 Subject: [PATCH 144/244] Doc fixes --- basis/locals/locals-docs.factor | 2 +- core/syntax/syntax-docs.factor | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/locals/locals-docs.factor b/basis/locals/locals-docs.factor index 748c206cc0..3dfc17c081 100644 --- a/basis/locals/locals-docs.factor +++ b/basis/locals/locals-docs.factor @@ -65,7 +65,7 @@ HELP: [wlet HELP: :: { $syntax ":: word ( bindings... -- outputs... ) body... ;" } -{ $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope. Any " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " or " { $link POSTPONE: [wlet } " forms used in the body of the word definition are automatically closure-converted." } +{ $description "Defines a word with named inputs; it reads stack values into bindings from left to right, then executes the body with those bindings in lexical scope." } { $notes "The output names do not affect the word's behavior, however the compiler attempts to check the stack effect as with other definitions." } { $examples "See " { $link POSTPONE: [| } ", " { $link POSTPONE: [let } " and " { $link POSTPONE: [wlet } "." } ; diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 905cd87903..2b7de36d56 100755 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -573,12 +573,12 @@ $nl } ; HELP: initial: -{ $syntax "TUPLE: ... { \"slot\" initial: value } ... ;" } +{ $syntax "TUPLE: ... { slot initial: value } ... ;" } { $values { "slot" "a slot name" } { "value" "any literal" } } { $description "Specifies an initial value for a tuple slot." } ; HELP: read-only -{ $syntax "TUPLE: ... { \"slot\" read-only } ... ;" } +{ $syntax "TUPLE: ... { slot read-only } ... ;" } { $values { "slot" "a slot name" } } { $description "Defines a tuple slot to be read-only. If a tuple has read-only slots, instances of the tuple should only be created by calling " { $link boa } ", instead of " { $link new } ". Using " { $link boa } " is the only way to set the value of a read-only slot." } ; From a5f9e0eb23ff01c94a51da57e557bcd94fbf2f92 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:40:00 -0500 Subject: [PATCH 145/244] Template tweak --- extra/webapps/help/search.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index 8335725ce5..324dc028e1 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -23,10 +23,10 @@

          This is the Factor documentation, generated offline from a - load-everything image. The Factor UI also - includes a documentation browser tool.

          + load-everything image. If you want, you can also browse the + documentation from within the Factor UI.

          -

          You may search article titles below.

          +

          You may search article titles below; for example, try searching for "HTTP".

          From 304e069af22a835009481855c9352bbfd0f375ce Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:40:41 -0500 Subject: [PATCH 146/244] Template tweak --- extra/webapps/help/search.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/help/search.xml b/extra/webapps/help/search.xml index 324dc028e1..e5fa5d3901 100644 --- a/extra/webapps/help/search.xml +++ b/extra/webapps/help/search.xml @@ -24,7 +24,7 @@

          This is the Factor documentation, generated offline from a load-everything image. If you want, you can also browse the - documentation from within the Factor UI.

          + documentation from within the Factor UI.

          You may search article titles below; for example, try searching for "HTTP".

          From 81bd2eb175824fba470ea11a235b8173080db48e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 22:54:10 -0500 Subject: [PATCH 147/244] Remove raw-query stuff, its a pain --- basis/urls/urls-tests.factor | 5 ----- basis/urls/urls.factor | 22 +++++++++++----------- 2 files changed, 11 insertions(+), 16 deletions(-) diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index c98802657b..cac206bf3c 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -10,7 +10,6 @@ arrays kernel assocs present accessors ; { host "www.apple.com" } { port 1234 } { path "/a/path" } - { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -21,7 +20,6 @@ arrays kernel assocs present accessors ; { protocol "http" } { host "www.apple.com" } { path "/a/path" } - { raw-query "a=b" } { query H{ { "a" "b" } } } { anchor "foo" } } @@ -59,7 +57,6 @@ arrays kernel assocs present accessors ; { T{ url { path "bar" } - { raw-query "a=b" } { query H{ { "a" "b" } } } } "bar?a=b" @@ -213,7 +210,6 @@ urls [ T{ url { protocol "http" } { host "localhost" } - { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } @@ -224,7 +220,6 @@ urls [ T{ url { protocol "http" } { host "localhost" } - { raw-query "foo=bar" } { query H{ { "foo" "bar" } } } { path "/" } } diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index fb56e274da..5cc8c9693b 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -8,7 +8,7 @@ strings.parser lexer prettyprint.backend hashtables present peg.ebnf urls.encoding ; IN: urls -TUPLE: url protocol username password host port path raw-query query anchor ; +TUPLE: url protocol username password host port path query anchor ; : ( -- url ) url new ; @@ -47,7 +47,7 @@ protocol = [a-z]+ => [[ url-decode ]] username = [^/:@#?]+ => [[ url-decode ]] password = [^/:@#?]+ => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]] -query = [^#]+ => [[ >string ]] +query = [^#]+ => [[ query>assoc ]] anchor = .+ => [[ url-decode ]] hostname = [^/#?]+ => [[ url-decode ]] @@ -80,7 +80,7 @@ M: string >url ] [ f f f f f ] if* ] [ second ] ! pathname - [ third dup query>assoc ] ! query + [ third ] ! query [ fourth ] ! anchor } cleave url boa dup host>> [ [ "/" or ] change-path ] when ; @@ -139,14 +139,14 @@ PRIVATE> : derive-url ( base url -- url' ) [ clone ] dip over { - [ [ protocol>> ] either? >>protocol ] - [ [ username>> ] either? >>username ] - [ [ password>> ] either? >>password ] - [ [ host>> ] either? >>host ] - [ [ port>> ] either? >>port ] - [ [ path>> ] bi@ swap url-append-path >>path ] - [ [ query>> ] either? >>query ] - [ [ anchor>> ] either? >>anchor ] + [ [ protocol>> ] either? >>protocol ] + [ [ username>> ] either? >>username ] + [ [ password>> ] either? >>password ] + [ [ host>> ] either? >>host ] + [ [ port>> ] either? >>port ] + [ [ path>> ] bi@ swap url-append-path >>path ] + [ [ query>> ] either? >>query ] + [ [ anchor>> ] either? >>anchor ] } 2cleave ; : relative-url ( url -- url' ) From 25df1f96145768c374918e17f79359ec6a81d03b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:04:14 -0500 Subject: [PATCH 148/244] Tweak config --- .../websites/concatenative/concatenative.factor | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 0af8eb31d7..0fec239743 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -45,7 +45,7 @@ TUPLE: factor-website < dispatcher ; { factor-website "page" } >>template ; -: ( responder -- responder' ) +: ( responder -- responder' ) "Factor website" "Factor website" >>name allow-registration @@ -77,10 +77,10 @@ SYMBOL: dh-file "password" key-password set-global common-configuration - "pastebin" add-responder - "planet" add-responder + "pastebin" add-responder + "planet" add-responder "/tmp/docs/" "docs" add-responder - + test-db main-responder set-global ; : ( path -- responder ) @@ -91,11 +91,12 @@ SYMBOL: dh-file : init-production ( -- ) common-configuration - "concatenative.org" add-responder - "paste.factorcode.org" add-responder - "planet.factorcode.org" add-responder - home "docs" append-path "docs.factorcode.org" add-responder + "concatenative.org" add-responder + "paste.factorcode.org" add-responder + "planet.factorcode.org" add-responder + home "docs" append-path "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder + test-db main-responder set-global ; : ( -- config ) From 9b05fe003254a98fca5c7e0eeaa3162a2d90df1a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:05:21 -0500 Subject: [PATCH 149/244] Oops --- extra/websites/concatenative/concatenative.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 0fec239743..527b0507ba 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -51,8 +51,7 @@ TUPLE: factor-website < dispatcher ; allow-registration allow-password-recovery allow-edit-profile - allow-deactivation - test-db ; + allow-deactivation ; : ( -- responder ) factor-website new-dispatcher From 2b10a154ced6986da042c4b8912218401b0efb9f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:08:37 -0500 Subject: [PATCH 150/244] Broke gitweb oops --- extra/websites/concatenative/concatenative.factor | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index 527b0507ba..5553fda740 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -90,12 +90,11 @@ SYMBOL: dh-file : init-production ( -- ) common-configuration - "concatenative.org" add-responder - "paste.factorcode.org" add-responder - "planet.factorcode.org" add-responder - home "docs" append-path "docs.factorcode.org" add-responder + test-db "concatenative.org" add-responder + test-db "paste.factorcode.org" add-responder + test-db "planet.factorcode.org" add-responder + home "docs" append-path test-db "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder - test-db main-responder set-global ; : ( -- config ) From 1bd36b3d879cf91733211c2c77c0900d8655db4d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:13:46 -0500 Subject: [PATCH 151/244] Working on XHTML 1.1 validation --- basis/html/components/components.factor | 2 +- extra/webapps/pastebin/new-paste.xml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/html/components/components.factor b/basis/html/components/components.factor index dafc9dd06b..6f35ba5d97 100644 --- a/basis/html/components/components.factor +++ b/basis/html/components/components.factor @@ -83,7 +83,7 @@ TUPLE: choice size multiple choices ; choice new ; : render-option ( text selected? -- ) - ; diff --git a/extra/webapps/pastebin/new-paste.xml b/extra/webapps/pastebin/new-paste.xml index 6abae4895b..96339b6cf8 100644 --- a/extra/webapps/pastebin/new-paste.xml +++ b/extra/webapps/pastebin/new-paste.xml @@ -18,6 +18,6 @@ - +

          From 00f3c256d97d9dfed71277b68ce3a8605ca0ae6e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:16:14 -0500 Subject: [PATCH 152/244] Working on XHTML 1.1 validation --- extra/webapps/pastebin/paste.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/webapps/pastebin/paste.xml b/extra/webapps/pastebin/paste.xml index 1c138fc8c0..8fe672049f 100644 --- a/extra/webapps/pastebin/paste.xml +++ b/extra/webapps/pastebin/paste.xml @@ -20,7 +20,7 @@ -

          Annotation:

          +

          Annotation:

          @@ -52,7 +52,7 @@
          Author:
          - +

          From 0dff27507dec3bfceeb13c3aa9327e3c035c7498 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:20:12 -0500 Subject: [PATCH 153/244] Fix validation warning --- extra/webapps/help/help.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/help/help.xml b/extra/webapps/help/help.xml index f4262a6f6a..7718b10a22 100644 --- a/extra/webapps/help/help.xml +++ b/extra/webapps/help/help.xml @@ -1,4 +1,4 @@ - + From 94872bd43a851f9cb1c00aed217ec8dbc5325851 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:29:51 -0500 Subject: [PATCH 154/244] Fix edit-blog action --- extra/webapps/planet/planet.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index cd6e183d14..00d843573c 100755 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -166,14 +166,14 @@ posting "POSTINGS" [ f [ deposit-blog-slots ] + [ "id" value >>id ] [ update-tuple ] - [ - - "$planet/admin" >>path - swap id>> "id" set-query-param - - ] tri + + + "$planet/admin" >>path + "id" value "id" set-query-param + ] >>submit ; : ( -- responder ) From e438fe2a80ae19d158678b284eb3f491bcdcdd65 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Mon, 29 Sep 2008 23:36:40 -0500 Subject: [PATCH 155/244] Handle Atom feeds with multiple entry links --- basis/syndication/syndication.factor | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/basis/syndication/syndication.factor b/basis/syndication/syndication.factor index ca7511f1af..aca09b939c 100644 --- a/basis/syndication/syndication.factor +++ b/basis/syndication/syndication.factor @@ -69,11 +69,15 @@ TUPLE: entry title url description date ; [ "item" tags-named [ rss2.0-entry ] map set-entries ] tri ; +: atom-entry-link ( tag -- url/f ) + "link" tags-named [ "rel" swap at "alternate" = ] find nip + dup [ "href" swap at >url ] when ; + : atom1.0-entry ( tag -- entry ) entry new swap { [ "title" tag-named children>string >>title ] - [ "link" tag-named "href" swap at >url >>url ] + [ atom-entry-link >>url ] [ { "content" "summary" } any-tag-named dup children>> [ string? not ] contains? From 34ce3e13e4696a911beaae93b66c8c4ca93acabc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 29 Sep 2008 23:43:34 -0500 Subject: [PATCH 156/244] add foreign key integrity to sqlite --- basis/db/queries/queries.factor | 32 +++--- basis/db/sql/sql-tests.factor | 42 ------- basis/db/sql/sql.factor | 172 ---------------------------- basis/db/sqlite/sqlite.factor | 109 +++++++++++++++++- basis/db/tuples/tuples-tests.factor | 97 ++++++++++++---- basis/db/types/types.factor | 15 ++- 6 files changed, 208 insertions(+), 259 deletions(-) delete mode 100644 basis/db/sql/sql-tests.factor delete mode 100755 basis/db/sql/sql.factor diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index f7809de578..e3322ada44 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -3,7 +3,7 @@ USING: accessors kernel math namespaces make sequences random strings math.parser math.intervals combinators math.bitwise nmake db db.tuples db.types db.sql classes words shuffle arrays -destructors continuations db.tuples.private ; +destructors continuations db.tuples.private prettyprint ; IN: db.queries GENERIC: where ( specs obj -- ) @@ -45,11 +45,16 @@ M: retryable execute-statement* ( statement type -- ) : sql-props ( class -- columns table ) [ db-columns ] [ db-table ] bi ; -: query-make ( class quot -- ) +: query-make ( class quot -- statements ) + #! query, input, outputs, secondary queries + over unparse "table" set [ sql-props ] dip [ 0 sql-counter rot with-variable ] curry - { "" { } { } } nmake - maybe-make-retryable ; inline + { "" { } { } { } } nmake + [ maybe-make-retryable ] dip + [ + [ 1array ] dip append + ] unless-empty ; inline : where-primary-key% ( specs -- ) " where " 0% @@ -152,25 +157,20 @@ M: db ( tuple class -- statement ) where-clause ] query-make ; +: splice ( string1 string2 string3 -- string ) + swap 3append ; + : do-group ( tuple groups -- ) - [ - ", " join " group by " swap 3append - ] curry change-sql drop ; + [ ", " join " group by " splice ] curry change-sql drop ; : do-order ( tuple order -- ) - [ - ", " join " order by " swap 3append - ] curry change-sql drop ; + [ ", " join " order by " splice ] curry change-sql drop ; : do-offset ( tuple n -- ) - [ - number>string " offset " swap 3append - ] curry change-sql drop ; + [ number>string " offset " splice ] curry change-sql drop ; : do-limit ( tuple n -- ) - [ - number>string " limit " swap 3append - ] curry change-sql drop ; + [ number>string " limit " splice ] curry change-sql drop ; : make-query* ( tuple query -- tuple' ) dupd diff --git a/basis/db/sql/sql-tests.factor b/basis/db/sql/sql-tests.factor deleted file mode 100644 index 0b57c2d8fa..0000000000 --- a/basis/db/sql/sql-tests.factor +++ /dev/null @@ -1,42 +0,0 @@ -USING: kernel namespaces db.sql sequences math ; -IN: db.sql.tests - -! TUPLE: person name age ; -: insert-1 - { insert - { - { table "person" } - { columns "name" "age" } - { values "erg" 26 } - } - } ; - -: update-1 - { update "person" - { set { "name" "erg" } - { "age" 6 } } - { where { "age" 6 } } - } ; - -: select-1 - { select - { columns - "branchno" - { count "staffno" as "mycount" } - { sum "salary" as "mysum" } } - { from "staff" "lol" } - { where - { "salary" > all - { select - { columns "salary" } - { from "staff" } - { where { "branchno" = "b003" } } - } - } - { "branchno" > 3 } } - { group-by "branchno" "lol2" } - { having { count "staffno" > 1 } } - { order-by "branchno" } - { offset 40 } - { limit 20 } - } ; diff --git a/basis/db/sql/sql.factor b/basis/db/sql/sql.factor deleted file mode 100755 index ba0673ae24..0000000000 --- a/basis/db/sql/sql.factor +++ /dev/null @@ -1,172 +0,0 @@ -USING: kernel parser quotations classes.tuple words math.order -nmake namespaces sequences arrays combinators -prettyprint strings math.parser math symbols db ; -IN: db.sql - -SYMBOLS: insert update delete select distinct columns from as -where group-by having order-by limit offset is-null desc all -any count avg table values ; - -: input-spec, ( obj -- ) 1, ; -: output-spec, ( obj -- ) 2, ; -: input, ( obj -- ) 3, ; -: output, ( obj -- ) 4, ; - -DEFER: sql% - -: (sql-interleave) ( seq sep -- ) - [ sql% ] curry [ sql% ] interleave ; - -: sql-interleave ( seq str sep -- ) - swap sql% (sql-interleave) ; - -: sql-function, ( seq function -- ) - sql% "(" sql% unclip sql% ")" sql% [ sql% ] each ; - -: sql-where, ( seq -- ) - [ - [ second 0, ] - [ first 0, ] - [ third 1, \ ? 0, ] tri - ] each ; - -HOOK: sql-create db ( object -- ) -M: db sql-create ( object -- ) - drop - "create table" sql% ; - -HOOK: sql-drop db ( object -- ) -M: db sql-drop ( object -- ) - drop - "drop table" sql% ; - -HOOK: sql-insert db ( object -- ) -M: db sql-insert ( object -- ) - drop - "insert into" sql% ; - -HOOK: sql-update db ( object -- ) -M: db sql-update ( object -- ) - drop - "update" sql% ; - -HOOK: sql-delete db ( object -- ) -M: db sql-delete ( object -- ) - drop - "delete" sql% ; - -HOOK: sql-select db ( object -- ) -M: db sql-select ( object -- ) - "select" sql% "," (sql-interleave) ; - -HOOK: sql-columns db ( object -- ) -M: db sql-columns ( object -- ) - "," (sql-interleave) ; - -HOOK: sql-from db ( object -- ) -M: db sql-from ( object -- ) - "from" "," sql-interleave ; - -HOOK: sql-where db ( object -- ) -M: db sql-where ( object -- ) - "where" 0, sql-where, ; - -HOOK: sql-group-by db ( object -- ) -M: db sql-group-by ( object -- ) - "group by" "," sql-interleave ; - -HOOK: sql-having db ( object -- ) -M: db sql-having ( object -- ) - "having" "," sql-interleave ; - -HOOK: sql-order-by db ( object -- ) -M: db sql-order-by ( object -- ) - "order by" "," sql-interleave ; - -HOOK: sql-offset db ( object -- ) -M: db sql-offset ( object -- ) - "offset" sql% sql% ; - -HOOK: sql-limit db ( object -- ) -M: db sql-limit ( object -- ) - "limit" sql% sql% ; - -! GENERIC: sql-subselect db ( object -- ) -! M: db sql-subselectselect ( object -- ) - ! "(select" sql% sql% ")" sql% ; - -HOOK: sql-table db ( object -- ) -M: db sql-table ( object -- ) - sql% ; - -HOOK: sql-set db ( object -- ) -M: db sql-set ( object -- ) - "set" "," sql-interleave ; - -HOOK: sql-values db ( object -- ) -M: db sql-values ( object -- ) - "values(" sql% "," (sql-interleave) ")" sql% ; - -HOOK: sql-count db ( object -- ) -M: db sql-count ( object -- ) - "count" sql-function, ; - -HOOK: sql-sum db ( object -- ) -M: db sql-sum ( object -- ) - "sum" sql-function, ; - -HOOK: sql-avg db ( object -- ) -M: db sql-avg ( object -- ) - "avg" sql-function, ; - -HOOK: sql-min db ( object -- ) -M: db sql-min ( object -- ) - "min" sql-function, ; - -HOOK: sql-max db ( object -- ) -M: db sql-max ( object -- ) - "max" sql-function, ; - -: sql-array% ( array -- ) - unclip - { - { \ create [ sql-create ] } - { \ drop [ sql-drop ] } - { \ insert [ sql-insert ] } - { \ update [ sql-update ] } - { \ delete [ sql-delete ] } - { \ select [ sql-select ] } - { \ columns [ sql-columns ] } - { \ from [ sql-from ] } - { \ where [ sql-where ] } - { \ group-by [ sql-group-by ] } - { \ having [ sql-having ] } - { \ order-by [ sql-order-by ] } - { \ offset [ sql-offset ] } - { \ limit [ sql-limit ] } - { \ table [ sql-table ] } - { \ set [ sql-set ] } - { \ values [ sql-values ] } - { \ count [ sql-count ] } - { \ sum [ sql-sum ] } - { \ avg [ sql-avg ] } - { \ min [ sql-min ] } - { \ max [ sql-max ] } - [ sql% [ sql% ] each ] - } case ; - -ERROR: no-sql-match ; -: sql% ( obj -- ) - { - { [ dup string? ] [ 0, ] } - { [ dup array? ] [ sql-array% ] } - { [ dup number? ] [ number>string sql% ] } - { [ dup symbol? ] [ unparse sql% ] } - { [ dup word? ] [ unparse sql% ] } - { [ dup quotation? ] [ call ] } - [ no-sql-match ] - } cond ; - -: parse-sql ( obj -- sql in-spec out-spec in out ) - [ [ sql% ] each ] { { } { } { } } nmake - [ " " join ] 2dip ; diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index aab1e5f40f..4fc3dbb227 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -5,7 +5,8 @@ io.files kernel math math.parser namespaces prettyprint sequences strings classes.tuple alien.c-types continuations db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators math.intervals io nmake accessors vectors math.ranges random -math.bitwise db.queries destructors db.tuples.private ; +math.bitwise db.queries destructors db.tuples.private interpolate +io.streams.string multiline make ; IN: db.sqlite TUPLE: sqlite-db < db path ; @@ -117,7 +118,8 @@ M: sqlite-db create-sql-statement ( class -- statement ) dupd "create table " 0% 0% "(" 0% [ ", " 0% ] [ - dup column-name>> 0% + dup "sql-spec" set + dup column-name>> [ "table-id" set ] [ 0% ] bi " " 0% dup type>> lookup-create-type 0% modifiers 0% @@ -203,9 +205,110 @@ M: sqlite-db persistent-table ( -- assoc ) { random-generator { f f f } } } ; +: insert-trigger ( -- string ) + [ + <" + CREATE TRIGGER fki_${table}_${foreign-table}_id + BEFORE INSERT ON ${table} + FOR EACH ROW BEGIN + SELECT RAISE(ROLLBACK, 'insert on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"') + WHERE (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; + END; + "> interpolate + ] with-string-writer ; + +: insert-trigger-not-null ( -- string ) + [ + <" + CREATE TRIGGER fki_${table}_${foreign-table}_id + BEFORE INSERT ON ${table} + FOR EACH ROW BEGIN + SELECT RAISE(ROLLBACK, 'insert on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"') + WHERE NEW.${foreign-table-id} IS NOT NULL + AND (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; + END; + "> interpolate + ] with-string-writer ; + +: update-trigger ( -- string ) + [ + <" + CREATE TRIGGER fku_${table}_${foreign-table}_id + BEFORE UPDATE ON ${table} + FOR EACH ROW BEGIN + SELECT RAISE(ROLLBACK, 'update on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"') + WHERE (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; + END; + "> interpolate + ] with-string-writer ; + +: update-trigger-not-null ( -- string ) + [ + <" + CREATE TRIGGER fku_${table}_${foreign-table}_id + BEFORE UPDATE ON ${table} + FOR EACH ROW BEGIN + SELECT RAISE(ROLLBACK, 'update on table "${table}" violates foreign key constraint "fk_${foreign-table}_id"') + WHERE NEW.${foreign-table-id} IS NOT NULL + AND (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL; + END; + "> interpolate + ] with-string-writer ; + +: delete-trigger-restrict ( -- string ) + [ + <" + CREATE TRIGGER fkd_${table}_${foreign-table}_id + BEFORE DELETE ON ${foreign-table} + FOR EACH ROW BEGIN + SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table}" violates foreign key constraint "fk_${foreign-table}_id"') + WHERE (SELECT ${foreign-table-id} FROM ${foreign-table} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL; + END; + "> interpolate + ] with-string-writer ; + +: delete-trigger-cascade ( -- string ) + [ + <" + CREATE TRIGGER fkd_${table}_${foreign-table}_id + BEFORE DELETE ON ${foreign-table} + FOR EACH ROW BEGIN + DELETE from ${table} WHERE ${table-id} = OLD.${foreign-table-id}; + END; + "> interpolate + ] with-string-writer ; + +: can-be-null? ( -- ? ) + "sql-spec" get modifiers>> [ +not-null+ = ] contains? not ; + +: delete-cascade? ( -- ? ) + "sql-spec" get modifiers>> [ +cascade+ = ] contains? ; + +: sqlite-trigger, ( string -- ) + { } { } 3, ; + +: create-sqlite-triggers ( -- ) + can-be-null? [ + insert-trigger sqlite-trigger, + update-trigger sqlite-trigger, + ] [ + insert-trigger-not-null sqlite-trigger, + update-trigger-not-null sqlite-trigger, + ] if + delete-cascade? [ + delete-trigger-cascade sqlite-trigger, + ] [ + delete-trigger-restrict sqlite-trigger, + ] if ; + M: sqlite-db compound ( string seq -- new-string ) over { { "default" [ first number>string join-space ] } - { "references" [ >reference-string ] } + { "references" [ + [ >reference-string ] keep + first2 [ "foreign-table" set ] + [ "foreign-table-id" set ] bi* + create-sqlite-triggers + ] } [ 2drop ] } case ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 6a5e78aa4b..9550ea1cd8 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -176,26 +176,49 @@ SYMBOL: person4 T{ timestamp f 0 0 0 12 34 56 T{ duration f 0 0 0 0 0 0 } } f H{ { 1 2 } { 3 4 } { 5 "lol" } } URL" http://www.google.com/search?hl=en&q=trailer+park+boys&btnG=Google+Search" person4 set ; + TUPLE: paste n summary author channel mode contents timestamp annotations ; TUPLE: annotation n paste-id summary author mode contents ; -: db-assigned-paste-schema ( -- ) - paste "PASTE" - { - { "n" "ID" +db-assigned-id+ } - { "summary" "SUMMARY" TEXT } - { "author" "AUTHOR" TEXT } - { "channel" "CHANNEL" TEXT } - { "mode" "MODE" TEXT } - { "contents" "CONTENTS" TEXT } - { "timestamp" "DATE" TIMESTAMP } - { "annotations" { +has-many+ annotation } } - } define-persistent +paste "PASTE" +{ + { "n" "ID" +db-assigned-id+ } + { "summary" "SUMMARY" TEXT } + { "author" "AUTHOR" TEXT } + { "channel" "CHANNEL" TEXT } + { "mode" "MODE" TEXT } + { "contents" "CONTENTS" TEXT } + { "timestamp" "DATE" TIMESTAMP } + { "annotations" { +has-many+ annotation } } +} define-persistent +: annotation-schema-foreign-key ( -- ) annotation "ANNOTATION" { { "n" "ID" +db-assigned-id+ } - { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "n" } + { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } } + { "summary" "SUMMARY" TEXT } + { "author" "AUTHOR" TEXT } + { "mode" "MODE" TEXT } + { "contents" "CONTENTS" TEXT } + } define-persistent ; + +: annotation-schema-foreign-key-not-null ( -- ) + annotation "ANNOTATION" + { + { "n" "ID" +db-assigned-id+ } + { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } +not-null+ } + { "summary" "SUMMARY" TEXT } + { "author" "AUTHOR" TEXT } + { "mode" "MODE" TEXT } + { "contents" "CONTENTS" TEXT } + } define-persistent ; + +: annotation-schema-cascade ( -- ) + annotation "ANNOTATION" + { + { "n" "ID" +db-assigned-id+ } + { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } +on-delete+ +cascade+ } { "summary" "SUMMARY" TEXT } { "author" "AUTHOR" TEXT } @@ -203,8 +226,18 @@ TUPLE: annotation n paste-id summary author mode contents ; { "contents" "CONTENTS" TEXT } } define-persistent ; +: annotation-schema-restrict ( -- ) + annotation "ANNOTATION" + { + { "n" "ID" +db-assigned-id+ } + { "paste-id" "PASTE_ID" INTEGER { +foreign-id+ paste "ID" } } + { "summary" "SUMMARY" TEXT } + { "author" "AUTHOR" TEXT } + { "mode" "MODE" TEXT } + { "contents" "CONTENTS" TEXT } + } define-persistent ; + : test-paste-schema ( -- ) - [ ] [ db-assigned-paste-schema ] unit-test [ ] [ paste ensure-table ] unit-test [ ] [ annotation ensure-table ] unit-test [ ] [ annotation drop-table ] unit-test @@ -229,14 +262,38 @@ TUPLE: annotation n paste-id summary author mode contents ; "erg" >>author "annotation contents" >>contents insert-tuple - ] unit-test + ] unit-test ; - [ ] [ - ] unit-test - ; +: test-foreign-key ( -- ) + [ ] [ annotation-schema-foreign-key ] unit-test + test-paste-schema + [ paste new 1 >>n delete-tuples ] must-fail ; -[ test-paste-schema ] test-sqlite -[ test-paste-schema ] test-postgresql +: test-foreign-key-not-null ( -- ) + [ ] [ annotation-schema-foreign-key-not-null ] unit-test + test-paste-schema + [ paste new 1 >>n delete-tuples ] must-fail ; + +: test-cascade ( -- ) + [ ] [ annotation-schema-cascade ] unit-test + test-paste-schema + [ ] [ paste new 1 >>n delete-tuples ] unit-test + [ 0 ] [ paste new select-tuples length ] unit-test ; + +: test-restrict ( -- ) + [ ] [ annotation-schema-restrict ] unit-test + test-paste-schema + [ paste new 1 >>n delete-tuples ] must-fail ; + +[ test-foreign-key ] test-sqlite +[ test-foreign-key-not-null ] test-sqlite +[ test-cascade ] test-sqlite +[ test-restrict ] test-sqlite + +[ test-foreign-key ] test-postgresql +[ test-foreign-key-not-null ] test-postgresql +[ test-cascade ] test-postgresql +[ test-restrict ] test-postgresql : test-repeated-insert [ ] [ person ensure-table ] unit-test diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index bc33792e52..242339264d 100755 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -87,16 +87,17 @@ SYMBOLS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB FACTOR-BLOB NULL URL ; -: spec>tuple ( class spec -- tuple ) - 3 f pad-right - [ first3 ] keep 3 tail +: ( class slot-name column-name type modifiers -- sql-spec ) sql-spec new swap >>modifiers swap >>type swap >>column-name swap >>slot-name swap >>class - dup normalize-spec ; + dup normalize-spec ; + +: spec>tuple ( class spec -- tuple ) + 3 f pad-right [ first3 ] keep 3 tail ; : number>string* ( n/string -- string ) dup number? [ number>string ] when ; @@ -115,7 +116,6 @@ FACTOR-BLOB NULL URL ; ! PostgreSQL Types: ! http://developer.postgresql.org/pgdocs/postgres/datatype.html - : ?at ( obj assoc -- value/obj ? ) dupd at* [ [ nip ] [ drop ] if ] keep ; @@ -159,8 +159,11 @@ ERROR: no-sql-type type ; HOOK: bind% db ( spec -- ) HOOK: bind# db ( spec obj -- ) +ERROR: no-column column ; + : >reference-string ( string pair -- string ) first2 [ [ unparse join-space ] [ db-columns ] bi ] dip - swap [ slot-name>> = ] with find nip + swap [ column-name>> = ] with find nip + [ no-column ] unless* column-name>> paren append ; From 4b5ed34f9e7cebf0fc7e155ebc6c2119c17197eb Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 30 Sep 2008 08:07:18 -0700 Subject: [PATCH 157/244] Adding 'switch' word to sequences-lib. --- extra/sequences/lib/lib-docs.factor | 11 +++++++++++ extra/sequences/lib/lib.factor | 5 +++++ 2 files changed, 16 insertions(+) diff --git a/extra/sequences/lib/lib-docs.factor b/extra/sequences/lib/lib-docs.factor index e279230b1b..c155bb47ec 100755 --- a/extra/sequences/lib/lib-docs.factor +++ b/extra/sequences/lib/lib-docs.factor @@ -27,3 +27,14 @@ HELP: enumerate { $values { "seq" sequence } { "seq'" sequence } } { $description "Returns a new sequence where each element is an array of { index, value }" } ; +HELP: switch +{ $values { "x" number } { "y" number } { "seq" sequence } } +{ $description "Swaps the values between indices 'x' and 'y' in the sequence." } +{ $examples + { $example + "USING: sequences.lib ;" + "1 2 \"asdf\" [ switch ] keep" + "\"adsf\"" } +} ; + + diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index fe9d9bb587..c23457a332 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -173,3 +173,8 @@ USE: random : enumerate ( seq -- seq' ) >alist ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: switch ( x y seq -- ) + 3dup swap [ nth ] dip [ [ move ] keep ] 2dip rot set-nth ; + From f41733faf1bf0a92b7f7b5e7c13c9e26239932aa Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 30 Sep 2008 11:00:44 -0500 Subject: [PATCH 158/244] add IGNORE types to tuple slots for select --- basis/db/queries/queries.factor | 9 ++++----- basis/db/sqlite/sqlite.factor | 2 +- basis/db/tuples/tuples-tests.factor | 10 ++++++++++ basis/db/types/types.factor | 10 +++++++++- 4 files changed, 24 insertions(+), 7 deletions(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index e3322ada44..17d8870990 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -52,9 +52,7 @@ M: retryable execute-statement* ( statement type -- ) [ 0 sql-counter rot with-variable ] curry { "" { } { } { } } nmake [ maybe-make-retryable ] dip - [ - [ 1array ] dip append - ] unless-empty ; inline + [ [ 1array ] dip append ] unless-empty ; inline : where-primary-key% ( specs -- ) " where " 0% @@ -150,9 +148,10 @@ M: db ( tuple table -- sql ) M: db ( tuple class -- statement ) [ "select " 0% - over [ ", " 0% ] + [ dupd filter-ignores ] dip + over + [ ", " 0% ] [ dup column-name>> 0% 2, ] interleave - " from " 0% 0% where-clause ] query-make ; diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 4fc3dbb227..dfd9fab08c 100755 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -282,7 +282,7 @@ M: sqlite-db persistent-table ( -- assoc ) "sql-spec" get modifiers>> [ +not-null+ = ] contains? not ; : delete-cascade? ( -- ? ) - "sql-spec" get modifiers>> [ +cascade+ = ] contains? ; + "sql-spec" get modifiers>> { +on-delete+ +cascade+ } swap subseq? ; : sqlite-trigger, ( string -- ) { } { } 3, ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index 9550ea1cd8..6114c7ebe1 100755 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -350,6 +350,16 @@ TUPLE: exam id name score ; [ ] [ T{ exam f f "Kenny" 60 } insert-tuple ] unit-test [ ] [ T{ exam f f "Cartman" 41 } insert-tuple ] unit-test + [ 4 ] + [ T{ exam { name IGNORE } { score IGNORE } } select-tuples length ] unit-test + + [ f ] + [ T{ exam { name IGNORE } { score IGNORE } } select-tuples first score>> ] unit-test + + ! FIXME + ! [ f ] + ! [ T{ exam { name IGNORE } { score IGNORE } { id IGNORE } } select-tuples first score>> ] unit-test + [ { T{ exam f 3 "Kenny" 60 } diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index 242339264d..ac9e3397f8 100755 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -29,9 +29,17 @@ SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ +foreign-id+ +has-many+ +on-delete+ +restrict+ +cascade+ +set-null+ +set-default+ ; +SYMBOL: IGNORE + +: filter-ignores ( tuple specs -- specs' ) + [ [ nip IGNORE = ] assoc-filter keys ] dip + [ slot-name>> swap member? not ] with filter ; + +ERROR: no-slot ; + : offset-of-slot ( string tuple -- n ) class superclasses [ "slots" word-prop ] map concat - slot-named offset>> ; + slot-named dup [ no-slot ] unless offset>> ; : get-slot-named ( name tuple -- value ) tuck offset-of-slot slot ; From 21c621d464aa8e9ce481aa57f9c7e3be0b0d8a55 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 30 Sep 2008 18:28:11 -0500 Subject: [PATCH 159/244] Fix erg's ratio bug --- core/math/parser/parser-tests.factor | 3 +++ core/math/parser/parser.factor | 4 ++-- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/core/math/parser/parser-tests.factor b/core/math/parser/parser-tests.factor index aad87ca995..0fb2559854 100755 --- a/core/math/parser/parser-tests.factor +++ b/core/math/parser/parser-tests.factor @@ -108,3 +108,6 @@ unit-test [ -1.0/0.0 ] [ "-1/0." string>number ] unit-test [ "-0.0" ] [ -0.0 number>string ] unit-test + +[ "-3/4" ] [ -3/4 number>string ] unit-test +[ "-1-1/4" ] [ -5/4 number>string ] unit-test diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index a126bbea8e..0134693761 100755 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -105,7 +105,7 @@ GENERIC# >base 1 ( n radix -- str ) base) ( n -- str ) radix get >base ; +: (>base) ( n -- str ) radix get positive>base ; PRIVATE> @@ -123,7 +123,7 @@ M: integer >base M: ratio >base [ dup 0 < negative? set - 1 /mod + abs 1 /mod [ dup zero? [ drop "" ] [ (>base) sign append ] if ] [ [ numerator (>base) ] From 75780d183be071133c14d014ba8ce1cc24b0f4a9 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Wed, 1 Oct 2008 10:57:15 +1000 Subject: [PATCH 160/244] Using inheritance instead of delegation in digraphs --- {unmaintained => extra}/digraphs/authors.txt | 0 .../digraphs/digraphs-tests.factor | 6 ++++-- {unmaintained => extra}/digraphs/digraphs.factor | 11 ++++++----- {unmaintained => extra}/digraphs/summary.txt | 0 {unmaintained => extra}/digraphs/tags.txt | 0 5 files changed, 10 insertions(+), 7 deletions(-) rename {unmaintained => extra}/digraphs/authors.txt (100%) rename {unmaintained => extra}/digraphs/digraphs-tests.factor (72%) rename {unmaintained => extra}/digraphs/digraphs.factor (87%) rename {unmaintained => extra}/digraphs/summary.txt (100%) rename {unmaintained => extra}/digraphs/tags.txt (100%) diff --git a/unmaintained/digraphs/authors.txt b/extra/digraphs/authors.txt similarity index 100% rename from unmaintained/digraphs/authors.txt rename to extra/digraphs/authors.txt diff --git a/unmaintained/digraphs/digraphs-tests.factor b/extra/digraphs/digraphs-tests.factor similarity index 72% rename from unmaintained/digraphs/digraphs-tests.factor rename to extra/digraphs/digraphs-tests.factor index b113c18ca7..64589c1a99 100644 --- a/unmaintained/digraphs/digraphs-tests.factor +++ b/extra/digraphs/digraphs-tests.factor @@ -3,7 +3,9 @@ IN: digraphs.tests : test-digraph ( -- digraph ) - { { "one" 1 } { "two" 2 } { "three" 3 } { "four" 4 } { "five" 5 } } [ first2 pick add-vertex ] each - { { "one" "three" } { "one" "four" } { "two" "three" } { "two" "one" } { "three" "four" } } [ first2 pick add-edge ] each ; + { { "one" 1 } { "two" 2 } { "three" 3 } { "four" 4 } { "five" 5 } } + [ first2 pick add-vertex ] each + { { "one" "three" } { "one" "four" } { "two" "three" } { "two" "one" } { "three" "four" } } + [ first2 pick add-edge ] each ; [ 5 ] [ test-digraph topological-sort length ] unit-test diff --git a/unmaintained/digraphs/digraphs.factor b/extra/digraphs/digraphs.factor similarity index 87% rename from unmaintained/digraphs/digraphs.factor rename to extra/digraphs/digraphs.factor index 7d56c96034..5ccc0d5a60 100755 --- a/unmaintained/digraphs/digraphs.factor +++ b/extra/digraphs/digraphs.factor @@ -1,19 +1,20 @@ ! Copyright (C) 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs kernel sequences vectors ; +USING: accessors assocs hashtables hashtables.private kernel sequences vectors ; IN: digraphs -TUPLE: digraph ; -TUPLE: vertex value edges ; +TUPLE: digraph < hashtable ; : ( -- digraph ) - digraph new H{ } clone over set-delegate ; + 0 digraph new [ reset-hash ] keep ; + +TUPLE: vertex value edges ; : ( value -- vertex ) V{ } clone vertex boa ; : add-vertex ( key value digraph -- ) - >r swap r> set-at ; + [ swap ] dip set-at ; : children ( key digraph -- seq ) at edges>> ; diff --git a/unmaintained/digraphs/summary.txt b/extra/digraphs/summary.txt similarity index 100% rename from unmaintained/digraphs/summary.txt rename to extra/digraphs/summary.txt diff --git a/unmaintained/digraphs/tags.txt b/extra/digraphs/tags.txt similarity index 100% rename from unmaintained/digraphs/tags.txt rename to extra/digraphs/tags.txt From 6a97831ba566cebab4b2f3c9bfffdab89e89ea3c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 30 Sep 2008 22:42:57 -0500 Subject: [PATCH 161/244] Add example to docs --- basis/http/server/static/static-docs.factor | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/basis/http/server/static/static-docs.factor b/basis/http/server/static/static-docs.factor index 866d2a3409..bca72a6126 100644 --- a/basis/http/server/static/static-docs.factor +++ b/basis/http/server/static/static-docs.factor @@ -19,11 +19,7 @@ HELP: enable-fhtml { $notes "See " { $link "html.templates.fhtml" } "." } { $side-effects "responder" } ; -ARTICLE: "http.server.static" "Serving static content" -"The " { $vocab-link "http.server.static" } " vocabulary implements a responder for serving static files." -{ $subsection } -"The static responder does not serve directory listings by default, as a security measure. Directory listings can be enabled by storing a true value in the " { $slot "allow-listings" } " slot." -$nl +ARTICLE: "http.server.static.extend" "Hooks for dynamic content" "The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- )" } "." $nl "A utility word uses the above feature to enable server-side " { $snippet ".fhtml" } " scripts, allowing a development style much like PHP:" @@ -34,4 +30,17 @@ $nl { $subsection } "The default just sends the file's contents with the request; " { $vocab-link "xmode.code2html.responder" } " provides an alternate hook which sends a syntax-highlighted version of the file." ; +ARTICLE: "http.server.static" "Serving static content" +"The " { $vocab-link "http.server.static" } " vocabulary implements a responder for serving static files." +{ $subsection } +"The static responder does not serve directory listings by default, as a security measure. Directory listings can be enabled by storing a true value in the " { $slot "allow-listings" } " slot." +$nl +"If all you want to do is serve files from a directory, the following phrase does the trick:" +{ $code + "USING: namespaces http.server http.server.static ;" + "/var/www/mysite.com/ main-responder set" + "8080 httpd" +} +{ $subsection "http.server.static.extend" } ; + ABOUT: "http.server.static" From ec95a0db6326c2d0502f575d71f8b50321a6e608 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 30 Sep 2008 23:38:11 -0500 Subject: [PATCH 162/244] Fix erg's mouse drag bug --- basis/ui/gadgets/worlds/worlds.factor | 8 ++++---- basis/ui/gestures/gestures.factor | 6 ------ 2 files changed, 4 insertions(+), 10 deletions(-) diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 1bdc63ed0e..6f901c37ee 100755 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -101,10 +101,10 @@ world H{ { T{ key-down f { C+ } "c" } [ T{ copy-action } send-action ] } { T{ key-down f { C+ } "v" } [ T{ paste-action } send-action ] } { T{ key-down f { C+ } "a" } [ T{ select-all-action } send-action ] } - { T{ button-down f { C+ } 1 } [ T{ button-down f f 3 } swap resend-button-down ] } - { T{ button-down f { A+ } 1 } [ T{ button-down f f 2 } swap resend-button-down ] } - { T{ button-up f { C+ } 1 } [ T{ button-up f f 3 } swap resend-button-up ] } - { T{ button-up f { A+ } 1 } [ T{ button-up f f 2 } swap resend-button-up ] } + { T{ button-down f { C+ } 1 } [ drop T{ button-down f f 3 } button-gesture ] } + { T{ button-down f { A+ } 1 } [ drop T{ button-down f f 2 } button-gesture ] } + { T{ button-up f { C+ } 1 } [ drop T{ button-up f f 3 } button-gesture ] } + { T{ button-up f { A+ } 1 } [ drop T{ button-up f f 2 } button-gesture ] } } set-gestures : close-global ( world global -- ) diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index a1c6adac6e..2a29d32055 100755 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -249,12 +249,6 @@ SYMBOL: drag-timer : send-action ( world gesture -- ) swap world-focus send-gesture drop ; -: resend-button-down ( gesture world -- ) - hand-loc get-global swap send-button-down ; - -: resend-button-up ( gesture world -- ) - hand-loc get-global swap send-button-up ; - GENERIC: gesture>string ( gesture -- string/f ) : modifiers>string ( modifiers -- string ) From 8cb3c1eb5e9b8070c595933c7634ea3a1da6ab85 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 03:12:35 -0500 Subject: [PATCH 163/244] Literal hashtables now cross-referenced --- core/words/words.factor | 2 ++ 1 file changed, 2 insertions(+) diff --git a/core/words/words.factor b/core/words/words.factor index 5627a1a015..b7b34f1d22 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -87,6 +87,8 @@ M: word (quot-uses) over crossref? [ conjoin ] [ 2drop ] if ; M: array (quot-uses) seq-uses ; +M: hashtable (quot-uses) >r >alist r> seq-uses ; + M: callable (quot-uses) seq-uses ; M: wrapper (quot-uses) >r wrapped>> r> (quot-uses) ; From b546ad3c6d920a38ab83ee267b3c2da65e91c003 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 03:13:56 -0500 Subject: [PATCH 164/244] Fix problem odd headers sent by Windows CE --- basis/http/server/static/static.factor | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/basis/http/server/static/static.factor b/basis/http/server/static/static.factor index 5ae18156b0..3e3307033a 100755 --- a/basis/http/server/static/static.factor +++ b/basis/http/server/static/static.factor @@ -3,7 +3,7 @@ USING: calendar io io.files kernel math math.order math.parser namespaces parser sequences strings assocs hashtables debugger mime-types sorting logging -calendar.format accessors +calendar.format accessors splitting io.encodings.binary fry xml.entities destructors urls html.elements html.templates.fhtml http @@ -14,9 +14,13 @@ IN: http.server.static TUPLE: file-responder root hook special allow-listings ; +: modified-since ( request -- date ) + "if-modified-since" header ";" split1 drop + dup [ rfc822>timestamp ] when ; + : modified-since? ( filename -- ? ) - request get "if-modified-since" header dup [ - [ file-info modified>> ] [ rfc822>timestamp ] bi* after? + request get modified-since dup [ + [ file-info modified>> ] dip after? ] [ 2drop t ] if ; From c3f9d2180a63f6febd262e5966a931e63450d72f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 03:35:41 -0500 Subject: [PATCH 165/244] Fix typo --- core/classes/classes-docs.factor | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor index ff7aac36d3..f8a2ff415c 100755 --- a/core/classes/classes-docs.factor +++ b/core/classes/classes-docs.factor @@ -28,12 +28,13 @@ $nl $nl "Classes themselves form a class:" { $subsection class? } -"You can ask an object for its class or superclass:" +"You can ask an object for its class:" { $subsection class } -{ $subsection superclass } -{ $subsection superclasses } "Testing if an object is an instance of a class:" { $subsection instance? } +"You can ask a class for its superclass:" +{ $subsection superclass } +{ $subsection superclasses } "Class predicates can be used to test instances directly:" { $subsection "class-predicates" } "There is a universal class which all objects are an instance of, and an empty class with no instances:" From 1cf1d967ea7352870d57b951f8d68f21b2e53002 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 05:43:20 -0500 Subject: [PATCH 166/244] New combinators for incremental HTTP requests --- basis/http/client/client-docs.factor | 15 +++- basis/http/client/client-tests.factor | 3 + basis/http/client/client.factor | 114 +++++++++++++++----------- 3 files changed, 84 insertions(+), 48 deletions(-) diff --git a/basis/http/client/client-docs.factor b/basis/http/client/client-docs.factor index ed846320c3..a762d1a5ef 100644 --- a/basis/http/client/client-docs.factor +++ b/basis/http/client/client-docs.factor @@ -39,11 +39,21 @@ HELP: http-post { $description "Submits a form at a URL." } { $errors "Throws an error if the HTTP request fails." } ; +HELP: with-http-get +{ $values { "url" "a " { $link url } " or " { $link string } } { "quot" "a quotation with stack effect " { $snippet "( chunk -- )" } } { "response" response } } +{ $description "Downloads the contents of a URL. Chunks of data are passed to the quotation as they are read." } +{ $errors "Throws an error if the HTTP request fails." } ; + HELP: http-request { $values { "request" request } { "response" response } { "data" sequence } } { $description "Sends an HTTP request to an HTTP server, and reads the response." } { $errors "Throws an error if the HTTP request fails." } ; +HELP: with-http-request +{ $values { "request" request } { "quot" "a quotation with stack effect " { $snippet "( chunk -- )" } } { "response" response } } +{ $description "Sends an HTTP request to an HTTP server, and reads the response incrementally. Chunks of data are passed to the quotation as they are read." } +{ $errors "Throws an error if the HTTP request fails." } ; + ARTICLE: "http.client.get" "GET requests with the HTTP client" "Basic usage involves passing a " { $link url } " and getting a " { $link response } " and data back:" { $subsection http-get } @@ -52,7 +62,10 @@ ARTICLE: "http.client.get" "GET requests with the HTTP client" { $subsection download-to } "Advanced usage involves constructing a " { $link request } ", which allows " { $link "http.cookies" } " and " { $link "http.headers" } " to be set:" { $subsection } -{ $subsection http-request } ; +{ $subsection http-request } +"The " { $link http-get } " and " { $link http-request } " words output sequences. This is undesirable if the response data may be large. Another pair of words take a quotation instead, and pass the quotation chunks of data incrementally:" +{ $subsection with-http-get } +{ $subsection with-http-request } ; ARTICLE: "http.client.post" "POST requests with the HTTP client" "As with GET requests, there is a high-level word which takes a " { $link url } " and a lower-level word which constructs an HTTP request object which can be passed to " { $link http-request } ":" diff --git a/basis/http/client/client-tests.factor b/basis/http/client/client-tests.factor index 1219ae0b97..4dcc6b8813 100755 --- a/basis/http/client/client-tests.factor +++ b/basis/http/client/client-tests.factor @@ -1,5 +1,8 @@ USING: http.client http.client.private http tools.test namespaces urls ; + +\ download must-infer + [ "localhost" f ] [ "localhost" parse-host ] unit-test [ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index 174c4e1b3a..aa1e0771ba 100755 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -3,7 +3,7 @@ USING: accessors assocs kernel math math.parser namespaces make sequences io io.sockets io.streams.string io.files io.timeouts strings splitting calendar continuations accessors vectors -math.order hashtables byte-arrays prettyprint +math.order hashtables byte-arrays prettyprint destructors io.encodings io.encodings.string io.encodings.ascii @@ -88,72 +88,92 @@ M: too-many-redirects summary drop [ "Redirection limit of " % max-redirects # " exceeded" % ] "" make ; -DEFER: (http-request) - url derive-url ensure-port ] change-url ; -: do-redirect ( response data -- response data ) - over code>> 300 399 between? [ - drop - redirects inc - redirects get max-redirects < [ - request get - swap "location" header redirect-url - "GET" >>method (http-request) - ] [ - too-many-redirects - ] if - ] when ; +: redirect? ( response -- ? ) + code>> 300 399 between? ; -PRIVATE> +: do-redirect ( quot: ( chunk -- ) response -- response ) + redirects inc + redirects get max-redirects < [ + request get clone + swap "location" header redirect-url + "GET" >>method swap (with-http-request) + ] [ too-many-redirects ] if ; inline recursive : read-chunk-size ( -- n ) read-crlf ";" split1 drop [ blank? ] trim-right hex> [ "Bad chunk size" throw ] unless* ; -: read-chunks ( -- ) +: read-chunked ( quot: ( chunk -- ) -- ) read-chunk-size dup zero? - [ drop ] [ read % read-crlf B{ } assert= read-chunks ] if ; + [ 2drop ] [ + read [ swap call ] [ drop ] 2bi + read-crlf B{ } assert= read-chunked + ] if ; inline recursive -: read-response-body ( response -- response data ) - dup "transfer-encoding" header "chunked" = [ - binary decode-input - [ read-chunks ] B{ } make - over content-charset>> decode - ] [ - dup content-charset>> decode-input - input-stream get contents - ] if ; +: read-unchunked ( quot: ( chunk -- ) -- ) + 8192 read dup [ + [ swap call ] [ drop read-unchunked ] 2bi + ] [ 2drop ] if ; inline recursive -: (http-request) ( request -- response data ) - dup request [ - dup url>> url-addr ascii [ - 1 minutes timeouts - write-request - read-response - read-response-body - ] with-client - do-redirect - ] with-variable ; +: read-response-body ( quot response -- ) + binary decode-input + "transfer-encoding" header "chunked" = + [ read-chunked ] [ read-unchunked ] if ; inline + +: ( -- stream ) + request get url>> url-addr ascii drop + 1 minutes over set-timeout ; + +: (with-http-request) ( request quot: ( chunk -- ) -- response ) + swap + request [ + [ + [ + out>> + [ request get write-request ] + with-output-stream* + ] [ + in>> [ + read-response dup redirect? [ t ] [ + [ nip response set ] + [ read-response-body ] + [ ] + 2tri f + ] if + ] with-input-stream* + ] bi + ] with-disposal + [ do-redirect ] [ nip ] if + ] with-variable ; inline recursive + +PRIVATE> : success? ( code -- ? ) 200 = ; -ERROR: download-failed response body ; +ERROR: download-failed response ; M: download-failed error. - "HTTP download failed:" print nl - [ response>> . nl ] [ body>> write ] bi ; + "HTTP request failed:" print nl + response>> . ; -: check-response ( response data -- response data ) - over code>> success? [ download-failed ] unless ; +: check-response ( response -- response ) + dup code>> success? [ download-failed ] unless ; + +: with-http-request ( request quot -- response ) + (with-http-request) check-response ; inline : http-request ( request -- response data ) - (http-request) check-response ; + [ [ % ] with-http-request ] B{ } make + over content-charset>> decode ; : ( url -- request ) @@ -163,14 +183,14 @@ M: download-failed error. : http-get ( url -- response data ) http-request ; +: with-http-get ( url quot -- response ) + [ ] dip with-http-request ; inline + : download-name ( url -- name ) present file-name "?" split1 drop "/" ?tail drop ; : download-to ( url file -- ) - #! Downloads the contents of a URL to a file. - swap http-get - [ content-charset>> ] [ '[ _ write ] ] bi* - with-file-writer ; + binary [ [ write ] with-http-get drop ] with-file-writer ; : download ( url -- ) dup download-name download-to ; From 34952ff5c4f1a09e3b319a55a112e95e6865298d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 08:20:49 -0500 Subject: [PATCH 167/244] Faster call-next-method --- basis/bootstrap/image/image.factor | 2 +- core/classes/classes.factor | 7 +++++-- core/generic/generic.factor | 13 ++++++++----- 3 files changed, 14 insertions(+), 8 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index f3f570b462..db8e8c8ec0 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -417,7 +417,7 @@ M: quotation ' } [ [ bootstrap-word ] [ get ] bi ] H{ } map>assoc { class<=-cache class-not-cache classes-intersect-cache - class-and-cache class-or-cache + class-and-cache class-or-cache next-method-quot-cache } [ H{ } clone ] H{ } map>assoc assoc-union bootstrap-global set bootstrap-global emit-userenv ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 67a789a1dc..dcb69c9149 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -10,20 +10,23 @@ SYMBOL: class-not-cache SYMBOL: classes-intersect-cache SYMBOL: class-and-cache SYMBOL: class-or-cache +SYMBOL: next-method-quot-cache : init-caches ( -- ) H{ } clone class<=-cache set H{ } clone class-not-cache set H{ } clone classes-intersect-cache set H{ } clone class-and-cache set - H{ } clone class-or-cache set ; + H{ } clone class-or-cache set + H{ } clone next-method-quot-cache set ; : reset-caches ( -- ) class<=-cache get clear-assoc class-not-cache get clear-assoc classes-intersect-cache get clear-assoc class-and-cache get clear-assoc - class-or-cache get clear-assoc ; + class-or-cache get clear-assoc + next-method-quot-cache get clear-assoc ; SYMBOL: update-map diff --git a/core/generic/generic.factor b/core/generic/generic.factor index 026e372912..d25a98c53c 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -45,7 +45,9 @@ GENERIC: effective-method ( generic -- method ) GENERIC: next-method-quot* ( class generic combination -- quot ) : next-method-quot ( class generic -- quot ) - dup "combination" word-prop next-method-quot* ; + next-method-quot-cache get [ + dup "combination" word-prop next-method-quot* + ] 2cache ; : (call-next-method) ( class generic -- ) next-method-quot call ; @@ -99,10 +101,11 @@ M: method-body crossref? 2bi ; : create-method ( class generic -- method ) - 2dup method dup [ - 2nip - ] [ - drop [ dup ] 2keep reveal-method + 2dup method dup [ 2nip ] [ + drop + [ dup ] 2keep + reveal-method + reset-caches ] if ; PREDICATE: default-method < word "default" word-prop ; From e1a2bfc048e92319a9cfc0da366bcc1641834e6a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 08:38:50 -0500 Subject: [PATCH 168/244] Oops --- core/generic/generic-tests.factor | 14 ++++++++++++++ core/generic/generic.factor | 4 ++-- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/core/generic/generic-tests.factor b/core/generic/generic-tests.factor index 22c690ffaf..aae76184ff 100755 --- a/core/generic/generic-tests.factor +++ b/core/generic/generic-tests.factor @@ -222,3 +222,17 @@ M: integer a-generic a-word ; M: boii jeah ; "> eval ] unit-test + +! call-next-method cache test +GENERIC: c-n-m-cache ( a -- b ) + +! Force it to be unoptimized +M: fixnum c-n-m-cache { } [ ] like call call-next-method ; +M: integer c-n-m-cache 1 + ; +M: number c-n-m-cache ; + +[ 3 ] [ 2 c-n-m-cache ] unit-test + +[ ] [ [ { integer c-n-m-cache } forget ] with-compilation-unit ] unit-test + +[ 2 ] [ 2 c-n-m-cache ] unit-test diff --git a/core/generic/generic.factor b/core/generic/generic.factor index d25a98c53c..095a8d5dcc 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -152,8 +152,8 @@ M: method-body forget* ] keep eq? [ [ [ delete-at ] with-methods ] - [ [ delete-at ] with-implementors ] - 2bi + [ [ delete-at ] with-implementors ] 2bi + reset-caches ] [ 2drop ] if ] if ] From 3360f5a3acf34ca2585951d4c08564615938654c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 12:50:49 -0500 Subject: [PATCH 169/244] add irc-log webapp to redirect you to today's \#concatenative log --- extra/webapps/irc-log/authors.txt | 1 + extra/webapps/irc-log/irc-log.factor | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100644 extra/webapps/irc-log/authors.txt create mode 100644 extra/webapps/irc-log/irc-log.factor diff --git a/extra/webapps/irc-log/authors.txt b/extra/webapps/irc-log/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/webapps/irc-log/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/extra/webapps/irc-log/irc-log.factor b/extra/webapps/irc-log/irc-log.factor new file mode 100644 index 0000000000..c193550719 --- /dev/null +++ b/extra/webapps/irc-log/irc-log.factor @@ -0,0 +1,22 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: calendar kernel http.server.dispatchers prettyprint +sequences printf furnace.actions html.forms accessors +furnace.redirection ; +IN: webapps.irc-log + +TUPLE: irclog-app < dispatcher ; + +: irc-link ( -- string ) + gmt -7 hours convert-timezone >date< + [ unparse 2 tail ] 2dip + "http://bespin.org/~nef/logs/concatenative/%02s.%02d.%02d" + sprintf ; + +: ( -- action ) + + [ irc-link ] >>display ; + +: ( -- dispatcher ) + irclog-app new-dispatcher + "" add-responder ; From 27c38f6d303df2af94f32e3c9758dc1bc3612904 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 14:19:28 -0500 Subject: [PATCH 170/244] checkin for prunedtree, i wrote some docs and spaced things a little better --- extra/suffix-arrays/authors.txt | 1 + extra/suffix-arrays/suffix-arrays-docs.factor | 44 +++++++++++++++++++ .../suffix-arrays/suffix-arrays-tests.factor | 27 ++++++++++++ extra/suffix-arrays/suffix-arrays.factor | 31 +++++++++++++ extra/suffix-arrays/summary.txt | 1 + extra/suffix-arrays/tags.txt | 1 + extra/suffix-arrays/words/words.factor | 19 ++++++++ 7 files changed, 124 insertions(+) create mode 100755 extra/suffix-arrays/authors.txt create mode 100755 extra/suffix-arrays/suffix-arrays-docs.factor create mode 100755 extra/suffix-arrays/suffix-arrays-tests.factor create mode 100755 extra/suffix-arrays/suffix-arrays.factor create mode 100755 extra/suffix-arrays/summary.txt create mode 100755 extra/suffix-arrays/tags.txt create mode 100755 extra/suffix-arrays/words/words.factor diff --git a/extra/suffix-arrays/authors.txt b/extra/suffix-arrays/authors.txt new file mode 100755 index 0000000000..e4a36df7ef --- /dev/null +++ b/extra/suffix-arrays/authors.txt @@ -0,0 +1 @@ +Marc Fauconneau \ No newline at end of file diff --git a/extra/suffix-arrays/suffix-arrays-docs.factor b/extra/suffix-arrays/suffix-arrays-docs.factor new file mode 100755 index 0000000000..3bea1d26fd --- /dev/null +++ b/extra/suffix-arrays/suffix-arrays-docs.factor @@ -0,0 +1,44 @@ +! Copyright (C) 2008 Marc Fauconneau. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays help.markup help.syntax io.streams.string +sequences strings math ; +IN: suffix-arrays + +HELP: >suffix-array +{ $values + { "seq" sequence } + { "array" array } } +{ $description "Creates a suffix array from the input sequence." } ; + +HELP: SA{ +{ $description "Creates a new literal suffix array at parse-time." } ; + +HELP: suffixes +{ $values + { "string" string } + { "suffixes-seq" "a sequence of slices" } } +{ $description "Returns a sequence of tail slices of the input string." } ; + +HELP: from-to +{ $values + { "index" integer } { "suffix-array" "a suffix-array" } { "begin" string } + { "from" integer } { "to" integer } } +{ $notes "Slices are [m,n) and we want (m,n) so we increment." } ; + +HELP: query +{ $values + { "begin" string } { "suffix-array" "a suffix-array" } + { "matches" array } } +{ $description "Returns " } ; + +ARTICLE: "suffix-arrays" "Suffix arrays" +"The " { $vocab-link "suffix-arrays" } " vocabulary implements the suffix array data structure for efficient lookup of subsequences." $nl + +"Creating new suffix arrays:" +{ $subsection >suffix-array } +"Literal suffix arrays:" +{ $subsection POSTPONE: SA{ } +"Querying suffix arrays:" +{ $subsection query } ; + +ABOUT: "suffix-arrays" diff --git a/extra/suffix-arrays/suffix-arrays-tests.factor b/extra/suffix-arrays/suffix-arrays-tests.factor new file mode 100755 index 0000000000..f4efd8e002 --- /dev/null +++ b/extra/suffix-arrays/suffix-arrays-tests.factor @@ -0,0 +1,27 @@ +! Copyright (C) 2008 Marc Fauconneau. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test suffix-arrays kernel namespaces ; +IN: suffix-arrays.tests + +! built from [ all-words 10 head [ name>> ] map ] +{ + "run-tests" + "must-fail-with" + "test-all" + "short-effect" + "failure" + "test" + "" + "this-test" + "(unit-test)" + "unit-test" +} "strings" set + +[ "strings" get >suffix-array "" swap query ] must-fail + +[ { } >suffix-array "something" swap query ] must-fail + +[ V{ "unit-test" "(unit-test)" } ] +[ "strings" get >suffix-array "unit-test" swap query ] unit-test + +[ V{ } ] [ "strings" get >suffix-array "something else" swap query ] unit-test diff --git a/extra/suffix-arrays/suffix-arrays.factor b/extra/suffix-arrays/suffix-arrays.factor new file mode 100755 index 0000000000..d51548017b --- /dev/null +++ b/extra/suffix-arrays/suffix-arrays.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Marc Fauconneau. +! See http://factorcode.org/license.txt for BSD license. +USING: parser kernel arrays math accessors sequences +math.vectors math.order sorting binary-search sets assocs fry ; +IN: suffix-arrays + +! this suffix array is a sorted array of suffixes +! query is efficient through binary searches + +: suffixes ( string -- suffixes-seq ) + dup length [ tail-slice ] with map ; + +: >suffix-array ( seq -- array ) + [ suffixes ] map concat natural-sort ; + +: SA{ \ } [ >suffix-array ] parse-literal ; parsing + +: prefix<=> ( seq begin -- <=> ) + [ swap <=> ] [ head? ] 2bi [ drop +eq+ ] when ; + +: find-index ( suffix-array begin -- index ) + '[ _ prefix<=> ] search drop ; + +: from-to ( index suffix-array begin -- from to ) + '[ _ head? not ] + [ find-last-from drop 1+ ] + [ find-from drop ] 3bi ; + +: query ( begin suffix-array -- matches ) + [ swap [ find-index ] 2keep from-to [ min ] keep ] keep + [ seq>> ] map prune ; diff --git a/extra/suffix-arrays/summary.txt b/extra/suffix-arrays/summary.txt new file mode 100755 index 0000000000..71eda476bc --- /dev/null +++ b/extra/suffix-arrays/summary.txt @@ -0,0 +1 @@ +Suffix arrays diff --git a/extra/suffix-arrays/tags.txt b/extra/suffix-arrays/tags.txt new file mode 100755 index 0000000000..42d711b32b --- /dev/null +++ b/extra/suffix-arrays/tags.txt @@ -0,0 +1 @@ +collections diff --git a/extra/suffix-arrays/words/words.factor b/extra/suffix-arrays/words/words.factor new file mode 100755 index 0000000000..74e2fc2f97 --- /dev/null +++ b/extra/suffix-arrays/words/words.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2008 Marc Fauconneau. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel arrays math accessors sequences math.vectors +math.order sorting binary-search sets assocs fry suffix-arrays ; +IN: suffix-arrays.words + +! to search on word names + +: new-word-sa ( words -- sa ) + [ name>> ] map >suffix-array ; + +: name>word-map ( words -- map ) + dup [ name>> V{ } clone ] H{ } map>assoc + [ '[ dup name>> _ at push ] each ] keep ; + +: query-word-sa ( map begin sa -- matches ) query '[ _ at ] map concat ; + +! usage example : +! clear all-words 100 head dup name>word-map "test" rot new-word-sa query . From 4c502165e7feb249f6c7670e077e8f9af84a1c3c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 14:49:21 -0500 Subject: [PATCH 171/244] a little bit of cleanup, trying to get rid of some stack shuffling --- extra/suffix-arrays/suffix-arrays-docs.factor | 4 +- .../suffix-arrays/suffix-arrays-tests.factor | 37 ++++++++++--------- extra/suffix-arrays/suffix-arrays.factor | 29 +++++++-------- 3 files changed, 36 insertions(+), 34 deletions(-) diff --git a/extra/suffix-arrays/suffix-arrays-docs.factor b/extra/suffix-arrays/suffix-arrays-docs.factor index 3bea1d26fd..879839d8cd 100755 --- a/extra/suffix-arrays/suffix-arrays-docs.factor +++ b/extra/suffix-arrays/suffix-arrays-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Marc Fauconneau. ! See http://factorcode.org/license.txt for BSD license. USING: arrays help.markup help.syntax io.streams.string -sequences strings math ; +sequences strings math suffix-arrays.private ; IN: suffix-arrays HELP: >suffix-array @@ -32,7 +32,7 @@ HELP: query { $description "Returns " } ; ARTICLE: "suffix-arrays" "Suffix arrays" -"The " { $vocab-link "suffix-arrays" } " vocabulary implements the suffix array data structure for efficient lookup of subsequences." $nl +"The " { $vocab-link "suffix-arrays" } " vocabulary implements the suffix array data structure for efficient lookup of subsequences. This suffix array implementation is a sorted array of suffixes. Querying it for matches uses binary search for efficiency." $nl "Creating new suffix arrays:" { $subsection >suffix-array } diff --git a/extra/suffix-arrays/suffix-arrays-tests.factor b/extra/suffix-arrays/suffix-arrays-tests.factor index f4efd8e002..8904d35362 100755 --- a/extra/suffix-arrays/suffix-arrays-tests.factor +++ b/extra/suffix-arrays/suffix-arrays-tests.factor @@ -1,27 +1,30 @@ ! Copyright (C) 2008 Marc Fauconneau. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test suffix-arrays kernel namespaces ; +USING: tools.test suffix-arrays kernel namespaces sequences ; IN: suffix-arrays.tests ! built from [ all-words 10 head [ name>> ] map ] -{ - "run-tests" - "must-fail-with" - "test-all" - "short-effect" - "failure" - "test" - "" - "this-test" - "(unit-test)" - "unit-test" -} "strings" set +[ ] [ + SA{ + "run-tests" + "must-fail-with" + "test-all" + "short-effect" + "failure" + "test" + "" + "this-test" + "(unit-test)" + "unit-test" + } "suffix-array" set +] unit-test -[ "strings" get >suffix-array "" swap query ] must-fail +[ "suffix-array" get "" swap query ] must-fail -[ { } >suffix-array "something" swap query ] must-fail +[ SA{ } "something" swap query ] must-fail [ V{ "unit-test" "(unit-test)" } ] -[ "strings" get >suffix-array "unit-test" swap query ] unit-test +[ "suffix-array" get "unit-test" swap query ] unit-test -[ V{ } ] [ "strings" get >suffix-array "something else" swap query ] unit-test +[ t ] +[ "suffix-array" get "something else" swap query empty? ] unit-test diff --git a/extra/suffix-arrays/suffix-arrays.factor b/extra/suffix-arrays/suffix-arrays.factor index d51548017b..2cf2076732 100755 --- a/extra/suffix-arrays/suffix-arrays.factor +++ b/extra/suffix-arrays/suffix-arrays.factor @@ -4,28 +4,27 @@ USING: parser kernel arrays math accessors sequences math.vectors math.order sorting binary-search sets assocs fry ; IN: suffix-arrays -! this suffix array is a sorted array of suffixes -! query is efficient through binary searches - + ( begin seq -- <=> ) + [ <=> ] [ swap head? ] 2bi [ drop +eq+ ] when ; + +: find-index ( begin suffix-array -- index ) + [ prefix<=> ] with search drop ; + +: from-to ( index begin suffix-array -- from to ) + swap '[ _ head? not ] + [ find-last-from drop 1+ ] + [ find-from drop ] 3bi ; +PRIVATE> + : >suffix-array ( seq -- array ) [ suffixes ] map concat natural-sort ; : SA{ \ } [ >suffix-array ] parse-literal ; parsing -: prefix<=> ( seq begin -- <=> ) - [ swap <=> ] [ head? ] 2bi [ drop +eq+ ] when ; - -: find-index ( suffix-array begin -- index ) - '[ _ prefix<=> ] search drop ; - -: from-to ( index suffix-array begin -- from to ) - '[ _ head? not ] - [ find-last-from drop 1+ ] - [ find-from drop ] 3bi ; - : query ( begin suffix-array -- matches ) - [ swap [ find-index ] 2keep from-to [ min ] keep ] keep + [ [ find-index ] 2keep from-to [ min ] keep ] keep [ seq>> ] map prune ; From 64af1a9e67e5f485650dc6f869137b2fbfd002cc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 16:00:23 -0500 Subject: [PATCH 172/244] handle boundary cases better in suffix-arrays. more unit tests --- extra/suffix-arrays/suffix-arrays-docs.factor | 8 ++++---- .../suffix-arrays/suffix-arrays-tests.factor | 18 ++++++++++++----- extra/suffix-arrays/suffix-arrays.factor | 20 ++++++++++++++----- 3 files changed, 32 insertions(+), 14 deletions(-) diff --git a/extra/suffix-arrays/suffix-arrays-docs.factor b/extra/suffix-arrays/suffix-arrays-docs.factor index 879839d8cd..55a78b2cb6 100755 --- a/extra/suffix-arrays/suffix-arrays-docs.factor +++ b/extra/suffix-arrays/suffix-arrays-docs.factor @@ -8,7 +8,7 @@ HELP: >suffix-array { $values { "seq" sequence } { "array" array } } -{ $description "Creates a suffix array from the input sequence." } ; +{ $description "Creates a suffix array from the input sequence. Suffix arrays are arrays of slices." } ; HELP: SA{ { $description "Creates a new literal suffix array at parse-time." } ; @@ -21,15 +21,15 @@ HELP: suffixes HELP: from-to { $values - { "index" integer } { "suffix-array" "a suffix-array" } { "begin" string } + { "index" integer } { "suffix-array" "a suffix-array" } { "begin" sequence } { "from" integer } { "to" integer } } { $notes "Slices are [m,n) and we want (m,n) so we increment." } ; HELP: query { $values - { "begin" string } { "suffix-array" "a suffix-array" } + { "begin" sequence } { "suffix-array" "a suffix-array" } { "matches" array } } -{ $description "Returns " } ; +{ $description "Returns a sequence of sequences from the suffix-array that contain the input sequence. An empty array is returned when there are no matches." } ; ARTICLE: "suffix-arrays" "Suffix arrays" "The " { $vocab-link "suffix-arrays" } " vocabulary implements the suffix array data structure for efficient lookup of subsequences. This suffix array implementation is a sorted array of suffixes. Querying it for matches uses binary search for efficiency." $nl diff --git a/extra/suffix-arrays/suffix-arrays-tests.factor b/extra/suffix-arrays/suffix-arrays-tests.factor index 8904d35362..5149804ce6 100755 --- a/extra/suffix-arrays/suffix-arrays-tests.factor +++ b/extra/suffix-arrays/suffix-arrays-tests.factor @@ -4,8 +4,8 @@ USING: tools.test suffix-arrays kernel namespaces sequences ; IN: suffix-arrays.tests ! built from [ all-words 10 head [ name>> ] map ] -[ ] [ - SA{ +[ ] [ + { "run-tests" "must-fail-with" "test-all" @@ -16,15 +16,23 @@ IN: suffix-arrays.tests "this-test" "(unit-test)" "unit-test" - } "suffix-array" set + } >suffix-array "suffix-array" set ] unit-test -[ "suffix-array" get "" swap query ] must-fail +[ t ] +[ "suffix-array" get "" swap query empty? not ] unit-test -[ SA{ } "something" swap query ] must-fail +[ { } ] +[ SA{ } "something" swap query ] unit-test [ V{ "unit-test" "(unit-test)" } ] [ "suffix-array" get "unit-test" swap query ] unit-test [ t ] [ "suffix-array" get "something else" swap query empty? ] unit-test + +[ V{ "rofl" } ] [ SA{ "rofl" } "r" swap query ] unit-test +[ V{ "rofl" } ] [ SA{ "rofl" } "o" swap query ] unit-test +[ V{ "rofl" } ] [ SA{ "rofl" } "f" swap query ] unit-test +[ V{ "rofl" } ] [ SA{ "rofl" } "l" swap query ] unit-test +[ V{ } ] [ SA{ "rofl" } "t" swap query ] unit-test diff --git a/extra/suffix-arrays/suffix-arrays.factor b/extra/suffix-arrays/suffix-arrays.factor index 2cf2076732..719496243c 100755 --- a/extra/suffix-arrays/suffix-arrays.factor +++ b/extra/suffix-arrays/suffix-arrays.factor @@ -11,13 +11,22 @@ IN: suffix-arrays : prefix<=> ( begin seq -- <=> ) [ <=> ] [ swap head? ] 2bi [ drop +eq+ ] when ; -: find-index ( begin suffix-array -- index ) +: find-index ( begin suffix-array -- index/f ) [ prefix<=> ] with search drop ; -: from-to ( index begin suffix-array -- from to ) +: from-to ( index begin suffix-array -- from/f to/f ) swap '[ _ head? not ] - [ find-last-from drop 1+ ] + [ find-last-from drop dup [ 1+ ] when ] [ find-from drop ] 3bi ; + +: ( from/f to/f seq -- slice ) + [ + tuck + [ drop [ 0 ] unless* ] + [ dupd length ? ] 2bi* + [ min ] keep + ] keep ; + PRIVATE> : >suffix-array ( seq -- array ) @@ -26,5 +35,6 @@ PRIVATE> : SA{ \ } [ >suffix-array ] parse-literal ; parsing : query ( begin suffix-array -- matches ) - [ [ find-index ] 2keep from-to [ min ] keep ] keep - [ seq>> ] map prune ; + 2dup find-index + [ -rot [ from-to ] keep [ seq>> ] map prune ] + [ 2drop { } ] if* ; From 01fcb1b856d05e356bd97c73d79b08b2d85f19a7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 16:04:32 -0500 Subject: [PATCH 173/244] fix help-lint --- extra/suffix-arrays/suffix-arrays-docs.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/extra/suffix-arrays/suffix-arrays-docs.factor b/extra/suffix-arrays/suffix-arrays-docs.factor index 55a78b2cb6..87df27281e 100755 --- a/extra/suffix-arrays/suffix-arrays-docs.factor +++ b/extra/suffix-arrays/suffix-arrays-docs.factor @@ -21,8 +21,9 @@ HELP: suffixes HELP: from-to { $values - { "index" integer } { "suffix-array" "a suffix-array" } { "begin" sequence } - { "from" integer } { "to" integer } } + { "index" integer } { "begin" sequence } { "suffix-array" "a suffix-array" } + { "from/f" "an integer or f" } { "to/f" "an integer or f" } } +{ $description "Finds the bounds of the suffix array that match the input sequence. A return value of " { $link f } " means that the endpoint is included." } { $notes "Slices are [m,n) and we want (m,n) so we increment." } ; HELP: query From 87bb2240fc27f28d2d45ba4b17f76f74662ab342 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 17:11:19 -0500 Subject: [PATCH 174/244] add line-breaks? flag to farkup just for kicks. it might be useful --- basis/farkup/farkup.factor | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/basis/farkup/farkup.factor b/basis/farkup/farkup.factor index 73b0cba4d0..21e3c05d04 100644 --- a/basis/farkup/farkup.factor +++ b/basis/farkup/farkup.factor @@ -9,6 +9,7 @@ IN: farkup SYMBOL: relative-link-prefix SYMBOL: disable-images? SYMBOL: link-no-follow? +SYMBOL: line-breaks? TUPLE: heading1 child ; TUPLE: heading2 child ; @@ -29,6 +30,7 @@ TUPLE: link href text ; TUPLE: image href text ; TUPLE: code mode string ; TUPLE: line ; +TUPLE: line-break ; : absolute-url? ( string -- ? ) { "http://" "https://" "ftp://" } [ head? ] with contains? ; @@ -109,7 +111,9 @@ table = ((table-row nl => [[ first ]] )+ table-row? | table-row) text = (!(nl | code | heading | inline-delimiter | table ).)+ => [[ >string ]] -paragraph-nl-item = nl (list | line)? +paragraph-nl-item = nl list + | nl line + | nl => [[ line-breaks? get [ drop line-break new ] when ]] paragraph-item = (table | code | text | inline-tag | inline-delimiter)+ paragraph = ((paragraph-item paragraph-nl-item)+ nl+ => [[ first ]] | (paragraph-item paragraph-nl-item)+ paragraph-item? @@ -209,6 +213,7 @@ M: link (write-farkup) [ href>> ] [ text>> ] bi write-link ; M: image (write-farkup) [ href>> ] [ text>> ] bi write-image-link ; M: code (write-farkup) [ string>> ] [ mode>> ] bi render-code ; M: line (write-farkup) drop
          ; +M: line-break (write-farkup) drop
          nl ; M: table-row (write-farkup) ( obj -- ) child>> [ [ [ (write-farkup) ] "td" in-tag. ] each ] "tr" in-tag. ; M: table (write-farkup) [ child>> (write-farkup) ] "table" in-tag. ; From 177de0bf0b2d7e7118ebc3c9cc70927c06e3ee5f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 17:52:37 -0500 Subject: [PATCH 175/244] add assoc-deques --- extra/assoc-deques/assoc-deques-docs.factor | 32 ++++++++++++++++++++ extra/assoc-deques/assoc-deques-tests.factor | 4 +++ extra/assoc-deques/assoc-deques.factor | 31 +++++++++++++++++++ extra/assoc-deques/authors.txt | 1 + 4 files changed, 68 insertions(+) create mode 100644 extra/assoc-deques/assoc-deques-docs.factor create mode 100644 extra/assoc-deques/assoc-deques-tests.factor create mode 100644 extra/assoc-deques/assoc-deques.factor create mode 100644 extra/assoc-deques/authors.txt diff --git a/extra/assoc-deques/assoc-deques-docs.factor b/extra/assoc-deques/assoc-deques-docs.factor new file mode 100644 index 0000000000..d8f305d51d --- /dev/null +++ b/extra/assoc-deques/assoc-deques-docs.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string ; +IN: assoc-deques + +HELP: +{ $description "Constructs a new " { $link assoc-deque } " from two existing data structures." } ; + +HELP: +{ $values + + { "unique-heap" assoc-deque } } +{ $description "Creates a new " { $link assoc-deque } " where the assoc is a hashtable and the deque is a max-heap." } ; + +HELP: +{ $values + + { "unique-heap" assoc-deque } } +{ $description "Creates a new " { $link assoc-deque } " where the assoc is a hashtable and the deque is a min-heap." } ; + +HELP: assoc-deque +{ $description "A data structure containing an assoc and a deque to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-deque to get a sorted data structure with O(1) lookup. Operations on assoc-deques should update both the assoc and the deque." } ; + +ARTICLE: "assoc-deques" "Associative deques" +"The " { $vocab-link "assoc-deques" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl +"Associative deque constructor:" +{ $subsection } +"Unique heaps:" +{ $subsection } +{ $subsection } ; + +ABOUT: "assoc-deques" diff --git a/extra/assoc-deques/assoc-deques-tests.factor b/extra/assoc-deques/assoc-deques-tests.factor new file mode 100644 index 0000000000..fe9d8840bc --- /dev/null +++ b/extra/assoc-deques/assoc-deques-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test assoc-deques ; +IN: assoc-deques.tests diff --git a/extra/assoc-deques/assoc-deques.factor b/extra/assoc-deques/assoc-deques.factor new file mode 100644 index 0000000000..a23e632b8b --- /dev/null +++ b/extra/assoc-deques/assoc-deques.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs deques hashtables heaps kernel ; +IN: assoc-deques + +TUPLE: assoc-deque assoc deque ; + +C: assoc-deque + +: ( -- unique-heap ) + H{ } clone ; + +: ( -- unique-heap ) + H{ } clone ; + +M: assoc-deque heap-push* ( value key assoc-deque -- entry ) + pick over assoc>> key? [ + 3drop f + ] [ + [ assoc>> swapd set-at ] [ deque>> heap-push* ] 3bi + ] if ; + +M: assoc-deque heap-pop ( assoc-deque -- value key ) + [ deque>> heap-pop ] keep + [ over ] dip assoc>> delete-at ; + +M: assoc-deque heap-peek ( assoc-deque -- value key ) + deque>> heap-peek ; + +M: assoc-deque heap-empty? ( assoc-deque -- value key ) + deque>> heap-empty? ; diff --git a/extra/assoc-deques/authors.txt b/extra/assoc-deques/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/extra/assoc-deques/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file From d5d94a6bcd9d76194a13589117472c323cc52033 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 17:52:54 -0500 Subject: [PATCH 176/244] scaffold-help deosnt need the vocab-root --- basis/tools/scaffold/scaffold-docs.factor | 3 +-- basis/tools/scaffold/scaffold.factor | 4 ++-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/basis/tools/scaffold/scaffold-docs.factor b/basis/tools/scaffold/scaffold-docs.factor index e22e10f8c9..479b636fcf 100644 --- a/basis/tools/scaffold/scaffold-docs.factor +++ b/basis/tools/scaffold/scaffold-docs.factor @@ -13,8 +13,7 @@ HELP: help. { $description "Prints out scaffold help markup for a given word." } ; HELP: scaffold-help -{ $values - { "vocab-root" "a vocabulary root string" } { "string" string } } +{ $values { "string" string } } { $description "Takes an existing vocabulary and creates a help file with scaffolded help for each word. This word only works if no help file yet exists." } ; HELP: scaffold-undocumented diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index d8d35ebf31..17eafa91c6 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -217,9 +217,9 @@ PRIVATE> : help. ( word -- ) [ (help.) ] [ nl vocabulary>> link-vocab ] bi ; -: scaffold-help ( vocab-root string -- ) +: scaffold-help ( string -- ) [ - check-vocab + [ find-vocab-root ] [ check-vocab ] bi prepare-scaffold [ "-docs.factor" scaffold-path ] dip swap [ set-scaffold-help-file ] [ 2drop ] if From 3ac95de9dcedca44c001b48406f7c56fdad2908a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 17:53:46 -0500 Subject: [PATCH 177/244] doesn't need sequences.lib anymore --- extra/html/parser/analyzer/analyzer.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index 38dd9225fe..095e3c3246 100755 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -3,7 +3,7 @@ USING: assocs html.parser kernel math sequences strings ascii arrays generalizations shuffle unicode.case namespaces make splitting http accessors io combinators http.client urls -urls.encoding fry sequences.lib ; +urls.encoding fry ; IN: html.parser.analyzer TUPLE: link attributes clickable ; From ffaab5a14e573f279f1256b47952c7c6b2776362 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 18:10:57 -0500 Subject: [PATCH 178/244] add slurp-heap-when, document heap-slurp-* --- basis/heaps/heaps-docs.factor | 18 ++++++++++++++++-- basis/heaps/heaps.factor | 6 ++++++ 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/basis/heaps/heaps-docs.factor b/basis/heaps/heaps-docs.factor index d1003ac2f8..90298c6edf 100755 --- a/basis/heaps/heaps-docs.factor +++ b/basis/heaps/heaps-docs.factor @@ -1,5 +1,5 @@ USING: heaps.private help.markup help.syntax kernel math assocs -math.order ; +math.order quotations ; IN: heaps ARTICLE: "heaps" "Heaps" @@ -28,7 +28,11 @@ $nl "Removal:" { $subsection heap-pop* } { $subsection heap-pop } -{ $subsection heap-delete } ; +{ $subsection heap-delete } +$nl +"Processing heaps:" +{ $subsection slurp-heap } +{ $subsection slurp-heap-when } ; ABOUT: "heaps" @@ -82,3 +86,13 @@ HELP: heap-delete { $description "Remove the specified entry from the heap." } { $errors "Throws an error if the entry is from another heap or if it has already been deleted." } { $side-effects "heap" } ; + +HELP: slurp-heap +{ $values + { "heap" "a heap" } { "quot" quotation } } +{ $description "Removes values from a heap and processes them with the quotation until the heap is empty." } ; + +HELP: slurp-heap-when +{ $values + { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } } +{ $description "Removes values from a heap that match the predicate quotation " { $snippet "quot1" } " and processes them with " { $snippet "quot2" } " until the predicate quotation no longer matches." } ; diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor index 6c387632ed..50aad826f5 100755 --- a/basis/heaps/heaps.factor +++ b/basis/heaps/heaps.factor @@ -195,3 +195,9 @@ M: heap heap-pop ( heap -- value key ) over heap-empty? [ 2drop ] [ [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi ] if ; inline recursive + +: slurp-heap-when ( heap quot1 quot2: ( value key -- ) -- ) + pick heap-empty? [ 3drop ] [ + [ [ heap-pop dup ] 2dip slip [ t ] compose [ 2drop f ] if ] + [ roll [ slurp-heap-when ] [ 3drop ] if ] 3bi + ] if ; inline recursive From 18760bf504eb1a773bc0194a8b41fe882d330495 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 18:13:34 -0500 Subject: [PATCH 179/244] remove using --- basis/db/queries/queries.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 17d8870990..8a4cfbc760 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel math namespaces make sequences random strings math.parser math.intervals combinators math.bitwise -nmake db db.tuples db.types db.sql classes words shuffle arrays +nmake db db.tuples db.types classes words shuffle arrays destructors continuations db.tuples.private prettyprint ; IN: db.queries From 62a8d45c0e30cda43355d5f2d04e2679b32d1666 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 18:15:41 -0500 Subject: [PATCH 180/244] add interpolate --- basis/interpolate/authors.txt | 1 + basis/interpolate/interpolate-tests.factor | 4 ++++ basis/interpolate/interpolate.factor | 21 +++++++++++++++++++++ 3 files changed, 26 insertions(+) create mode 100644 basis/interpolate/authors.txt create mode 100644 basis/interpolate/interpolate-tests.factor create mode 100644 basis/interpolate/interpolate.factor diff --git a/basis/interpolate/authors.txt b/basis/interpolate/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/interpolate/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/interpolate/interpolate-tests.factor b/basis/interpolate/interpolate-tests.factor new file mode 100644 index 0000000000..005ae87746 --- /dev/null +++ b/basis/interpolate/interpolate-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test interpolate ; +IN: interpolate.tests diff --git a/basis/interpolate/interpolate.factor b/basis/interpolate/interpolate.factor new file mode 100644 index 0000000000..27f0756f1f --- /dev/null +++ b/basis/interpolate/interpolate.factor @@ -0,0 +1,21 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io kernel macros make multiline namespaces parser +peg.ebnf present sequences strings ; +IN: interpolate + +MACRO: interpolate ( string -- ) +[EBNF +var = "${" [^}]+ "}" => [[ second >string [ get present write ] curry ]] +text = [^$]+ => [[ >string [ write ] curry ]] +interpolate = (var|text)* => [[ [ ] join ]] +EBNF] ; + +EBNF: interpolate-locals +var = "${" [^}]+ "}" => [[ [ second >string search , [ present write ] % ] [ ] make ]] +text = [^$]+ => [[ [ >string , [ write ] % ] [ ] make ]] +interpolate = (var|text)* => [[ [ ] join ]] +;EBNF + +: I[ "]I" parse-multiline-string + interpolate-locals parsed \ call parsed ; parsing From 39aec886021fcc92a099d3acfa293526dcf57ce2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 18:16:29 -0500 Subject: [PATCH 181/244] remove dead code --- basis/db/queries/queries.factor | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 8a4cfbc760..0b206cea8f 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -186,18 +186,6 @@ M: db query>statement ( query -- tuple ) ! select ID, NAME, SCORE from EXAM limit 1 offset 3 -: select-tuples* ( tuple -- statement ) - dup - [ - select 0, - dup class db-columns [ ", " 0, ] - [ dup column-name>> 0, 2, ] interleave - from 0, - class name>> 0, - ] { { } { } { } } nmake - >r >r parse-sql 4drop r> r> - maybe-make-retryable do-select ; - M: db ( query -- statement ) [ tuple>> dup class ] keep [ [ "select count(*) from " 0% 0% where-clause ] query-make ] From 723cd453a7b54f9738d4da8f69b0911b047a3449 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 18:17:31 -0500 Subject: [PATCH 182/244] initial checkin or spider --- extra/spider/authors.txt | 1 + extra/spider/spider.factor | 91 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 92 insertions(+) create mode 100644 extra/spider/authors.txt create mode 100644 extra/spider/spider.factor diff --git a/extra/spider/authors.txt b/extra/spider/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/spider/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor new file mode 100644 index 0000000000..7f68fe3a8f --- /dev/null +++ b/extra/spider/spider.factor @@ -0,0 +1,91 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors fry html.parser html.parser.analyzer +http.client kernel tools.time sets assocs sequences +concurrency.combinators io threads namespaces math multiline +heaps math.parser inspector urls assoc-deques logging +combinators.short-circuit continuations calendar prettyprint ; +IN: spider + +TUPLE: spider base count max-count sleep max-depth secure? agent timeout +filters spidered todo nonmatching initial-links ; + +TUPLE: spider-result url depth headers fetch-time parsed-html +links processing-time ; + +: ( base -- spider ) + >url + spider new + over >>base + swap 0 [ heap-push ] keep >>todo + >>nonmatching + 0 >>max-depth + 0 >>count + 1/0. >>max-count + H{ } clone >>spidered ; + +> [ '[ _ 1&& ] filter ] when* ; + +: add-todo ( links level spider -- ) + tuck [ apply-filters ] 2dip + tuck + [ spidered>> keys diff ] + [ todo>> ] 2bi* '[ _ _ heap-push ] each ; + +: add-nonmatching ( links level spider -- ) + nonmatching>> '[ _ _ heap-push ] each ; + +: relative-url? ( url -- ? ) protocol>> not ; + +: filter-base ( spider spider-result -- base-links nonmatching-links ) + [ base>> host>> ] [ links>> prune ] bi* + [ host>> = ] with partition ; + +: add-spidered ( spider spider-result -- ) + [ [ 1+ ] change-count ] dip + 2dup [ spidered>> ] [ dup url>> ] bi* rot set-at + [ filter-base ] 2keep + depth>> 1+ swap + [ add-nonmatching ] + [ add-todo ] 2bi ; + +: print-spidering ( url depth -- ) + "depth: " write number>string write + ", spidering: " write . yield ; + +: normalize-hrefs ( links -- links' ) + [ >url ] map + spider get base>> swap [ derive-url ] with map ; + +: (spider-page) ( url depth -- spider-result ) + 2dup print-spidering + f pick spider get spidered>> set-at + over '[ _ http-get ] benchmark swap + [ parse-html dup find-hrefs normalize-hrefs ] benchmark + spider-result boa + dup describe ; + +: spider-page ( url depth -- ) + (spider-page) spider get swap add-spidered ; + +\ spider-page ERROR add-error-logging + +: spider-sleep ( -- ) + spider get sleep>> [ sleep ] when* ; + +PRIVATE> + +: run-spider ( spider -- spider ) + "spider" [ + dup spider [ + [ todo>> ] [ max-depth>> ] bi + '[ + _ <= spider get + [ count>> ] [ max-count>> ] bi < and + ] [ spider-page spider-sleep ] slurp-heap-when + spider get + ] with-variable + ] with-logging ; From ebe8adfe317389010ad9433d5935b1753a6a0a89 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 19:29:18 -0500 Subject: [PATCH 183/244] spruce up the spider --- extra/spider/spider-docs.factor | 57 +++++++++++++++++++++++++++++++++ extra/spider/spider.factor | 14 +++++--- 2 files changed, 67 insertions(+), 4 deletions(-) create mode 100644 extra/spider/spider-docs.factor diff --git a/extra/spider/spider-docs.factor b/extra/spider/spider-docs.factor new file mode 100644 index 0000000000..27238e4f19 --- /dev/null +++ b/extra/spider/spider-docs.factor @@ -0,0 +1,57 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string urls +multiline ; +IN: spider + +HELP: +{ $values + { "base" "a string or url" } + { "spider" spider } } +{ $description "Creates a new web spider with a given base url." } ; + +HELP: run-spider +{ $values + { "spider" spider } + { "spider" spider } } +{ $description "Runs a spider until completion. See the " { $subsection "spider-tutorial" } " for a complete description of the tuple slots that affect how thet spider works." } ; + +HELP: spider +{ $description "" } ; + +HELP: spider-result +{ $description "" } ; + +ARTICLE: "spider-tutorial" "Spider tutorial" +"To create a new spider, call the " { $link } " word with a link to the site you wish to spider." +{ $code <" "http://concatentative.org" "> } +"The max-depth is initialized to 0, which retrieves just the initial page. Let's initialize it to something more fun:" +{ $code <" 1 >>max-depth "> } +"Now the spider will retrieve the first page and all the pages it links to in the same domain." $nl +"But suppose the front page contains thousands of links. To avoid grabbing them all, we can set " { $slot "max-count" } " to a reasonable limit." +{ $code <" 10 >>max-count "> } +"A timeout might keep the spider from hitting the server too hard:" +{ $code <" USE: calendar 1.5 seconds >>sleep "> } +"Since we happen to know that not all pages of a wiki are suitable for spidering, we will spider only the wiki view pages, not the edit or revisions pages. To do this, we add a filter through which new links are tested; links that pass the filter are added to the todo queue, while links that do not are discarded. You can add several filters to the filter array, but we'll just add a single one for now." +{ $code <" { [ path>> "/wiki/view" head? ] } >>filters "> } +"Finally, to start the spider, call the " { $link run-spider } " word." +{ $code "run-spider" } +"The full code from the tutorial." +{ $code <" USING: spider calendar sequences accessors ; +: spider-concatenative ( -- spider ) + "http://concatenative.org" + 1 >>max-depth + 10 >>max-count + 1.5 seconds >>sleep + { [ path>> "/wiki/view" head? ] } >>filters + run-spider ;"> } ; + +ARTICLE: "spider" "Spider" +"The " { $vocab-link "spider" } " vocabulary implements a simple web spider for retrieving sets of webpages." +{ $subsection "spider-tutorial" } +"Creating a new spider:" +{ $subsection } +"Running the spider:" +{ $subsection run-spider } ; + +ABOUT: "spider" diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index 7f68fe3a8f..6f5261f158 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -7,11 +7,12 @@ heaps math.parser inspector urls assoc-deques logging combinators.short-circuit continuations calendar prettyprint ; IN: spider -TUPLE: spider base count max-count sleep max-depth secure? agent timeout -filters spidered todo nonmatching initial-links ; +TUPLE: spider base count max-count sleep max-depth initial-links +filters spidered todo nonmatching ; +! secure? agent page-timeout data-timeout overall-timeout TUPLE: spider-result url depth headers fetch-time parsed-html -links processing-time ; +links processing-time timestamp ; : ( base -- spider ) >url @@ -65,7 +66,7 @@ links processing-time ; f pick spider get spidered>> set-at over '[ _ http-get ] benchmark swap [ parse-html dup find-hrefs normalize-hrefs ] benchmark - spider-result boa + now spider-result boa dup describe ; : spider-page ( url depth -- ) @@ -76,11 +77,16 @@ links processing-time ; : spider-sleep ( -- ) spider get sleep>> [ sleep ] when* ; +: queue-initial-links ( spider -- spider ) + [ initial-links>> normalize-hrefs 0 ] keep + [ add-todo ] keep ; + PRIVATE> : run-spider ( spider -- spider ) "spider" [ dup spider [ + queue-initial-links [ todo>> ] [ max-depth>> ] bi '[ _ <= spider get From 065fbc4ca3a2bd114dc7f5ec281ab8d85a9b9736 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 1 Oct 2008 17:38:12 -0700 Subject: [PATCH 184/244] printf: Fix rounding of floats and exps, default to 6 digits, update docs and tests. --- extra/printf/printf-docs.factor | 4 +- extra/printf/printf-tests.factor | 14 +++--- extra/printf/printf.factor | 80 ++++++++++++++++++-------------- 3 files changed, 54 insertions(+), 44 deletions(-) diff --git a/extra/printf/printf-docs.factor b/extra/printf/printf-docs.factor index b28b5e1c86..3ca9c07c36 100644 --- a/extra/printf/printf-docs.factor +++ b/extra/printf/printf-docs.factor @@ -18,11 +18,11 @@ HELP: printf { $example "USING: printf ;" "1.23456789 \"%.3f\" printf" - "1.234" } + "1.235" } { $example "USING: printf ;" "1234567890 \"%.5e\" printf" - "1.23456e+09" } + "1.23457e+09" } { $example "USING: printf ;" "12 \"%'#4d\" printf" diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor index 5302048dfe..2123784ea1 100644 --- a/extra/printf/printf-tests.factor +++ b/extra/printf/printf-tests.factor @@ -23,25 +23,27 @@ USING: kernel printf tools.test ; [ t ] [ "+0010" 10 "%+05d" sprintf = ] unit-test -[ t ] [ "123.456" 123.456 "%f" sprintf = ] unit-test +[ t ] [ "123.456000" 123.456 "%f" sprintf = ] unit-test + +[ t ] [ "2.44" 2.436 "%.2f" sprintf = ] unit-test [ t ] [ "123.10" 123.1 "%01.2f" sprintf = ] unit-test -[ t ] [ "1.2345" 1.23456789 "%.4f" sprintf = ] unit-test +[ t ] [ "1.2346" 1.23456789 "%.4f" sprintf = ] unit-test [ t ] [ " 1.23" 1.23456789 "%6.2f" sprintf = ] unit-test -[ t ] [ "1.234e+08" 123400000 "%e" sprintf = ] unit-test +[ t ] [ "1.234000e+08" 123400000 "%e" sprintf = ] unit-test -[ t ] [ "-1.234e+08" -123400000 "%e" sprintf = ] unit-test +[ t ] [ "-1.234000e+08" -123400000 "%e" sprintf = ] unit-test [ t ] [ "1.234567e+08" 123456700 "%e" sprintf = ] unit-test [ t ] [ "3.625e+08" 362525200 "%.3e" sprintf = ] unit-test -[ t ] [ "2.5e-03" 0.0025 "%e" sprintf = ] unit-test +[ t ] [ "2.500000e-03" 0.0025 "%e" sprintf = ] unit-test -[ t ] [ "2.5E-03" 0.0025 "%E" sprintf = ] unit-test +[ t ] [ "2.500000E-03" 0.0025 "%E" sprintf = ] unit-test [ t ] [ " 1.0E+01" 10 "%10.1E" sprintf = ] unit-test diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor index c7a7153d6a..0120891e12 100644 --- a/extra/printf/printf.factor +++ b/extra/printf/printf.factor @@ -2,8 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license USING: io io.encodings.ascii io.files io.streams.string combinators -kernel sequences splitting strings math math.parser macros -fry peg.ebnf ascii unicode.case arrays quotations vectors ; +kernel sequences splitting strings math math.functions math.parser +macros fry peg.ebnf ascii unicode.case arrays quotations vectors ; IN: printf @@ -27,42 +27,52 @@ IN: printf : >digits ( string -- digits ) [ 0 ] [ string>number ] if-empty ; -: max-digits ( string digits -- string ) +: pad-digits ( string digits -- string' ) [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." swap 3append ; -: max-width ( string length -- string ) +: max-digits ( n digits -- n' ) + 10 swap ^ [ * round ] keep / ; + +: max-width ( string length -- string' ) short head ; -: >exponential ( n -- base exp ) - [ 0 < ] keep abs 0 - [ swap dup [ 10.0 >= ] keep 1.0 < or ] - [ dup 10.0 >= - [ 10.0 / [ 1+ ] dip swap ] - [ 10.0 * [ 1- ] dip swap ] if - ] [ swap ] while - [ number>string ] dip - dup abs number>string 2 CHAR: 0 pad-left - [ 0 < "-" "+" ? ] dip append - "e" prepend - rot [ [ "-" prepend ] dip ] when ; +: >exp ( x -- exp base ) + [ + abs 0 swap + [ dup [ 10.0 >= ] [ 1.0 < ] bi or ] + [ dup 10.0 >= + [ 10.0 / [ 1+ ] dip ] + [ 10.0 * [ 1- ] dip ] if + ] [ ] while + ] keep 0 < [ neg ] when ; + +: exp>string ( exp base digits -- string ) + [ max-digits ] keep -rot + [ + [ 0 < "-" "+" ? ] + [ abs number>string 2 CHAR: 0 pad-left ] bi + "e" -rot 3append + ] + [ number>string ] bi* + rot pad-digits prepend ; EBNF: parse-format-string zero = "0" => [[ CHAR: 0 ]] char = "'" (.) => [[ second ]] -pad-char = (zero|char)? => [[ CHAR: \s or 1quotation ]] -pad-align = ("-")? => [[ [ pad-right ] [ pad-left ] ? ]] -pad-width = ([0-9])* => [[ >digits 1quotation ]] -pad = pad-align pad-char pad-width => [[ reverse compose-all [ first ] keep swap 0 = [ drop [ ] ] when ]] +pad-char = (zero|char)? => [[ CHAR: \s or ]] +pad-align = ("-")? => [[ \ pad-right \ pad-left ? ]] +pad-width = ([0-9])* => [[ >digits ]] +pad = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]] -sign = ("+")? => [[ [ dup CHAR: - swap index not [ "+" prepend ] when ] [ ] ? ]] +sign = ("+")? => [[ [ dup CHAR: - swap index [ "+" prepend ] unless ] [ ] ? ]] width_ = "." ([0-9])* => [[ second >digits '[ _ max-width ] ]] width = (width_)? => [[ [ ] or ]] -digits_ = "." ([0-9])* => [[ second >digits '[ _ max-digits ] ]] -digits = (digits_)? => [[ [ ] or ]] +digits_ = "." ([0-9])* => [[ second >digits ]] +digits = (digits_)? => [[ 6 or ]] fmt-% = "%" => [[ [ "%" ] ]] fmt-c = "c" => [[ [ 1string ] ]] @@ -70,26 +80,24 @@ fmt-C = "C" => [[ [ 1string >upper ] ]] fmt-s = "s" => [[ [ ] ]] fmt-S = "S" => [[ [ >upper ] ]] fmt-d = "d" => [[ [ >fixnum number>string ] ]] -fmt-e = "e" => [[ [ >exponential ] ]] -fmt-E = "E" => [[ [ >exponential >upper ] ]] -fmt-f = "f" => [[ [ >float number>string ] ]] +fmt-e = digits "e" => [[ first '[ >exp _ exp>string ] ]] +fmt-E = digits "E" => [[ first '[ >exp _ exp>string >upper ] ]] +fmt-f = digits "f" => [[ first dup '[ >float _ max-digits number>string _ pad-digits ] ]] fmt-x = "x" => [[ [ >hex ] ]] fmt-X = "X" => [[ [ >hex >upper ] ]] unknown = (.)* => [[ "Unknown directive" throw ]] -chars = fmt-c | fmt-C -strings = pad width (fmt-s|fmt-S) => [[ reverse compose-all ]] -decimals = fmt-d -exps = digits (fmt-e|fmt-E) => [[ reverse [ swap ] join [ swap append ] append ]] -floats = digits fmt-f => [[ reverse compose-all ]] -hex = fmt-x | fmt-X -numbers = sign pad (decimals|floats|hex|exps) => [[ reverse first3 swap 3append [ fix-sign ] append ]] +strings_ = fmt-c|fmt-C|fmt-s|fmt-S +strings = pad width strings_ => [[ reverse compose-all ]] -formats = "%" (chars|strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]] +numbers_ = fmt-d|fmt-e|fmt-E|fmt-f|fmt-x|fmt-X +numbers = sign pad numbers_ => [[ unclip-last prefix compose-all [ fix-sign ] append ]] -plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]] +formats = "%" (strings|numbers|fmt-%|unknown) => [[ second '[ _ dip ] ]] -text = (formats|plain-text)* => [[ reverse [ [ dup [ push ] dip ] append ] map ]] +plain-text = (!("%").)+ => [[ >string '[ _ swap ] ]] + +text = (formats|plain-text)* => [[ reverse [ [ [ push ] keep ] append ] map ]] ;EBNF From 0b57ce6c52c4578cc3de95a5d1900e544e9f4a6e Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 1 Oct 2008 17:46:09 -0700 Subject: [PATCH 185/244] Remove switch from sequences-lib (exists as exchange). --- extra/sequences/lib/lib-docs.factor | 11 ----------- extra/sequences/lib/lib.factor | 5 ----- 2 files changed, 16 deletions(-) diff --git a/extra/sequences/lib/lib-docs.factor b/extra/sequences/lib/lib-docs.factor index c155bb47ec..e279230b1b 100755 --- a/extra/sequences/lib/lib-docs.factor +++ b/extra/sequences/lib/lib-docs.factor @@ -27,14 +27,3 @@ HELP: enumerate { $values { "seq" sequence } { "seq'" sequence } } { $description "Returns a new sequence where each element is an array of { index, value }" } ; -HELP: switch -{ $values { "x" number } { "y" number } { "seq" sequence } } -{ $description "Swaps the values between indices 'x' and 'y' in the sequence." } -{ $examples - { $example - "USING: sequences.lib ;" - "1 2 \"asdf\" [ switch ] keep" - "\"adsf\"" } -} ; - - diff --git a/extra/sequences/lib/lib.factor b/extra/sequences/lib/lib.factor index c23457a332..fe9d9bb587 100755 --- a/extra/sequences/lib/lib.factor +++ b/extra/sequences/lib/lib.factor @@ -173,8 +173,3 @@ USE: random : enumerate ( seq -- seq' ) >alist ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: switch ( x y seq -- ) - 3dup swap [ nth ] dip [ [ move ] keep ] 2dip rot set-nth ; - From ded8ae641e9b4d968fcabf057cebfda2e888d5e7 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Thu, 2 Oct 2008 11:12:46 +1000 Subject: [PATCH 186/244] Fixed tetris and moved it from unmaintained to extra --- {unmaintained => extra}/tetris/README.txt | 1 + {unmaintained => extra}/tetris/authors.txt | 0 .../tetris/board/authors.txt | 0 extra/tetris/board/board-tests.factor | 23 ++++ .../tetris/board/board.factor | 33 +++-- {unmaintained => extra}/tetris/deploy.factor | 0 .../tetris/game/authors.txt | 0 extra/tetris/game/game-tests.factor | 16 +++ extra/tetris/game/game.factor | 114 ++++++++++++++++++ {unmaintained => extra}/tetris/gl/authors.txt | 0 {unmaintained => extra}/tetris/gl/gl.factor | 29 ++--- .../tetris/piece/authors.txt | 0 extra/tetris/piece/piece-tests.factor | 23 ++++ extra/tetris/piece/piece.factor | 50 ++++++++ {unmaintained => extra}/tetris/summary.txt | 0 {unmaintained => extra}/tetris/tags.txt | 0 extra/tetris/tetris.factor | 56 +++++++++ .../tetris/tetromino/authors.txt | 0 .../tetris/tetromino/tetromino.factor | 2 +- unmaintained/tetris/board/board-tests.factor | 24 ---- unmaintained/tetris/game/game-tests.factor | 16 --- unmaintained/tetris/game/game.factor | 113 ----------------- unmaintained/tetris/piece/piece-tests.factor | 23 ---- unmaintained/tetris/piece/piece.factor | 47 -------- unmaintained/tetris/tetris.factor | 61 ---------- 25 files changed, 315 insertions(+), 316 deletions(-) rename {unmaintained => extra}/tetris/README.txt (91%) rename {unmaintained => extra}/tetris/authors.txt (100%) rename {unmaintained => extra}/tetris/board/authors.txt (100%) create mode 100644 extra/tetris/board/board-tests.factor rename {unmaintained => extra}/tetris/board/board.factor (51%) rename {unmaintained => extra}/tetris/deploy.factor (100%) rename {unmaintained => extra}/tetris/game/authors.txt (100%) create mode 100644 extra/tetris/game/game-tests.factor create mode 100644 extra/tetris/game/game.factor rename {unmaintained => extra}/tetris/gl/authors.txt (100%) rename {unmaintained => extra}/tetris/gl/gl.factor (51%) rename {unmaintained => extra}/tetris/piece/authors.txt (100%) create mode 100644 extra/tetris/piece/piece-tests.factor create mode 100644 extra/tetris/piece/piece.factor rename {unmaintained => extra}/tetris/summary.txt (100%) rename {unmaintained => extra}/tetris/tags.txt (100%) create mode 100644 extra/tetris/tetris.factor rename {unmaintained => extra}/tetris/tetromino/authors.txt (100%) rename {unmaintained => extra}/tetris/tetromino/tetromino.factor (97%) delete mode 100644 unmaintained/tetris/board/board-tests.factor delete mode 100644 unmaintained/tetris/game/game-tests.factor delete mode 100644 unmaintained/tetris/game/game.factor delete mode 100644 unmaintained/tetris/piece/piece-tests.factor delete mode 100644 unmaintained/tetris/piece/piece.factor delete mode 100644 unmaintained/tetris/tetris.factor diff --git a/unmaintained/tetris/README.txt b/extra/tetris/README.txt similarity index 91% rename from unmaintained/tetris/README.txt rename to extra/tetris/README.txt index bd34dc3c16..e8f81fc831 100644 --- a/unmaintained/tetris/README.txt +++ b/extra/tetris/README.txt @@ -14,3 +14,4 @@ n: start a new game TODO: - rotation of pieces when they're on the far right of the board - make blocks prettier +- possibly make piece inherit from tetromino diff --git a/unmaintained/tetris/authors.txt b/extra/tetris/authors.txt similarity index 100% rename from unmaintained/tetris/authors.txt rename to extra/tetris/authors.txt diff --git a/unmaintained/tetris/board/authors.txt b/extra/tetris/board/authors.txt similarity index 100% rename from unmaintained/tetris/board/authors.txt rename to extra/tetris/board/authors.txt diff --git a/extra/tetris/board/board-tests.factor b/extra/tetris/board/board-tests.factor new file mode 100644 index 0000000000..518b5544e9 --- /dev/null +++ b/extra/tetris/board/board-tests.factor @@ -0,0 +1,23 @@ +USING: accessors arrays colors kernel tetris.board tetris.piece tools.test ; + +[ { { f f } { f f } { f f } } ] [ 2 3 make-rows ] unit-test +[ { { f f } { f f } { f f } } ] [ 2 3 rows>> ] unit-test +[ 1 { f f } ] [ 2 3 { 1 1 } board@block ] unit-test +[ f ] [ 2 3 { 1 1 } block ] unit-test +[ 2 3 { 2 3 } block ] must-fail +red 1array [ 2 3 dup { 1 1 } red set-block { 1 1 } block ] unit-test +[ t ] [ 2 3 { 1 1 } block-free? ] unit-test +[ f ] [ 2 3 dup { 1 1 } red set-block { 1 1 } block-free? ] unit-test +[ t ] [ 2 3 dup { 1 1 } red set-block { 1 2 } block-free? ] unit-test +[ t ] [ 2 3 dup { 1 1 } red set-block { 0 1 } block-free? ] unit-test +[ t ] [ 2 3 { 0 0 } block-in-bounds? ] unit-test +[ f ] [ 2 3 { -1 0 } block-in-bounds? ] unit-test +[ t ] [ 2 3 { 1 2 } block-in-bounds? ] unit-test +[ f ] [ 2 3 { 2 2 } block-in-bounds? ] unit-test +[ t ] [ 2 3 { 1 1 } location-valid? ] unit-test +[ f ] [ 2 3 dup { 1 1 } red set-block { 1 1 } location-valid? ] unit-test +[ t ] [ 10 10 10 piece-valid? ] unit-test +[ f ] [ 2 3 10 { 1 2 } >>location piece-valid? ] unit-test +[ { { f } { f } } ] [ 1 1 add-row rows>> ] unit-test +[ { { f } } ] [ 1 2 dup { 0 1 } red set-block remove-full-rows rows>> ] unit-test +[ { { f } { f } } ] [ 1 2 dup { 0 1 } red set-block dup check-rows drop rows>> ] unit-test diff --git a/unmaintained/tetris/board/board.factor b/extra/tetris/board/board.factor similarity index 51% rename from unmaintained/tetris/board/board.factor rename to extra/tetris/board/board.factor index 3e4548078c..1f12dcabe6 100644 --- a/unmaintained/tetris/board/board.factor +++ b/extra/tetris/board/board.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2006, 2007 Alex Chapman +! Copyright (C) 2006, 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences arrays tetris.piece math ; +USING: accessors arrays kernel math sequences tetris.piece ; IN: tetris.board -TUPLE: board width height rows ; +TUPLE: board { width integer } { height integer } rows ; : make-rows ( width height -- rows ) [ drop f ] with map ; @@ -15,17 +15,17 @@ TUPLE: board width height rows ; #! the tetris board, and { 9 19 } is the bottom right on a 10x20 board. : board@block ( board block -- n row ) - [ second swap board-rows nth ] keep first swap ; + [ second swap rows>> nth ] keep first swap ; -: board-set-block ( board block colour -- ) -rot board@block set-nth ; +: set-block ( board block colour -- ) -rot board@block set-nth ; -: board-block ( board block -- colour ) board@block nth ; +: block ( board block -- colour ) board@block nth ; -: block-free? ( board block -- ? ) board-block not ; +: block-free? ( board block -- ? ) block not ; : block-in-bounds? ( board block -- ? ) - [ first swap board-width bounds-check? ] 2keep - second swap board-height bounds-check? and ; + [ first swap width>> bounds-check? ] 2keep + second swap height>> bounds-check? and ; : location-valid? ( board block -- ? ) 2dup block-in-bounds? [ block-free? ] [ 2drop f ] if ; @@ -35,22 +35,21 @@ TUPLE: board width height rows ; : row-not-full? ( row -- ? ) f swap member? ; -: add-row ( board -- ) - dup board-rows over board-width f - prefix swap set-board-rows ; +: add-row ( board -- board ) + dup rows>> over width>> f prefix >>rows ; : top-up-rows ( board -- ) - dup board-height over board-rows length = [ + dup height>> over rows>> length = [ drop ] [ - dup add-row top-up-rows + add-row top-up-rows ] if ; -: remove-full-rows ( board -- ) - dup board-rows [ row-not-full? ] filter swap set-board-rows ; +: remove-full-rows ( board -- board ) + [ [ row-not-full? ] filter ] change-rows ; : check-rows ( board -- n ) #! remove full rows, then add blank ones at the top, returning the number #! of rows removed (and added) - dup remove-full-rows dup board-height over board-rows length - >r top-up-rows r> ; + remove-full-rows dup height>> over rows>> length - swap top-up-rows ; diff --git a/unmaintained/tetris/deploy.factor b/extra/tetris/deploy.factor similarity index 100% rename from unmaintained/tetris/deploy.factor rename to extra/tetris/deploy.factor diff --git a/unmaintained/tetris/game/authors.txt b/extra/tetris/game/authors.txt similarity index 100% rename from unmaintained/tetris/game/authors.txt rename to extra/tetris/game/authors.txt diff --git a/extra/tetris/game/game-tests.factor b/extra/tetris/game/game-tests.factor new file mode 100644 index 0000000000..047c20d053 --- /dev/null +++ b/extra/tetris/game/game-tests.factor @@ -0,0 +1,16 @@ +USING: accessors kernel tetris.game tetris.board tetris.piece tools.test +sequences ; + +[ t ] [ [ current-piece ] [ next-piece ] bi and t f ? ] unit-test +[ t ] [ { 1 1 } can-move? ] unit-test +[ t ] [ { 1 1 } tetris-move ] unit-test +[ 1 ] [ dup { 1 1 } tetris-move drop current-piece location>> second ] unit-test +[ 1 ] [ level>> ] unit-test +[ 1 ] [ 9 >>rows level>> ] unit-test +[ 2 ] [ 10 >>rows level>> ] unit-test +[ 0 ] [ 3 0 rows-score ] unit-test +[ 80 ] [ 1 1 rows-score ] unit-test +[ 4800 ] [ 3 4 rows-score ] unit-test +[ 1 ] [ dup 3 score-rows dup 3 score-rows dup 3 score-rows level>> ] unit-test +[ 2 ] [ dup 4 score-rows dup 4 score-rows dup 2 score-rows level>> ] unit-test + diff --git a/extra/tetris/game/game.factor b/extra/tetris/game/game.factor new file mode 100644 index 0000000000..30622c9e38 --- /dev/null +++ b/extra/tetris/game/game.factor @@ -0,0 +1,114 @@ +! Copyright (C) 2006, 2007, 2008 Alex Chapman +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators kernel lists math math.functions sequences system tetris.board tetris.piece tetris.tetromino ; +IN: tetris.game + +TUPLE: tetris + { board board } + { pieces } + { last-update integer initial: 0 } + { rows integer initial: 0 } + { score integer initial: 0 } + { paused? initial: f } + { running? initial: t } ; + +: default-width 10 ; inline +: default-height 20 ; inline + +: ( width height -- tetris ) + dupd swap + tetris new swap >>pieces swap >>board ; + +: ( -- tetris ) default-width default-height ; + +: ( old -- new ) + board>> [ width>> ] [ height>> ] bi ; + +: current-piece ( tetris -- piece ) pieces>> car ; + +: next-piece ( tetris -- piece ) pieces>> cdr car ; + +: toggle-pause ( tetris -- ) + [ not ] change-paused? drop ; + +: level>> ( tetris -- level ) + rows>> 1+ 10 / ceiling ; + +: update-interval ( tetris -- interval ) + level>> 1- 60 * 1000 swap - ; + +: add-block ( tetris block -- ) + over board>> spin current-piece tetromino>> colour>> set-block ; + +: game-over? ( tetris -- ? ) + [ board>> ] [ next-piece ] bi piece-valid? not ; + +: new-current-piece ( tetris -- tetris ) + dup game-over? [ + f >>running? + ] [ + [ cdr ] change-pieces + ] if ; + +: rows-score ( level n -- score ) + { + { 0 [ 0 ] } + { 1 [ 40 ] } + { 2 [ 100 ] } + { 3 [ 300 ] } + { 4 [ 1200 ] } + } case swap 1+ * ; + +: add-score ( tetris n-rows -- tetris ) + over level>> swap rows-score swap [ + ] change-score ; + +: add-rows ( tetris rows -- tetris ) + swap [ + ] change-rows ; + +: score-rows ( tetris n -- ) + [ add-score ] keep add-rows drop ; + +: lock-piece ( tetris -- ) + [ dup current-piece piece-blocks [ add-block ] with each ] keep + new-current-piece dup board>> check-rows score-rows ; + +: can-rotate? ( tetris -- ? ) + [ board>> ] [ current-piece clone 1 rotate-piece ] bi piece-valid? ; + +: (rotate) ( inc tetris -- ) + dup can-rotate? [ current-piece swap rotate-piece drop ] [ 2drop ] if ; + +: rotate-left ( tetris -- ) -1 swap (rotate) ; + +: rotate-right ( tetris -- ) 1 swap (rotate) ; + +: can-move? ( tetris move -- ? ) + [ drop board>> ] [ [ current-piece clone ] dip move-piece ] 2bi piece-valid? ; + +: tetris-move ( tetris move -- ? ) + #! moves the piece if possible, returns whether the piece was moved + 2dup can-move? [ + >r current-piece r> move-piece drop t + ] [ + 2drop f + ] if ; + +: move-left ( tetris -- ) { -1 0 } tetris-move drop ; + +: move-right ( tetris -- ) { 1 0 } tetris-move drop ; + +: move-down ( tetris -- ) + dup { 0 1 } tetris-move [ drop ] [ lock-piece ] if ; + +: move-drop ( tetris -- ) + dup { 0 1 } tetris-move [ move-drop ] [ lock-piece ] if ; + +: update ( tetris -- ) + millis over last-update>> - + over update-interval > [ + dup move-down + millis >>last-update + ] when drop ; + +: ?update ( tetris -- ) + dup [ paused?>> ] [ running?>> not ] bi or [ drop ] [ update ] if ; diff --git a/unmaintained/tetris/gl/authors.txt b/extra/tetris/gl/authors.txt similarity index 100% rename from unmaintained/tetris/gl/authors.txt rename to extra/tetris/gl/authors.txt diff --git a/unmaintained/tetris/gl/gl.factor b/extra/tetris/gl/gl.factor similarity index 51% rename from unmaintained/tetris/gl/gl.factor rename to extra/tetris/gl/gl.factor index e425c4766f..d47f027293 100644 --- a/unmaintained/tetris/gl/gl.factor +++ b/extra/tetris/gl/gl.factor @@ -1,8 +1,6 @@ -! Copyright (C) 2006, 2007 Alex Chapman +! Copyright (C) 2006, 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences arrays math math.vectors namespaces -opengl opengl.gl ui.render ui.gadgets tetris.game tetris.board -tetris.piece tetris.tetromino ; +USING: accessors arrays combinators kernel math math.vectors namespaces opengl opengl.gl sequences tetris.board tetris.game tetris.piece ui.render tetris.tetromino ui.gadgets ; IN: tetris.gl #! OpenGL rendering for tetris @@ -14,33 +12,36 @@ IN: tetris.gl piece-blocks [ draw-block ] each ; : draw-piece ( piece -- ) - dup tetromino-colour gl-color draw-piece-blocks ; + dup tetromino>> colour>> set-color draw-piece-blocks ; : draw-next-piece ( piece -- ) - dup tetromino-colour clone 0.2 3 pick set-nth gl-color draw-piece-blocks ; + dup tetromino>> colour>> + clone 0.2 >>alpha set-color draw-piece-blocks ; ! TODO: move implementation specific stuff into tetris-board : (draw-row) ( x y row -- ) >r over r> nth dup - [ gl-color 2array draw-block ] [ 3drop ] if ; + [ set-color 2array draw-block ] [ 3drop ] if ; : draw-row ( y row -- ) dup length -rot [ (draw-row) ] 2curry each ; : draw-board ( board -- ) - board-rows dup length swap + rows>> dup length swap [ dupd nth draw-row ] curry each ; -: scale-tetris ( width height tetris -- ) - [ board-width swap ] keep board-height / -rot / swap 1 glScalef ; +: scale-board ( width height board -- ) + [ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ; : (draw-tetris) ( width height tetris -- ) #! width and height are in pixels GL_MODELVIEW [ - [ scale-tetris ] keep - dup tetris-board draw-board - dup tetris-next-piece draw-next-piece - tetris-current-piece draw-piece + { + [ board>> scale-board ] + [ board>> draw-board ] + [ next-piece draw-next-piece ] + [ current-piece draw-piece ] + } cleave ] do-matrix ; : draw-tetris ( width height tetris -- ) diff --git a/unmaintained/tetris/piece/authors.txt b/extra/tetris/piece/authors.txt similarity index 100% rename from unmaintained/tetris/piece/authors.txt rename to extra/tetris/piece/authors.txt diff --git a/extra/tetris/piece/piece-tests.factor b/extra/tetris/piece/piece-tests.factor new file mode 100644 index 0000000000..05e4faa68f --- /dev/null +++ b/extra/tetris/piece/piece-tests.factor @@ -0,0 +1,23 @@ +USING: accessors kernel tetris.tetromino tetris.piece tools.test sequences arrays namespaces ; + +! Tests for tetris.tetromino and tetris.piece, since there's not much to test in tetris.tetromino + +! these two tests rely on the first rotation of the first tetromino being the +! 'I' tetromino in its vertical orientation. +[ 4 ] [ tetrominoes get first states>> first blocks-width ] unit-test +[ 1 ] [ tetrominoes get first states>> first blocks-height ] unit-test + +[ { 0 0 } ] [ random-tetromino location>> ] unit-test +[ 0 ] [ 10 rotation>> ] unit-test + +[ { { 0 0 } { 1 0 } { 2 0 } { 3 0 } } ] +[ tetrominoes get first piece-blocks ] unit-test + +[ { { 0 0 } { 0 1 } { 0 2 } { 0 3 } } ] +[ tetrominoes get first 1 rotate-piece piece-blocks ] unit-test + +[ { { 1 1 } { 2 1 } { 3 1 } { 4 1 } } ] +[ tetrominoes get first { 1 1 } move-piece piece-blocks ] unit-test + +[ 3 ] [ tetrominoes get second piece-width ] unit-test +[ 2 ] [ tetrominoes get second 1 rotate-piece piece-width ] unit-test diff --git a/extra/tetris/piece/piece.factor b/extra/tetris/piece/piece.factor new file mode 100644 index 0000000000..2ebbfc07d6 --- /dev/null +++ b/extra/tetris/piece/piece.factor @@ -0,0 +1,50 @@ +! Copyright (C) 2006, 2007, 2008 Alex Chapman +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays kernel math math.vectors sequences tetris.tetromino lists.lazy ; +IN: tetris.piece + +#! The rotation is an index into the tetromino's states array, and the +#! position is added to the tetromino's blocks to give them their location on the +#! tetris board. If the location is f then the piece is not yet on the board. + +TUPLE: piece + { tetromino tetromino } + { rotation integer initial: 0 } + { location array initial: { 0 0 } } ; + +: ( tetromino -- piece ) + piece new swap >>tetromino ; + +: (piece-blocks) ( piece -- blocks ) + #! rotates the piece + [ rotation>> ] [ tetromino>> states>> ] bi nth ; + +: piece-blocks ( piece -- blocks ) + #! rotates and positions the piece + [ (piece-blocks) ] [ location>> ] bi [ v+ ] curry map ; + +: piece-width ( piece -- width ) + piece-blocks blocks-width ; + +: set-start-location ( piece board-width -- piece ) + over piece-width [ 2 /i ] bi@ - 0 2array >>location ; + +: ( board-width -- piece ) + random-tetromino swap set-start-location ; + +: ( board-width -- llist ) + [ [ ] curry ] keep [ ] curry lazy-cons ; + +: modulo ( n m -- n ) + #! -2 7 mod => -2, -2 7 modulo => 5 + tuck mod over + swap mod ; + +: (rotate-piece) ( rotation inc n-states -- rotation' ) + [ + ] dip modulo ; + +: rotate-piece ( piece inc -- piece ) + over tetromino>> states>> length + [ (rotate-piece) ] 2curry change-rotation ; + +: move-piece ( piece move -- piece ) + [ v+ ] curry change-location ; diff --git a/unmaintained/tetris/summary.txt b/extra/tetris/summary.txt similarity index 100% rename from unmaintained/tetris/summary.txt rename to extra/tetris/summary.txt diff --git a/unmaintained/tetris/tags.txt b/extra/tetris/tags.txt similarity index 100% rename from unmaintained/tetris/tags.txt rename to extra/tetris/tags.txt diff --git a/extra/tetris/tetris.factor b/extra/tetris/tetris.factor new file mode 100644 index 0000000000..b200c4d735 --- /dev/null +++ b/extra/tetris/tetris.factor @@ -0,0 +1,56 @@ +! Copyright (C) 2006, 2007, 2008 Alex Chapman +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alarms arrays calendar kernel make math math.geometry.rect math.parser namespaces sequences system tetris.game tetris.gl ui.gadgets ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui ; +IN: tetris + +TUPLE: tetris-gadget < gadget { tetris tetris } { alarm } ; + +: ( tetris -- gadget ) + tetris-gadget new-gadget swap >>tetris ; + +M: tetris-gadget pref-dim* drop { 200 400 } ; + +: update-status ( gadget -- ) + dup tetris>> [ + "Level: " % dup level>> # + " Score: " % score>> # + ] "" make swap show-status ; + +M: tetris-gadget draw-gadget* ( gadget -- ) + [ + dup rect-dim [ first ] [ second ] bi rot tetris>> draw-tetris + ] keep update-status ; + +: new-tetris ( gadget -- gadget ) + [ ] change-tetris ; + +tetris-gadget H{ + { T{ key-down f f "UP" } [ tetris>> rotate-right ] } + { T{ key-down f f "d" } [ tetris>> rotate-left ] } + { T{ key-down f f "f" } [ tetris>> rotate-right ] } + { T{ key-down f f "e" } [ tetris>> rotate-left ] } ! dvorak d + { T{ key-down f f "u" } [ tetris>> rotate-right ] } ! dvorak f + { T{ key-down f f "LEFT" } [ tetris>> move-left ] } + { T{ key-down f f "RIGHT" } [ tetris>> move-right ] } + { T{ key-down f f "DOWN" } [ tetris>> move-down ] } + { T{ key-down f f " " } [ tetris>> move-drop ] } + { T{ key-down f f "p" } [ tetris>> toggle-pause ] } + { T{ key-down f f "n" } [ new-tetris drop ] } +} set-gestures + +: tick ( gadget -- ) + [ tetris>> ?update ] [ relayout-1 ] bi ; + +M: tetris-gadget graft* ( gadget -- ) + [ [ tick ] curry 100 milliseconds every ] keep (>>alarm) ; + +M: tetris-gadget ungraft* ( gadget -- ) + [ cancel-alarm f ] change-alarm drop ; + +: tetris-window ( -- ) + [ + + "Tetris" open-status-window + ] with-ui ; + +MAIN: tetris-window diff --git a/unmaintained/tetris/tetromino/authors.txt b/extra/tetris/tetromino/authors.txt similarity index 100% rename from unmaintained/tetris/tetromino/authors.txt rename to extra/tetris/tetromino/authors.txt diff --git a/unmaintained/tetris/tetromino/tetromino.factor b/extra/tetris/tetromino/tetromino.factor similarity index 97% rename from unmaintained/tetris/tetromino/tetromino.factor rename to extra/tetris/tetromino/tetromino.factor index 957f808aae..7e6b2ecf34 100644 --- a/unmaintained/tetris/tetromino/tetromino.factor +++ b/extra/tetris/tetromino/tetromino.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2007 Alex Chapman +! Copyright (C) 2006, 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. USING: kernel arrays namespaces sequences math math.vectors colors random ; diff --git a/unmaintained/tetris/board/board-tests.factor b/unmaintained/tetris/board/board-tests.factor deleted file mode 100644 index bd8789c4d6..0000000000 --- a/unmaintained/tetris/board/board-tests.factor +++ /dev/null @@ -1,24 +0,0 @@ -USING: kernel tetris.board tetris.piece tools.test arrays -colors ; - -[ { { f f } { f f } { f f } } ] [ 2 3 make-rows ] unit-test -[ { { f f } { f f } { f f } } ] [ 2 3 board-rows ] unit-test -[ 1 { f f } ] [ 2 3 { 1 1 } board@block ] unit-test -[ f ] [ 2 3 { 1 1 } board-block ] unit-test -[ 2 3 { 2 3 } board-block ] must-fail -red 1array [ 2 3 dup { 1 1 } red board-set-block { 1 1 } board-block ] unit-test -[ t ] [ 2 3 { 1 1 } block-free? ] unit-test -[ f ] [ 2 3 dup { 1 1 } red board-set-block { 1 1 } block-free? ] unit-test -[ t ] [ 2 3 dup { 1 1 } red board-set-block { 1 2 } block-free? ] unit-test -[ t ] [ 2 3 dup { 1 1 } red board-set-block { 0 1 } block-free? ] unit-test -[ t ] [ 2 3 { 0 0 } block-in-bounds? ] unit-test -[ f ] [ 2 3 { -1 0 } block-in-bounds? ] unit-test -[ t ] [ 2 3 { 1 2 } block-in-bounds? ] unit-test -[ f ] [ 2 3 { 2 2 } block-in-bounds? ] unit-test -[ t ] [ 2 3 { 1 1 } location-valid? ] unit-test -[ f ] [ 2 3 dup { 1 1 } red board-set-block { 1 1 } location-valid? ] unit-test -[ t ] [ 10 10 10 piece-valid? ] unit-test -[ f ] [ 2 3 10 { 1 2 } over set-piece-location piece-valid? ] unit-test -[ { { f } { f } } ] [ 1 1 dup add-row board-rows ] unit-test -[ { { f } } ] [ 1 2 dup { 0 1 } red board-set-block dup remove-full-rows board-rows ] unit-test -[ { { f } { f } } ] [ 1 2 dup { 0 1 } red board-set-block dup check-rows drop board-rows ] unit-test diff --git a/unmaintained/tetris/game/game-tests.factor b/unmaintained/tetris/game/game-tests.factor deleted file mode 100644 index e5af54803d..0000000000 --- a/unmaintained/tetris/game/game-tests.factor +++ /dev/null @@ -1,16 +0,0 @@ -USING: kernel tetris.game tetris.board tetris.piece tools.test -sequences ; - -[ t ] [ dup tetris-current-piece swap tetris-next-piece and t f ? ] unit-test -[ t ] [ { 1 1 } can-move? ] unit-test -[ t ] [ { 1 1 } tetris-move ] unit-test -[ 1 ] [ dup { 1 1 } tetris-move drop tetris-current-piece piece-location second ] unit-test -[ 1 ] [ tetris-level ] unit-test -[ 1 ] [ 9 over set-tetris-rows tetris-level ] unit-test -[ 2 ] [ 10 over set-tetris-rows tetris-level ] unit-test -[ 0 ] [ 3 0 rows-score ] unit-test -[ 80 ] [ 1 1 rows-score ] unit-test -[ 4800 ] [ 3 4 rows-score ] unit-test -[ 1 ] [ dup 3 score-rows dup 3 score-rows dup 3 score-rows tetris-level ] unit-test -[ 2 ] [ dup 4 score-rows dup 4 score-rows dup 2 score-rows tetris-level ] unit-test - diff --git a/unmaintained/tetris/game/game.factor b/unmaintained/tetris/game/game.factor deleted file mode 100644 index 90df619ff7..0000000000 --- a/unmaintained/tetris/game/game.factor +++ /dev/null @@ -1,113 +0,0 @@ -! Copyright (C) 2006, 2007 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: kernel sequences math math.functions tetris.board -tetris.piece tetris.tetromino lists combinators system ; -IN: tetris.game - -TUPLE: tetris pieces last-update update-interval rows score game-state paused? running? ; - -: default-width 10 ; inline -: default-height 20 ; inline - -: ( width height -- tetris ) - tetris construct-delegate - dup board-width over set-tetris-pieces - 0 over set-tetris-last-update - 0 over set-tetris-rows - 0 over set-tetris-score - f over set-tetris-paused? - t over set-tetris-running? ; - -: ( -- tetris ) default-width default-height ; - -: ( old -- new ) - [ board-width ] keep board-height ; - -: tetris-board ( tetris -- board ) delegate ; - -: tetris-current-piece ( tetris -- piece ) tetris-pieces car ; - -: tetris-next-piece ( tetris -- piece ) tetris-pieces cdr car ; - -: toggle-pause ( tetris -- ) - dup tetris-paused? not swap set-tetris-paused? ; - -: tetris-level ( tetris -- level ) - tetris-rows 1+ 10 / ceiling ; - -: tetris-update-interval ( tetris -- interval ) - tetris-level 1- 60 * 1000 swap - ; - -: add-block ( tetris block -- ) - over tetris-current-piece tetromino-colour board-set-block ; - -: game-over? ( tetris -- ? ) - dup tetris-next-piece piece-valid? not ; - -: new-current-piece ( tetris -- ) - dup game-over? [ - f swap set-tetris-running? - ] [ - dup tetris-pieces cdr swap set-tetris-pieces - ] if ; - -: rows-score ( level n -- score ) - { - { 0 [ 0 ] } - { 1 [ 40 ] } - { 2 [ 100 ] } - { 3 [ 300 ] } - { 4 [ 1200 ] } - } case swap 1+ * ; - -: add-score ( tetris score -- ) - over tetris-score + swap set-tetris-score ; - -: score-rows ( tetris n -- ) - 2dup >r dup tetris-level r> rows-score add-score - over tetris-rows + swap set-tetris-rows ; - -: lock-piece ( tetris -- ) - [ dup tetris-current-piece piece-blocks [ add-block ] with each ] keep - dup new-current-piece dup check-rows score-rows ; - -: can-rotate? ( tetris -- ? ) - dup tetris-current-piece clone dup 1 rotate-piece piece-valid? ; - -: (rotate) ( inc tetris -- ) - dup can-rotate? [ tetris-current-piece swap rotate-piece ] [ 2drop ] if ; - -: rotate-left ( tetris -- ) -1 swap (rotate) ; - -: rotate-right ( tetris -- ) 1 swap (rotate) ; - -: can-move? ( tetris move -- ? ) - >r dup tetris-current-piece clone dup r> move-piece piece-valid? ; - -: tetris-move ( tetris move -- ? ) - #! moves the piece if possible, returns whether the piece was moved - 2dup can-move? [ - >r tetris-current-piece r> move-piece t - ] [ - 2drop f - ] if ; - -: move-left ( tetris -- ) { -1 0 } tetris-move drop ; - -: move-right ( tetris -- ) { 1 0 } tetris-move drop ; - -: move-down ( tetris -- ) - dup { 0 1 } tetris-move [ drop ] [ lock-piece ] if ; - -: move-drop ( tetris -- ) - dup { 0 1 } tetris-move [ move-drop ] [ lock-piece ] if ; - -: update ( tetris -- ) - millis over tetris-last-update - - over tetris-update-interval > [ - dup move-down - millis swap set-tetris-last-update - ] [ drop ] if ; - -: maybe-update ( tetris -- ) - dup tetris-paused? over tetris-running? not or [ drop ] [ update ] if ; diff --git a/unmaintained/tetris/piece/piece-tests.factor b/unmaintained/tetris/piece/piece-tests.factor deleted file mode 100644 index d4d19fe822..0000000000 --- a/unmaintained/tetris/piece/piece-tests.factor +++ /dev/null @@ -1,23 +0,0 @@ -USING: kernel tetris.tetromino tetris.piece tools.test sequences arrays namespaces ; - -! Tests for tetris.tetromino and tetris.piece, since there's not much to test in tetris.tetromino - -! these two tests rely on the first rotation of the first tetromino being the -! 'I' tetromino in its vertical orientation. -[ 4 ] [ tetrominoes get first tetromino-states first blocks-width ] unit-test -[ 1 ] [ tetrominoes get first tetromino-states first blocks-height ] unit-test - -[ { 0 0 } ] [ random-tetromino piece-location ] unit-test -[ 0 ] [ 10 piece-rotation ] unit-test - -[ { { 0 0 } { 1 0 } { 2 0 } { 3 0 } } ] -[ tetrominoes get first piece-blocks ] unit-test - -[ { { 0 0 } { 0 1 } { 0 2 } { 0 3 } } ] -[ tetrominoes get first dup 1 rotate-piece piece-blocks ] unit-test - -[ { { 1 1 } { 2 1 } { 3 1 } { 4 1 } } ] -[ tetrominoes get first dup { 1 1 } move-piece piece-blocks ] unit-test - -[ 3 ] [ tetrominoes get second piece-width ] unit-test -[ 2 ] [ tetrominoes get second dup 1 rotate-piece piece-width ] unit-test diff --git a/unmaintained/tetris/piece/piece.factor b/unmaintained/tetris/piece/piece.factor deleted file mode 100644 index 55215dbf6a..0000000000 --- a/unmaintained/tetris/piece/piece.factor +++ /dev/null @@ -1,47 +0,0 @@ -! Copyright (C) 2006, 2007 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: kernel arrays tetris.tetromino math math.vectors -sequences quotations lists.lazy ; -IN: tetris.piece - -#! A piece adds state to the tetromino that is the piece's delegate. The -#! rotation is an index into the tetromino's states array, and the position is -#! added to the tetromino's blocks to give them their location on the tetris -#! board. If the location is f then the piece is not yet on the board. -TUPLE: piece rotation location ; - -: ( tetromino -- piece ) - piece construct-delegate - 0 over set-piece-rotation - { 0 0 } over set-piece-location ; - -: (piece-blocks) ( piece -- blocks ) - #! rotates the tetromino - dup piece-rotation swap tetromino-states nth ; - -: piece-blocks ( piece -- blocks ) - #! rotates and positions the tetromino - dup (piece-blocks) swap piece-location [ v+ ] curry map ; - -: piece-width ( piece -- width ) - piece-blocks blocks-width ; - -: set-start-location ( piece board-width -- ) - 2 /i over piece-width 2 /i - 0 2array swap set-piece-location ; - -: ( board-width -- piece ) - random-tetromino [ swap set-start-location ] keep ; - -: ( board-width -- llist ) - [ [ ] curry ] keep [ ] curry lazy-cons ; - -: modulo ( n m -- n ) - #! -2 7 mod => -2, -2 7 modulo => 5 - tuck mod over + swap mod ; - -: rotate-piece ( piece inc -- ) - over piece-rotation + over tetromino-states length modulo swap set-piece-rotation ; - -: move-piece ( piece move -- ) - over piece-location v+ swap set-piece-location ; - diff --git a/unmaintained/tetris/tetris.factor b/unmaintained/tetris/tetris.factor deleted file mode 100644 index d01cec3790..0000000000 --- a/unmaintained/tetris/tetris.factor +++ /dev/null @@ -1,61 +0,0 @@ -! Copyright (C) 2006, 2007 Alex Chapman -! See http://factorcode.org/license.txt for BSD license. -USING: alarms arrays calendar kernel ui.gadgets ui.gadgets.labels -ui.gadgets.worlds ui.gadgets.status-bar ui.gestures ui.render ui -tetris.game tetris.gl sequences system math math.parser namespaces -math.geometry.rect ; -IN: tetris - -TUPLE: tetris-gadget tetris alarm ; - -: ( tetris -- gadget ) - tetris-gadget construct-gadget - [ set-tetris-gadget-tetris ] keep ; - -M: tetris-gadget pref-dim* drop { 200 400 } ; - -: update-status ( gadget -- ) - dup tetris-gadget-tetris [ - "Level: " % dup tetris-level # - " Score: " % tetris-score # - ] "" make swap show-status ; - -M: tetris-gadget draw-gadget* ( gadget -- ) - [ - dup rect-dim dup first swap second rot tetris-gadget-tetris draw-tetris - ] keep update-status ; - -: new-tetris ( gadget -- ) - dup tetris-gadget-tetris swap set-tetris-gadget-tetris ; - -tetris-gadget H{ - { T{ key-down f f "UP" } [ tetris-gadget-tetris rotate-right ] } - { T{ key-down f f "d" } [ tetris-gadget-tetris rotate-left ] } - { T{ key-down f f "f" } [ tetris-gadget-tetris rotate-right ] } - { T{ key-down f f "e" } [ tetris-gadget-tetris rotate-left ] } ! dvorak d - { T{ key-down f f "u" } [ tetris-gadget-tetris rotate-right ] } ! dvorak f - { T{ key-down f f "LEFT" } [ tetris-gadget-tetris move-left ] } - { T{ key-down f f "RIGHT" } [ tetris-gadget-tetris move-right ] } - { T{ key-down f f "DOWN" } [ tetris-gadget-tetris move-down ] } - { T{ key-down f f " " } [ tetris-gadget-tetris move-drop ] } - { T{ key-down f f "p" } [ tetris-gadget-tetris toggle-pause ] } - { T{ key-down f f "n" } [ new-tetris ] } -} set-gestures - -: tick ( gadget -- ) - dup tetris-gadget-tetris maybe-update relayout-1 ; - -M: tetris-gadget graft* ( gadget -- ) - dup [ tick ] curry 100 milliseconds every - swap set-tetris-gadget-alarm ; - -M: tetris-gadget ungraft* ( gadget -- ) - [ tetris-gadget-alarm cancel-alarm f ] keep set-tetris-gadget-alarm ; - -: tetris-window ( -- ) - [ - - "Tetris" open-status-window - ] with-ui ; - -MAIN: tetris-window From 32b3fab3a90cfbe2afde161f7a7eac94674fade9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 20:48:53 -0500 Subject: [PATCH 187/244] assoc-deques -> assoc-heaps --- extra/assoc-deques/assoc-deques-docs.factor | 32 ------------------- extra/assoc-deques/assoc-deques.factor | 31 ------------------ extra/assoc-heaps/assoc-heaps-docs.factor | 32 +++++++++++++++++++ .../assoc-heaps-tests.factor} | 4 +-- extra/assoc-heaps/assoc-heaps.factor | 31 ++++++++++++++++++ .../{assoc-deques => assoc-heaps}/authors.txt | 0 extra/spider/spider.factor | 2 +- 7 files changed, 66 insertions(+), 66 deletions(-) delete mode 100644 extra/assoc-deques/assoc-deques-docs.factor delete mode 100644 extra/assoc-deques/assoc-deques.factor create mode 100644 extra/assoc-heaps/assoc-heaps-docs.factor rename extra/{assoc-deques/assoc-deques-tests.factor => assoc-heaps/assoc-heaps-tests.factor} (62%) create mode 100644 extra/assoc-heaps/assoc-heaps.factor rename extra/{assoc-deques => assoc-heaps}/authors.txt (100%) diff --git a/extra/assoc-deques/assoc-deques-docs.factor b/extra/assoc-deques/assoc-deques-docs.factor deleted file mode 100644 index d8f305d51d..0000000000 --- a/extra/assoc-deques/assoc-deques-docs.factor +++ /dev/null @@ -1,32 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax io.streams.string ; -IN: assoc-deques - -HELP: -{ $description "Constructs a new " { $link assoc-deque } " from two existing data structures." } ; - -HELP: -{ $values - - { "unique-heap" assoc-deque } } -{ $description "Creates a new " { $link assoc-deque } " where the assoc is a hashtable and the deque is a max-heap." } ; - -HELP: -{ $values - - { "unique-heap" assoc-deque } } -{ $description "Creates a new " { $link assoc-deque } " where the assoc is a hashtable and the deque is a min-heap." } ; - -HELP: assoc-deque -{ $description "A data structure containing an assoc and a deque to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-deque to get a sorted data structure with O(1) lookup. Operations on assoc-deques should update both the assoc and the deque." } ; - -ARTICLE: "assoc-deques" "Associative deques" -"The " { $vocab-link "assoc-deques" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl -"Associative deque constructor:" -{ $subsection } -"Unique heaps:" -{ $subsection } -{ $subsection } ; - -ABOUT: "assoc-deques" diff --git a/extra/assoc-deques/assoc-deques.factor b/extra/assoc-deques/assoc-deques.factor deleted file mode 100644 index a23e632b8b..0000000000 --- a/extra/assoc-deques/assoc-deques.factor +++ /dev/null @@ -1,31 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs deques hashtables heaps kernel ; -IN: assoc-deques - -TUPLE: assoc-deque assoc deque ; - -C: assoc-deque - -: ( -- unique-heap ) - H{ } clone ; - -: ( -- unique-heap ) - H{ } clone ; - -M: assoc-deque heap-push* ( value key assoc-deque -- entry ) - pick over assoc>> key? [ - 3drop f - ] [ - [ assoc>> swapd set-at ] [ deque>> heap-push* ] 3bi - ] if ; - -M: assoc-deque heap-pop ( assoc-deque -- value key ) - [ deque>> heap-pop ] keep - [ over ] dip assoc>> delete-at ; - -M: assoc-deque heap-peek ( assoc-deque -- value key ) - deque>> heap-peek ; - -M: assoc-deque heap-empty? ( assoc-deque -- value key ) - deque>> heap-empty? ; diff --git a/extra/assoc-heaps/assoc-heaps-docs.factor b/extra/assoc-heaps/assoc-heaps-docs.factor new file mode 100644 index 0000000000..6a80bcc6c6 --- /dev/null +++ b/extra/assoc-heaps/assoc-heaps-docs.factor @@ -0,0 +1,32 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string ; +IN: assoc-heaps + +HELP: +{ $description "Constructs a new " { $link assoc-heap } " from two existing data structures." } ; + +HELP: +{ $values + + { "unique-heap" assoc-heap } } +{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap." } ; + +HELP: +{ $values + + { "unique-heap" assoc-heap } } +{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap." } ; + +HELP: assoc-heap +{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap should update both the assoc and the heap." } ; + +ARTICLE: "assoc-heaps" "Associative heaps" +"The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl +"Associative heap constructor:" +{ $subsection } +"Unique heaps:" +{ $subsection } +{ $subsection } ; + +ABOUT: "assoc-heaps" diff --git a/extra/assoc-deques/assoc-deques-tests.factor b/extra/assoc-heaps/assoc-heaps-tests.factor similarity index 62% rename from extra/assoc-deques/assoc-deques-tests.factor rename to extra/assoc-heaps/assoc-heaps-tests.factor index fe9d8840bc..6ea3fe14a4 100644 --- a/extra/assoc-deques/assoc-deques-tests.factor +++ b/extra/assoc-heaps/assoc-heaps-tests.factor @@ -1,4 +1,4 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test assoc-deques ; -IN: assoc-deques.tests +USING: tools.test assoc-heaps ; +IN: assoc-heaps.tests diff --git a/extra/assoc-heaps/assoc-heaps.factor b/extra/assoc-heaps/assoc-heaps.factor new file mode 100644 index 0000000000..d2154002b9 --- /dev/null +++ b/extra/assoc-heaps/assoc-heaps.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs hashtables heaps kernel ; +IN: assoc-heaps + +TUPLE: assoc-heap assoc heap ; + +C: assoc-heap + +: ( -- unique-heap ) + H{ } clone ; + +: ( -- unique-heap ) + H{ } clone ; + +M: assoc-heap heap-push* ( value key assoc-heap -- entry ) + pick over assoc>> key? [ + 3drop f + ] [ + [ assoc>> swapd set-at ] [ heap>> heap-push* ] 3bi + ] if ; + +M: assoc-heap heap-pop ( assoc-heap -- value key ) + [ heap>> heap-pop ] keep + [ over ] dip assoc>> delete-at ; + +M: assoc-heap heap-peek ( assoc-heap -- value key ) + heap>> heap-peek ; + +M: assoc-heap heap-empty? ( assoc-heap -- value key ) + heap>> heap-empty? ; diff --git a/extra/assoc-deques/authors.txt b/extra/assoc-heaps/authors.txt similarity index 100% rename from extra/assoc-deques/authors.txt rename to extra/assoc-heaps/authors.txt diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index 6f5261f158..90326d21cd 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -3,7 +3,7 @@ USING: accessors fry html.parser html.parser.analyzer http.client kernel tools.time sets assocs sequences concurrency.combinators io threads namespaces math multiline -heaps math.parser inspector urls assoc-deques logging +heaps math.parser inspector urls assoc-heaps logging combinators.short-circuit continuations calendar prettyprint ; IN: spider From 4ce980b9acbf3416d04b35bb03d791d619abb2d1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 20:54:58 -0500 Subject: [PATCH 188/244] Move heap-slurp-when to spider --- basis/heaps/heaps-docs.factor | 5 ----- basis/heaps/heaps.factor | 6 ------ extra/spider/spider-docs.factor | 5 +++++ extra/spider/spider.factor | 6 ++++++ 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/basis/heaps/heaps-docs.factor b/basis/heaps/heaps-docs.factor index 90298c6edf..77537cbfb1 100755 --- a/basis/heaps/heaps-docs.factor +++ b/basis/heaps/heaps-docs.factor @@ -91,8 +91,3 @@ HELP: slurp-heap { $values { "heap" "a heap" } { "quot" quotation } } { $description "Removes values from a heap and processes them with the quotation until the heap is empty." } ; - -HELP: slurp-heap-when -{ $values - { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } } -{ $description "Removes values from a heap that match the predicate quotation " { $snippet "quot1" } " and processes them with " { $snippet "quot2" } " until the predicate quotation no longer matches." } ; diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor index 50aad826f5..6c387632ed 100755 --- a/basis/heaps/heaps.factor +++ b/basis/heaps/heaps.factor @@ -195,9 +195,3 @@ M: heap heap-pop ( heap -- value key ) over heap-empty? [ 2drop ] [ [ [ heap-pop drop ] dip call ] [ slurp-heap ] 2bi ] if ; inline recursive - -: slurp-heap-when ( heap quot1 quot2: ( value key -- ) -- ) - pick heap-empty? [ 3drop ] [ - [ [ heap-pop dup ] 2dip slip [ t ] compose [ 2drop f ] if ] - [ roll [ slurp-heap-when ] [ 3drop ] if ] 3bi - ] if ; inline recursive diff --git a/extra/spider/spider-docs.factor b/extra/spider/spider-docs.factor index 27238e4f19..458c1d14d8 100644 --- a/extra/spider/spider-docs.factor +++ b/extra/spider/spider-docs.factor @@ -22,6 +22,11 @@ HELP: spider HELP: spider-result { $description "" } ; +HELP: slurp-heap-when +{ $values + { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } } +{ $description "Removes values from a heap that match the predicate quotation " { $snippet "quot1" } " and processes them with " { $snippet "quot2" } " until the predicate quotation no longer matches." } ; + ARTICLE: "spider-tutorial" "Spider tutorial" "To create a new spider, call the " { $link } " word with a link to the site you wish to spider." { $code <" "http://concatentative.org" "> } diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index 6f5261f158..8f60a0d521 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -81,6 +81,12 @@ links processing-time timestamp ; [ initial-links>> normalize-hrefs 0 ] keep [ add-todo ] keep ; +: slurp-heap-when ( heap quot1 quot2: ( value key -- ) -- ) + pick heap-empty? [ 3drop ] [ + [ [ heap-pop dup ] 2dip slip [ t ] compose [ 2drop f ] if ] + [ roll [ slurp-heap-when ] [ 3drop ] if ] 3bi + ] if ; inline recursive + PRIVATE> : run-spider ( spider -- spider ) From f240e1ff37eca88ddb77dba530b7d7d459925b5b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 20:55:24 -0500 Subject: [PATCH 189/244] Small cleanup --- extra/suffix-arrays/suffix-arrays.factor | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/extra/suffix-arrays/suffix-arrays.factor b/extra/suffix-arrays/suffix-arrays.factor index 719496243c..b181ba9d60 100755 --- a/extra/suffix-arrays/suffix-arrays.factor +++ b/extra/suffix-arrays/suffix-arrays.factor @@ -22,10 +22,9 @@ IN: suffix-arrays : ( from/f to/f seq -- slice ) [ tuck - [ drop [ 0 ] unless* ] - [ dupd length ? ] 2bi* + [ drop 0 or ] [ length or ] 2bi* [ min ] keep - ] keep ; + ] keep ; inline PRIVATE> @@ -35,6 +34,6 @@ PRIVATE> : SA{ \ } [ >suffix-array ] parse-literal ; parsing : query ( begin suffix-array -- matches ) - 2dup find-index + 2dup find-index dup [ -rot [ from-to ] keep [ seq>> ] map prune ] - [ 2drop { } ] if* ; + [ 3drop { } ] if ; From 37219fa139aae8ec3239ec69955c1d187fb088e8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 1 Oct 2008 21:05:27 -0500 Subject: [PATCH 190/244] Fix help --- basis/heaps/heaps-docs.factor | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/basis/heaps/heaps-docs.factor b/basis/heaps/heaps-docs.factor index 77537cbfb1..3c1c61faec 100755 --- a/basis/heaps/heaps-docs.factor +++ b/basis/heaps/heaps-docs.factor @@ -29,10 +29,8 @@ $nl { $subsection heap-pop* } { $subsection heap-pop } { $subsection heap-delete } -$nl "Processing heaps:" -{ $subsection slurp-heap } -{ $subsection slurp-heap-when } ; +{ $subsection slurp-heap } ; ABOUT: "heaps" From a10c3f425c570a6c6726fce1a03704e1b82b0df9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 21:25:37 -0500 Subject: [PATCH 191/244] let the unique heap retain hashtable entries after elements are popped to ensure uniqueness forever --- extra/assoc-heaps/assoc-heaps-docs.factor | 9 ++++--- extra/assoc-heaps/assoc-heaps.factor | 3 +-- extra/spider/spider.factor | 33 ++++++++++++----------- 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/extra/assoc-heaps/assoc-heaps-docs.factor b/extra/assoc-heaps/assoc-heaps-docs.factor index 6a80bcc6c6..8beaf9c4b1 100644 --- a/extra/assoc-heaps/assoc-heaps-docs.factor +++ b/extra/assoc-heaps/assoc-heaps-docs.factor @@ -10,16 +10,17 @@ HELP: { $values { "unique-heap" assoc-heap } } -{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap." } ; +{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ; HELP: { $values - { "unique-heap" assoc-heap } } -{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap." } ; +{ $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ; + +{ } related-words HELP: assoc-heap -{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap should update both the assoc and the heap." } ; +{ $description "A data structure containing an assoc and a heap to get certain properties with better time constraints at the expense of more space and complexity. For instance, a hashtable and a heap can be combined into one assoc-heap to get a sorted data structure with O(1) lookup. Operations on assoc-heap may update both the assoc and the heap or leave them out of sync if it's advantageous." } ; ARTICLE: "assoc-heaps" "Associative heaps" "The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl diff --git a/extra/assoc-heaps/assoc-heaps.factor b/extra/assoc-heaps/assoc-heaps.factor index d2154002b9..a495aed626 100644 --- a/extra/assoc-heaps/assoc-heaps.factor +++ b/extra/assoc-heaps/assoc-heaps.factor @@ -21,8 +21,7 @@ M: assoc-heap heap-push* ( value key assoc-heap -- entry ) ] if ; M: assoc-heap heap-pop ( assoc-heap -- value key ) - [ heap>> heap-pop ] keep - [ over ] dip assoc>> delete-at ; + heap>> heap-pop ; M: assoc-heap heap-peek ( assoc-heap -- value key ) heap>> heap-peek ; diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index 90326d21cd..fb7757d448 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -8,7 +8,7 @@ combinators.short-circuit continuations calendar prettyprint ; IN: spider TUPLE: spider base count max-count sleep max-depth initial-links -filters spidered todo nonmatching ; +filters spidered todo nonmatching quiet ; ! secure? agent page-timeout data-timeout overall-timeout TUPLE: spider-result url depth headers fetch-time parsed-html @@ -27,19 +27,19 @@ links processing-time timestamp ; > not ; + : apply-filters ( links spider -- links' ) filters>> [ '[ _ 1&& ] filter ] when* ; +: push-links ( links level assoc-heap -- ) + '[ _ _ heap-push ] each ; + : add-todo ( links level spider -- ) - tuck [ apply-filters ] 2dip - tuck - [ spidered>> keys diff ] - [ todo>> ] 2bi* '[ _ _ heap-push ] each ; + todo>> push-links ; : add-nonmatching ( links level spider -- ) - nonmatching>> '[ _ _ heap-push ] each ; - -: relative-url? ( url -- ? ) protocol>> not ; + nonmatching>> push-links ; : filter-base ( spider spider-result -- base-links nonmatching-links ) [ base>> host>> ] [ links>> prune ] bi* @@ -51,26 +51,27 @@ links processing-time timestamp ; [ filter-base ] 2keep depth>> 1+ swap [ add-nonmatching ] - [ add-todo ] 2bi ; - -: print-spidering ( url depth -- ) - "depth: " write number>string write - ", spidering: " write . yield ; + [ tuck [ apply-filters ] 2dip add-todo ] 2bi ; : normalize-hrefs ( links -- links' ) [ >url ] map spider get base>> swap [ derive-url ] with map ; +: print-spidering ( url depth -- ) + "depth: " write number>string write + ", spidering: " write . yield ; + : (spider-page) ( url depth -- spider-result ) - 2dup print-spidering f pick spider get spidered>> set-at over '[ _ http-get ] benchmark swap [ parse-html dup find-hrefs normalize-hrefs ] benchmark now spider-result boa - dup describe ; : spider-page ( url depth -- ) - (spider-page) spider get swap add-spidered ; + spider get quiet>> [ 2dup print-spidering ] unless + (spider-page) + spider get [ quiet>> [ dup describe ] unless ] + [ swap add-spidered ] bi ; \ spider-page ERROR add-error-logging From 7308f2fb52c9fdd34ed6fac7c0793b2fc7399546 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 1 Oct 2008 21:30:12 -0500 Subject: [PATCH 192/244] fix shiz --- extra/spider/spider-docs.factor | 8 +------- extra/spider/spider.factor | 2 +- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/extra/spider/spider-docs.factor b/extra/spider/spider-docs.factor index 458c1d14d8..5f820ca368 100644 --- a/extra/spider/spider-docs.factor +++ b/extra/spider/spider-docs.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: help.markup help.syntax io.streams.string urls -multiline ; +multiline spider.private quotations ; IN: spider HELP: @@ -16,12 +16,6 @@ HELP: run-spider { "spider" spider } } { $description "Runs a spider until completion. See the " { $subsection "spider-tutorial" } " for a complete description of the tuple slots that affect how thet spider works." } ; -HELP: spider -{ $description "" } ; - -HELP: spider-result -{ $description "" } ; - HELP: slurp-heap-when { $values { "heap" "a heap" } { "quot1" quotation } { "quot2" quotation } } diff --git a/extra/spider/spider.factor b/extra/spider/spider.factor index fa1cd2ac0f..64ee081ecc 100644 --- a/extra/spider/spider.factor +++ b/extra/spider/spider.factor @@ -65,7 +65,7 @@ links processing-time timestamp ; f pick spider get spidered>> set-at over '[ _ http-get ] benchmark swap [ parse-html dup find-hrefs normalize-hrefs ] benchmark - now spider-result boa + now spider-result boa ; : spider-page ( url depth -- ) spider get quiet>> [ 2dup print-spidering ] unless From 2c634cd4abd2a6ad393f6ea3e6a98ec04202dc9e Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Thu, 2 Oct 2008 14:27:39 +1000 Subject: [PATCH 193/244] Moving Jamshred from unmaintained. It's *almost* working. --- {unmaintained => extra}/jamshred/authors.txt | 0 .../jamshred/deploy.factor | 0 .../jamshred/game/authors.txt | 0 .../jamshred/game/game.factor | 0 .../jamshred/gl/authors.txt | 0 {unmaintained => extra}/jamshred/gl/gl.factor | 13 ++++----- .../jamshred/jamshred.factor | 13 ++++----- .../jamshred/log/log.factor | 0 .../jamshred/oint/authors.txt | 0 .../jamshred/oint/oint-tests.factor | 0 .../jamshred/oint/oint.factor | 2 +- .../jamshred/player/authors.txt | 0 .../jamshred/player/player.factor | 5 +--- .../jamshred/sound/bang.wav | Bin .../jamshred/sound/sound.factor | 0 {unmaintained => extra}/jamshred/summary.txt | 0 {unmaintained => extra}/jamshred/tags.txt | 0 .../jamshred/tunnel/authors.txt | 0 .../jamshred/tunnel/tunnel-tests.factor | 26 +++++++++--------- .../jamshred/tunnel/tunnel.factor | 4 +-- 20 files changed, 27 insertions(+), 36 deletions(-) rename {unmaintained => extra}/jamshred/authors.txt (100%) rename {unmaintained => extra}/jamshred/deploy.factor (100%) rename {unmaintained => extra}/jamshred/game/authors.txt (100%) rename {unmaintained => extra}/jamshred/game/game.factor (100%) rename {unmaintained => extra}/jamshred/gl/authors.txt (100%) rename {unmaintained => extra}/jamshred/gl/gl.factor (86%) rename {unmaintained => extra}/jamshred/jamshred.factor (85%) rename {unmaintained => extra}/jamshred/log/log.factor (100%) rename {unmaintained => extra}/jamshred/oint/authors.txt (100%) rename {unmaintained => extra}/jamshred/oint/oint-tests.factor (100%) rename {unmaintained => extra}/jamshred/oint/oint.factor (98%) rename {unmaintained => extra}/jamshred/player/authors.txt (100%) rename {unmaintained => extra}/jamshred/player/player.factor (94%) rename {unmaintained => extra}/jamshred/sound/bang.wav (100%) rename {unmaintained => extra}/jamshred/sound/sound.factor (100%) rename {unmaintained => extra}/jamshred/summary.txt (100%) rename {unmaintained => extra}/jamshred/tags.txt (100%) rename {unmaintained => extra}/jamshred/tunnel/authors.txt (100%) rename {unmaintained => extra}/jamshred/tunnel/tunnel-tests.factor (69%) rename {unmaintained => extra}/jamshred/tunnel/tunnel.factor (98%) diff --git a/unmaintained/jamshred/authors.txt b/extra/jamshred/authors.txt similarity index 100% rename from unmaintained/jamshred/authors.txt rename to extra/jamshred/authors.txt diff --git a/unmaintained/jamshred/deploy.factor b/extra/jamshred/deploy.factor similarity index 100% rename from unmaintained/jamshred/deploy.factor rename to extra/jamshred/deploy.factor diff --git a/unmaintained/jamshred/game/authors.txt b/extra/jamshred/game/authors.txt similarity index 100% rename from unmaintained/jamshred/game/authors.txt rename to extra/jamshred/game/authors.txt diff --git a/unmaintained/jamshred/game/game.factor b/extra/jamshred/game/game.factor similarity index 100% rename from unmaintained/jamshred/game/game.factor rename to extra/jamshred/game/game.factor diff --git a/unmaintained/jamshred/gl/authors.txt b/extra/jamshred/gl/authors.txt similarity index 100% rename from unmaintained/jamshred/gl/authors.txt rename to extra/jamshred/gl/authors.txt diff --git a/unmaintained/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor similarity index 86% rename from unmaintained/jamshred/gl/gl.factor rename to extra/jamshred/gl/gl.factor index 52caaa10c9..69af7ab986 100644 --- a/unmaintained/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -1,9 +1,6 @@ -! Copyright (C) 2007 Alex Chapman +! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types colors jamshred.game -jamshred.oint jamshred.player jamshred.tunnel kernel math -math.constants math.functions math.vectors opengl opengl.gl -opengl.glu sequences float-arrays ; +USING: accessors alien.c-types jamshred.game jamshred.oint jamshred.player jamshred.tunnel kernel math math.constants math.functions math.vectors opengl opengl.gl opengl.glu sequences float-arrays ; IN: jamshred.gl : min-vertices 6 ; inline @@ -45,7 +42,7 @@ IN: jamshred.gl #! return a sequence of n numbers between 0 and 2pi dup [ / pi 2 * * ] curry map ; : draw-segment-vertex ( segment theta -- ) - over segment-color gl-color segment-vertex-and-normal + over color>> gl-color segment-vertex-and-normal gl-normal gl-vertex ; : draw-vertex-pair ( theta next-segment segment -- ) @@ -61,8 +58,8 @@ IN: jamshred.gl 1 over length pick subseq swap [ draw-segment ] 2each ; : segments-to-render ( player -- segments ) - dup player-nearest-segment segment-number dup n-segments-behind - - swap n-segments-ahead + rot player-tunnel sub-tunnel ; + dup nearest-segment>> number>> dup n-segments-behind - + swap n-segments-ahead + rot tunnel>> sub-tunnel ; : draw-tunnel ( player -- ) segments-to-render draw-segments ; diff --git a/unmaintained/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor similarity index 85% rename from unmaintained/jamshred/jamshred.factor rename to extra/jamshred/jamshred.factor index d9a0f84b53..aa9c164b8f 100755 --- a/unmaintained/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -1,15 +1,12 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alarms arrays calendar jamshred.game jamshred.gl -jamshred.player jamshred.log kernel math math.constants namespaces -sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds -ui.gestures ui.render math.vectors math.geometry.rect ; +USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.geometry.rect math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ; IN: jamshred -TUPLE: jamshred-gadget jamshred last-hand-loc alarm ; +TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ; : ( jamshred -- gadget ) - jamshred-gadget construct-gadget swap >>jamshred ; + jamshred-gadget new-gadget swap >>jamshred ; : default-width ( -- x ) 800 ; : default-height ( -- y ) 600 ; @@ -91,7 +88,7 @@ jamshred-gadget H{ { T{ mouse-scroll } [ handle-mouse-scroll ] } } set-gestures -: jamshred-window ( -- jamshred ) - [ dup "Jamshred" open-window ] with-ui ; +: jamshred-window ( -- gadget ) + [ dup "Jamshred" open-window ] with-ui ; MAIN: jamshred-window diff --git a/unmaintained/jamshred/log/log.factor b/extra/jamshred/log/log.factor similarity index 100% rename from unmaintained/jamshred/log/log.factor rename to extra/jamshred/log/log.factor diff --git a/unmaintained/jamshred/oint/authors.txt b/extra/jamshred/oint/authors.txt similarity index 100% rename from unmaintained/jamshred/oint/authors.txt rename to extra/jamshred/oint/authors.txt diff --git a/unmaintained/jamshred/oint/oint-tests.factor b/extra/jamshred/oint/oint-tests.factor similarity index 100% rename from unmaintained/jamshred/oint/oint-tests.factor rename to extra/jamshred/oint/oint-tests.factor diff --git a/unmaintained/jamshred/oint/oint.factor b/extra/jamshred/oint/oint.factor similarity index 98% rename from unmaintained/jamshred/oint/oint.factor rename to extra/jamshred/oint/oint.factor index 7a37646a6d..808e92a1f9 100644 --- a/unmaintained/jamshred/oint/oint.factor +++ b/extra/jamshred/oint/oint.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Alex Chapman +! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ; IN: jamshred.oint diff --git a/unmaintained/jamshred/player/authors.txt b/extra/jamshred/player/authors.txt similarity index 100% rename from unmaintained/jamshred/player/authors.txt rename to extra/jamshred/player/authors.txt diff --git a/unmaintained/jamshred/player/player.factor b/extra/jamshred/player/player.factor similarity index 94% rename from unmaintained/jamshred/player/player.factor rename to extra/jamshred/player/player.factor index 48ea847db1..418847673b 100644 --- a/unmaintained/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -1,9 +1,6 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors colors combinators jamshred.log jamshred.oint -jamshred.sound jamshred.tunnel kernel locals math math.constants -math.order math.ranges math.vectors math.matrices shuffle -sequences system float-arrays ; +USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle system ; IN: jamshred.player TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; diff --git a/unmaintained/jamshred/sound/bang.wav b/extra/jamshred/sound/bang.wav similarity index 100% rename from unmaintained/jamshred/sound/bang.wav rename to extra/jamshred/sound/bang.wav diff --git a/unmaintained/jamshred/sound/sound.factor b/extra/jamshred/sound/sound.factor similarity index 100% rename from unmaintained/jamshred/sound/sound.factor rename to extra/jamshred/sound/sound.factor diff --git a/unmaintained/jamshred/summary.txt b/extra/jamshred/summary.txt similarity index 100% rename from unmaintained/jamshred/summary.txt rename to extra/jamshred/summary.txt diff --git a/unmaintained/jamshred/tags.txt b/extra/jamshred/tags.txt similarity index 100% rename from unmaintained/jamshred/tags.txt rename to extra/jamshred/tags.txt diff --git a/unmaintained/jamshred/tunnel/authors.txt b/extra/jamshred/tunnel/authors.txt similarity index 100% rename from unmaintained/jamshred/tunnel/authors.txt rename to extra/jamshred/tunnel/authors.txt diff --git a/unmaintained/jamshred/tunnel/tunnel-tests.factor b/extra/jamshred/tunnel/tunnel-tests.factor similarity index 69% rename from unmaintained/jamshred/tunnel/tunnel-tests.factor rename to extra/jamshred/tunnel/tunnel-tests.factor index 97077bdd67..9486713f55 100644 --- a/unmaintained/jamshred/tunnel/tunnel-tests.factor +++ b/extra/jamshred/tunnel/tunnel-tests.factor @@ -1,20 +1,20 @@ -! Copyright (C) 2007 Alex Chapman +! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test float-arrays ; +USING: accessors arrays float-arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test ; IN: jamshred.tunnel.tests [ 0 ] [ T{ segment f { 0 0 0 } f f f 0 } T{ segment f { 1 1 1 } f f f 1 } T{ oint f { 0 0 0.25 } } - nearer-segment segment-number ] unit-test + nearer-segment number>> ] unit-test -[ 0 ] [ T{ oint f { 0 0 0 } } find-nearest-segment segment-number ] unit-test -[ 1 ] [ T{ oint f { 0 0 -1 } } find-nearest-segment segment-number ] unit-test -[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } find-nearest-segment segment-number ] unit-test +[ 0 ] [ T{ oint f { 0 0 0 } } find-nearest-segment number>> ] unit-test +[ 1 ] [ T{ oint f { 0 0 -1 } } find-nearest-segment number>> ] unit-test +[ 2 ] [ T{ oint f { 0 0.1 -2.1 } } find-nearest-segment number>> ] unit-test -[ 3 ] [ T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward segment-number ] unit-test +[ 3 ] [ T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test -[ F{ 0 0 0 } ] [ T{ oint f { 0 0 -0.25 } } over first nearest-segment oint-location ] unit-test +[ F{ 0 0 0 } ] [ T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test : test-segment-oint ( -- oint ) { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } ; @@ -32,14 +32,14 @@ IN: jamshred.tunnel.tests { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } initial-segment ; -[ { 0 0 0 } ] [ simplest-straight-ahead sideways-heading ] unit-test -[ { 0 0 0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test +[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-heading ] unit-test +[ { 0.0 0.0 0.0 } ] [ simplest-straight-ahead sideways-relative-location ] unit-test : simple-collision-up ( -- oint segment ) { 0 0 0 } { 0 1 0 } { 0 0 1 } { -1 0 0 } initial-segment ; -[ { 0 1 0 } ] [ simple-collision-up sideways-heading ] unit-test -[ { 0 0 0 } ] [ simple-collision-up sideways-relative-location ] unit-test -[ { 0 1 0 } ] +[ { 0.0 1.0 0.0 } ] [ simple-collision-up sideways-heading ] unit-test +[ { 0.0 0.0 0.0 } ] [ simple-collision-up sideways-relative-location ] unit-test +[ { 0.0 1.0 0.0 } ] [ simple-collision-up collision-vector 0 0 0 3array v+ ] unit-test diff --git a/unmaintained/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor similarity index 98% rename from unmaintained/jamshred/tunnel/tunnel.factor rename to extra/jamshred/tunnel/tunnel.factor index 99c396bebd..8d2cc8e766 100755 --- a/unmaintained/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -21,7 +21,7 @@ C: segment : random-segment ( previous-segment -- segment ) clone dup random-rotation-angle random-turn tunnel-segment-distance over go-forward - random-color over set-segment-color dup segment-number++ ; + random-color >>color dup segment-number++ ; : (random-segments) ( segments n -- segments ) dup 0 > [ @@ -77,7 +77,7 @@ C: segment : nearest-segment ( segments oint start-segment -- segment ) #! find the segment nearest to 'oint', and return it. #! start looking at segment 'start-segment' - segment-number over >r + number>> over >r [ nearest-segment-forward ] 3keep nearest-segment-backward r> nearer-segment ; From 7c9d7f476ab00f9c028d24115b088fadf182343a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 18:28:10 -0500 Subject: [PATCH 194/244] windows needs timeval struct too --- basis/windows/winsock/winsock.factor | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 3c4230e21e..4ca07ce850 100644 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman. - +! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.strings alien.syntax arrays byte-arrays kernel math sequences windows.types windows.kernel32 -windows.errors structs windows math.bitwise alias ; +windows.errors windows math.bitwise alias ; IN: windows.winsock USE: libc @@ -138,6 +138,10 @@ C-STRUCT: addrinfo { "sockaddr*" "addr" } { "addrinfo*" "next" } ; +C-STRUCT: timeval + { "long" "sec" } + { "long" "usec" } ; + : hostent-addr ( hostent -- addr ) hostent-addr-list *void* ; ! *uint ; LIBRARY: winsock @@ -440,4 +444,3 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi : init-winsock ( -- ) HEX: 0202 WSAStartup winsock-return-check ; - From 8e315944b41e5bb4d8403742e8340abb6278699f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 19:01:41 -0500 Subject: [PATCH 195/244] fix --- basis/io/unix/backend/backend.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/unix/backend/backend.factor b/basis/io/unix/backend/backend.factor index 0e9139f431..5bb0b82555 100644 --- a/basis/io/unix/backend/backend.factor +++ b/basis/io/unix/backend/backend.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types generic assocs kernel kernel.private -math io.ports sequences strings structs sbufs threads unix +math io.ports sequences strings sbufs threads unix vectors io.buffers io.backend io.encodings math.parser continuations system libc qualified namespaces make io.timeouts io.encodings.utf8 destructors accessors summary combinators -locals ; +locals unix.time ; QUALIFIED: io IN: io.unix.backend From 69b3306f4b47daefab7edd0018598cf9e3649f05 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 19:13:33 -0500 Subject: [PATCH 196/244] fix using --- basis/io/unix/files/files.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index fafc56154b..f0dc028d74 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -4,7 +4,7 @@ USING: io.backend io.ports io.unix.backend io.files io unix unix.stat unix.time kernel math continuations math.bitwise byte-arrays alien combinators calendar io.encodings.binary accessors sequences strings system -io.files.private destructors vocabs.loader ; +io.files.private destructors vocabs.loader calendar.unix ; IN: io.unix.files From 114e81590cf9367ea4f33c13eb74e4be464a7564 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 20:52:32 -0500 Subject: [PATCH 197/244] renamed timestamp>unix-time --- basis/io/unix/files/freebsd/freebsd.factor | 2 +- basis/io/unix/files/netbsd/netbsd.factor | 2 +- basis/io/unix/files/openbsd/openbsd.factor | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor index e6fff4dfe0..26cfe48bb1 100644 --- a/basis/io/unix/files/freebsd/freebsd.factor +++ b/basis/io/unix/files/freebsd/freebsd.factor @@ -13,5 +13,5 @@ M: freebsd stat>file-info ( stat -- file-info ) { [ stat-st_flags >>flags ] [ stat-st_gen >>gen ] - [ stat-st_birthtimespec timespec>timestamp >>birth-time ] + [ stat-st_birthtimespec timespec>unix-time >>birth-time ] } cleave ; diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor index 6a41e6e18a..c5f52cc100 100644 --- a/basis/io/unix/files/netbsd/netbsd.factor +++ b/basis/io/unix/files/netbsd/netbsd.factor @@ -13,5 +13,5 @@ M: netbsd stat>file-info ( stat -- file-info ) { [ stat-st_flags >>flags ] [ stat-st_gen >>gen ] - [ stat-st_birthtim timespec>timestamp >>birth-time ] + [ stat-st_birthtim timespec>unix-time >>birth-time ] } cleave ; diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor index 5723827481..58833e7c97 100644 --- a/basis/io/unix/files/openbsd/openbsd.factor +++ b/basis/io/unix/files/openbsd/openbsd.factor @@ -13,5 +13,5 @@ M: openbsd stat>file-info ( stat -- file-info ) { [ stat-st_flags >>flags ] [ stat-st_gen >>gen ] - [ stat-st_birthtim timespec>timestamp >>birth-time ] + [ stat-st_birthtim timespec>unix-time >>birth-time ] } cleave ; From 1f1a62fcdd2a8969a375a0b7ec7c70fd66c013f7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 21:02:10 -0500 Subject: [PATCH 198/244] fix using --- basis/io/unix/select/select.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor index f0547da10e..8638ae7be5 100644 --- a/basis/io/unix/select/select.factor +++ b/basis/io/unix/select/select.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.ports io.unix.backend bit-arrays sequences assocs unix math namespaces structs -accessors math.order locals ; +accessors math.order locals unix.time ; IN: io.unix.select TUPLE: select-mx < mx read-fdset write-fdset ; From 9751a38fa73f7b1f48293f8c77c6a6eaa3b5a8a0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 21:04:30 -0500 Subject: [PATCH 199/244] since-1970 docs --- basis/calendar/calendar-docs.factor | 6 ++++++ basis/calendar/calendar.factor | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index f1cdafb476..64c74a494a 100644 --- a/basis/calendar/calendar-docs.factor +++ b/basis/calendar/calendar-docs.factor @@ -512,6 +512,12 @@ HELP: time-since-midnight { $values { "timestamp" timestamp } { "duration" duration } } { $description "Calculates a " { $snippet "duration" } " that represents the elapsed time since midnight of the input " { $snippet "timestamp" } "." } ; +HELP: since-1970 +{ $values + { "duration" duration } + { "timestamp" timestamp } } +{ $description "Adds the duration to the beginning of Unix time and returns the result as a timestamp." } ; + ARTICLE: "calendar" "Calendar" "The two data types used throughout the calendar library:" { $subsection timestamp } diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index d5824768f4..c002760748 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -401,7 +401,7 @@ PRIVATE> : time-since-midnight ( timestamp -- duration ) dup midnight time- ; -: since-1970 ( time -- timestamp ) +: since-1970 ( duration -- timestamp ) unix-1970 time+ >local-time ; M: timestamp sleep-until timestamp>millis sleep-until ; From 1d5b86f23c2c6820946a07f64ff2c79272df50f2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 21:16:15 -0500 Subject: [PATCH 200/244] factor is hard. let's go shopping! --- basis/io/unix/select/select.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/unix/select/select.factor b/basis/io/unix/select/select.factor index 8638ae7be5..f2a802a859 100644 --- a/basis/io/unix/select/select.factor +++ b/basis/io/unix/select/select.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.ports io.unix.backend -bit-arrays sequences assocs unix math namespaces structs +bit-arrays sequences assocs unix math namespaces accessors math.order locals unix.time ; IN: io.unix.select From ff64bafae24efebaaf7ee9c943ccd5126458c5b8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 21:17:51 -0500 Subject: [PATCH 201/244] dont use structs --- basis/io/unix/epoll/epoll.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/io/unix/epoll/epoll.factor b/basis/io/unix/epoll/epoll.factor index 406a7fcb50..05a9bcfa8d 100644 --- a/basis/io/unix/epoll/epoll.factor +++ b/basis/io/unix/epoll/epoll.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien.c-types kernel io.ports io.unix.backend bit-arrays sequences assocs unix unix.linux.epoll math -namespaces structs ; +namespaces unix.time ; IN: io.unix.epoll TUPLE: epoll-mx < mx events ; From 0e81d4c82c4130a829a4703c68ee6e75ac078325 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 21:41:06 -0500 Subject: [PATCH 202/244] last using patch, i think i got it --- basis/calendar/unix/unix.factor | 12 ------------ basis/unix/time/time.factor | 12 ++++++++++++ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index fcdfcc8a67..d5b66ffc1a 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -4,18 +4,6 @@ USING: alien alien.c-types alien.syntax arrays calendar kernel math unix unix.time namespaces system ; IN: calendar.unix -: make-timeval ( ms -- timeval ) - 1000 /mod 1000 * - "timeval" - [ set-timeval-usec ] keep - [ set-timeval-sec ] keep ; - -: make-timespec ( ms -- timespec ) - 1000 /mod 1000000 * - "timespec" - [ set-timespec-nsec ] keep - [ set-timespec-sec ] keep ; - : timeval>unix-time ( timeval -- timestamp ) [ timeval-sec seconds ] [ timeval-usec microseconds ] bi time+ since-1970 ; diff --git a/basis/unix/time/time.factor b/basis/unix/time/time.factor index b6471e9892..c664aa3bfb 100644 --- a/basis/unix/time/time.factor +++ b/basis/unix/time/time.factor @@ -11,6 +11,18 @@ C-STRUCT: timespec { "time_t" "sec" } { "long" "nsec" } ; +: make-timeval ( ms -- timeval ) + 1000 /mod 1000 * + "timeval" + [ set-timeval-usec ] keep + [ set-timeval-sec ] keep ; + +: make-timespec ( ms -- timespec ) + 1000 /mod 1000000 * + "timespec" + [ set-timespec-nsec ] keep + [ set-timespec-sec ] keep ; + C-STRUCT: tm { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?) { "int" "min" } ! Minutes: 0-59 From 312f399003e7e51bc5e6df57770c3bba87b061d0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 22:51:06 -0500 Subject: [PATCH 203/244] found stat64 for macosx, so there's a unix-file-info and a bsd-file-info only --- basis/io/unix/files/files.factor | 14 +++++++------- basis/io/unix/files/freebsd/freebsd.factor | 17 ----------------- basis/io/unix/files/freebsd/tags.txt | 1 - basis/io/unix/files/macosx/macosx.factor | 16 ---------------- basis/io/unix/files/macosx/tags.txt | 1 - basis/io/unix/files/netbsd/netbsd.factor | 17 ----------------- basis/io/unix/files/netbsd/tags.txt | 1 - basis/io/unix/files/openbsd/openbsd.factor | 17 ----------------- basis/io/unix/files/openbsd/tags.txt | 1 - basis/unix/stat/freebsd/32/32.factor | 8 ++++---- basis/unix/stat/freebsd/64/64.factor | 6 +++--- basis/unix/stat/linux/32/32.factor | 8 ++++---- basis/unix/stat/linux/64/64.factor | 6 +++--- basis/unix/stat/macosx/macosx.factor | 15 +++++++-------- basis/unix/stat/netbsd/32/32.factor | 8 ++++---- basis/unix/stat/netbsd/64/64.factor | 8 ++++---- basis/unix/stat/openbsd/openbsd.factor | 8 ++++---- 17 files changed, 40 insertions(+), 112 deletions(-) delete mode 100644 basis/io/unix/files/freebsd/freebsd.factor delete mode 100644 basis/io/unix/files/freebsd/tags.txt delete mode 100644 basis/io/unix/files/macosx/macosx.factor delete mode 100644 basis/io/unix/files/macosx/tags.txt delete mode 100644 basis/io/unix/files/netbsd/netbsd.factor delete mode 100644 basis/io/unix/files/netbsd/tags.txt delete mode 100644 basis/io/unix/files/openbsd/openbsd.factor delete mode 100644 basis/io/unix/files/openbsd/tags.txt diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index f0dc028d74..6ddb74f4a3 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -103,9 +103,9 @@ M: unix stat>file-info ( stat -- file-info ) [ stat>type >>type ] [ stat-st_size >>size ] [ stat-st_mode >>permissions ] - [ stat-st_ctim timespec>unix-time >>created ] - [ stat-st_mtim timespec>unix-time >>modified ] - [ stat-st_atim timespec>unix-time >>accessed ] + [ stat-st_ctimespec timespec>unix-time >>created ] + [ stat-st_mtimespec timespec>unix-time >>modified ] + [ stat-st_atimespec timespec>unix-time >>accessed ] [ stat-st_uid >>uid ] [ stat-st_gid >>gid ] [ stat-st_dev >>dev ] @@ -130,9 +130,9 @@ M: unix stat>type ( stat -- type ) ! Linux has no extra fields in its stat struct os { - { macosx [ "io.unix.files.macosx" require ] } - { freebsd [ "io.unix.files.freebsd" require ] } - { netbsd [ "io.unix.files.netbsd" require ] } - { openbsd [ "io.unix.files.openbsd" require ] } + { macosx [ "io.unix.files.bsd" require ] } + { netbsd [ "io.unix.files.bsd" require ] } + { openbsd [ "io.unix.files.bsd" require ] } + { freebsd [ "io.unix.files.bsd" require ] } { linux [ ] } } case diff --git a/basis/io/unix/files/freebsd/freebsd.factor b/basis/io/unix/files/freebsd/freebsd.factor deleted file mode 100644 index 26cfe48bb1..0000000000 --- a/basis/io/unix/files/freebsd/freebsd.factor +++ /dev/null @@ -1,17 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators calendar.unix ; -IN: io.unix.files.freebsd - -TUPLE: freebsd-file-info < unix-file-info birth-time flags gen ; - -M: freebsd new-file-info ( -- class ) freebsd-file-info new ; - -M: freebsd stat>file-info ( stat -- file-info ) - [ call-next-method ] keep - { - [ stat-st_flags >>flags ] - [ stat-st_gen >>gen ] - [ stat-st_birthtimespec timespec>unix-time >>birth-time ] - } cleave ; diff --git a/basis/io/unix/files/freebsd/tags.txt b/basis/io/unix/files/freebsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/freebsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/macosx/macosx.factor b/basis/io/unix/files/macosx/macosx.factor deleted file mode 100644 index 4173123e45..0000000000 --- a/basis/io/unix/files/macosx/macosx.factor +++ /dev/null @@ -1,16 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators ; -IN: io.unix.files.macosx - -TUPLE: macosx-file-info < unix-file-info flags gen ; - -M: macosx new-file-info ( -- class ) macosx-file-info new ; - -M: macosx stat>file-info ( stat -- file-info ) - [ call-next-method ] keep - { - [ stat-st_flags >>flags ] - [ stat-st_gen >>gen ] - } cleave ; diff --git a/basis/io/unix/files/macosx/tags.txt b/basis/io/unix/files/macosx/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/macosx/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/netbsd/netbsd.factor b/basis/io/unix/files/netbsd/netbsd.factor deleted file mode 100644 index c5f52cc100..0000000000 --- a/basis/io/unix/files/netbsd/netbsd.factor +++ /dev/null @@ -1,17 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators calendar.unix ; -IN: io.unix.files.netbsd - -TUPLE: netbsd-file-info < unix-file-info birth-time flags gen ; - -M: netbsd new-file-info ( -- class ) netbsd-file-info new ; - -M: netbsd stat>file-info ( stat -- file-info ) - [ call-next-method ] keep - { - [ stat-st_flags >>flags ] - [ stat-st_gen >>gen ] - [ stat-st_birthtim timespec>unix-time >>birth-time ] - } cleave ; diff --git a/basis/io/unix/files/netbsd/tags.txt b/basis/io/unix/files/netbsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/netbsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/io/unix/files/openbsd/openbsd.factor b/basis/io/unix/files/openbsd/openbsd.factor deleted file mode 100644 index 58833e7c97..0000000000 --- a/basis/io/unix/files/openbsd/openbsd.factor +++ /dev/null @@ -1,17 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel alien.syntax math io.unix.files system -unix.stat accessors combinators calendar.unix ; -IN: io.unix.files.openbsd - -TUPLE: openbsd-file-info < unix-file-info birth-time flags gen ; - -M: openbsd new-file-info ( -- class ) openbsd-file-info new ; - -M: openbsd stat>file-info ( stat -- file-info ) - [ call-next-method ] keep - { - [ stat-st_flags >>flags ] - [ stat-st_gen >>gen ] - [ stat-st_birthtim timespec>unix-time >>birth-time ] - } cleave ; diff --git a/basis/io/unix/files/openbsd/tags.txt b/basis/io/unix/files/openbsd/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/basis/io/unix/files/openbsd/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/basis/unix/stat/freebsd/32/32.factor b/basis/unix/stat/freebsd/32/32.factor index a81fc4f02e..3692dea0c0 100644 --- a/basis/unix/stat/freebsd/32/32.factor +++ b/basis/unix/stat/freebsd/32/32.factor @@ -12,9 +12,9 @@ C-STRUCT: stat { "uid_t" "st_uid" } { "gid_t" "st_gid" } { "__dev_t" "st_rdev" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } { "off_t" "st_size" } { "blkcnt_t" "st_blocks" } { "blksize_t" "st_blksize" } @@ -27,4 +27,4 @@ C-STRUCT: stat { "__uint32_t" "pad1" } ; FUNCTION: int stat ( char* pathname, stat* buf ) ; -FUNCTION: int lstat ( char* pathname, stat* buf ) ; \ No newline at end of file +FUNCTION: int lstat ( char* pathname, stat* buf ) ; diff --git a/basis/unix/stat/freebsd/64/64.factor b/basis/unix/stat/freebsd/64/64.factor index 75d51cd6ae..73ba676701 100644 --- a/basis/unix/stat/freebsd/64/64.factor +++ b/basis/unix/stat/freebsd/64/64.factor @@ -12,9 +12,9 @@ C-STRUCT: stat { "uid_t" "st_uid" } { "gid_t" "st_gid" } { "__dev_t" "st_rdev" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } { "off_t" "st_size" } { "blkcnt_t" "st_blocks" } { "blksize_t" "st_blksize" } diff --git a/basis/unix/stat/linux/32/32.factor b/basis/unix/stat/linux/32/32.factor index ed53fab86b..3f6c6ba0e0 100644 --- a/basis/unix/stat/linux/32/32.factor +++ b/basis/unix/stat/linux/32/32.factor @@ -18,9 +18,9 @@ C-STRUCT: stat { "off_t" "st_size" } { "blksize_t" "st_blksize" } { "blkcnt_t" "st_blocks" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } { "ulong" "unused4" } { "ulong" "unused5" } ; @@ -30,4 +30,4 @@ FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ; FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ; : stat ( pathname buf -- int ) 3 -rot __xstat ; -: lstat ( pathname buf -- int ) 3 -rot __lxstat ; \ No newline at end of file +: lstat ( pathname buf -- int ) 3 -rot __lxstat ; diff --git a/basis/unix/stat/linux/64/64.factor b/basis/unix/stat/linux/64/64.factor index a374551385..088ab8d339 100644 --- a/basis/unix/stat/linux/64/64.factor +++ b/basis/unix/stat/linux/64/64.factor @@ -17,9 +17,9 @@ C-STRUCT: stat { "off_t" "st_size" } { "blksize_t" "st_blksize" } { "blkcnt_t" "st_blocks" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } { "long" "__unused0" } { "long" "__unused1" } { "long" "__unused2" } ; diff --git a/basis/unix/stat/macosx/macosx.factor b/basis/unix/stat/macosx/macosx.factor index 4d84e38399..65e02b7986 100644 --- a/basis/unix/stat/macosx/macosx.factor +++ b/basis/unix/stat/macosx/macosx.factor @@ -1,21 +1,21 @@ - USING: kernel alien.syntax math ; - IN: unix.stat ! Mac OS X ppc +! stat64 structure C-STRUCT: stat { "dev_t" "st_dev" } - { "ino_t" "st_ino" } { "mode_t" "st_mode" } { "nlink_t" "st_nlink" } + { "ino_t" "st_ino" } { "uid_t" "st_uid" } { "gid_t" "st_gid" } { "dev_t" "st_rdev" } { "timespec" "st_atimespec" } { "timespec" "st_mtimespec" } { "timespec" "st_ctimespec" } + { "timespec" "st_birthtimespec" } { "off_t" "st_size" } { "blkcnt_t" "st_blocks" } { "blksize_t" "st_blksize" } @@ -25,9 +25,8 @@ C-STRUCT: stat { "__int64_t" "st_qspare0" } { "__int64_t" "st_qspare1" } ; -FUNCTION: int stat ( char* pathname, stat* buf ) ; -FUNCTION: int lstat ( char* pathname, stat* buf ) ; +FUNCTION: int stat64 ( char* pathname, stat* buf ) ; +FUNCTION: int lstat64 ( char* pathname, stat* buf ) ; -: stat-st_atim ( stat -- timespec ) stat-st_atimespec ; -: stat-st_mtim ( stat -- timespec ) stat-st_mtimespec ; -: stat-st_ctim ( stat -- timespec ) stat-st_ctimespec ; +: stat ( path buf -- n ) stat64 ; +: lstat ( path buf -- n ) lstat64 ; diff --git a/basis/unix/stat/netbsd/32/32.factor b/basis/unix/stat/netbsd/32/32.factor index 55f5108c70..d6a60ba5c8 100644 --- a/basis/unix/stat/netbsd/32/32.factor +++ b/basis/unix/stat/netbsd/32/32.factor @@ -11,10 +11,10 @@ C-STRUCT: stat { "uid_t" "st_uid" } { "gid_t" "st_gid" } { "dev_t" "st_rdev" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } - { "timespec" "st_birthtim" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } + { "timespec" "st_birthtimespec" } { "off_t" "st_size" } { "blkcnt_t" "st_blocks" } { "blksize_t" "st_blksize" } diff --git a/basis/unix/stat/netbsd/64/64.factor b/basis/unix/stat/netbsd/64/64.factor index 163695b524..1a1f97507c 100644 --- a/basis/unix/stat/netbsd/64/64.factor +++ b/basis/unix/stat/netbsd/64/64.factor @@ -11,16 +11,16 @@ C-STRUCT: stat { "uid_t" "st_uid" } { "gid_t" "st_gid" } { "dev_t" "st_rdev" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } { "off_t" "st_size" } { "blkcnt_t" "st_blocks" } { "blksize_t" "st_blksize" } { "uint32_t" "st_flags" } { "uint32_t" "st_gen" } { "uint32_t" "st_spare0" } - { "timespec" "st_birthtim" } ; + { "timespec" "st_birthtimespec" } ; FUNCTION: int __stat13 ( char* pathname, stat* buf ) ; FUNCTION: int __lstat13 ( char* pathname, stat* buf ) ; diff --git a/basis/unix/stat/openbsd/openbsd.factor b/basis/unix/stat/openbsd/openbsd.factor index decfb0dbb1..f76d4c6e18 100644 --- a/basis/unix/stat/openbsd/openbsd.factor +++ b/basis/unix/stat/openbsd/openbsd.factor @@ -12,16 +12,16 @@ C-STRUCT: stat { "gid_t" "st_gid" } { "dev_t" "st_rdev" } { "int32_t" "st_lspare0" } - { "timespec" "st_atim" } - { "timespec" "st_mtim" } - { "timespec" "st_ctim" } + { "timespec" "st_atimespec" } + { "timespec" "st_mtimespec" } + { "timespec" "st_ctimespec" } { "off_t" "st_size" } { "int64_t" "st_blocks" } { "u_int32_t" "st_blksize" } { "u_int32_t" "st_flags" } { "u_int32_t" "st_gen" } { "int32_t" "st_lspare1" } - { "timespec" "st_birthtim" } + { "timespec" "st_birthtimespec" } { { "int64_t" 2 } "st_qspare" } ; FUNCTION: int stat ( char* pathname, stat* buf ) ; From 39160d66e3f086a60341c9b6ff8bde8364c79143 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 6 Oct 2008 23:02:06 -0500 Subject: [PATCH 204/244] add files --- basis/io/unix/files/bsd/bsd.factor | 17 +++++++++++++++++ basis/io/unix/files/bsd/tags.txt | 1 + 2 files changed, 18 insertions(+) create mode 100644 basis/io/unix/files/bsd/bsd.factor create mode 100644 basis/io/unix/files/bsd/tags.txt diff --git a/basis/io/unix/files/bsd/bsd.factor b/basis/io/unix/files/bsd/bsd.factor new file mode 100644 index 0000000000..18e713af2f --- /dev/null +++ b/basis/io/unix/files/bsd/bsd.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel alien.syntax math io.unix.files system +unix.stat accessors combinators calendar.unix ; +IN: io.unix.files.bsd + +TUPLE: bsd-file-info < unix-file-info birth-time flags gen ; + +M: bsd new-file-info ( -- class ) bsd-file-info new ; + +M: bsd stat>file-info ( stat -- file-info ) + [ call-next-method ] keep + { + [ stat-st_flags >>flags ] + [ stat-st_gen >>gen ] + [ stat-st_birthtimespec timespec>unix-time >>birth-time ] + } cleave ; diff --git a/basis/io/unix/files/bsd/tags.txt b/basis/io/unix/files/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/io/unix/files/bsd/tags.txt @@ -0,0 +1 @@ +unportable From 7c05a777baf2b152185ce6289c9c1570d5429c2c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 7 Oct 2008 01:27:18 -0500 Subject: [PATCH 205/244] Add unportable tag and other meta-data to core-foundation subvocabs --- basis/core-foundation/run-loop/authors.txt | 1 + basis/core-foundation/run-loop/summary.txt | 1 + basis/core-foundation/run-loop/thread/authors.txt | 1 + basis/core-foundation/run-loop/thread/summary.txt | 1 + basis/core-foundation/run-loop/thread/tags.txt | 1 + 5 files changed, 5 insertions(+) create mode 100644 basis/core-foundation/run-loop/authors.txt create mode 100644 basis/core-foundation/run-loop/summary.txt create mode 100644 basis/core-foundation/run-loop/thread/authors.txt create mode 100644 basis/core-foundation/run-loop/thread/summary.txt create mode 100644 basis/core-foundation/run-loop/thread/tags.txt diff --git a/basis/core-foundation/run-loop/authors.txt b/basis/core-foundation/run-loop/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/core-foundation/run-loop/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/core-foundation/run-loop/summary.txt b/basis/core-foundation/run-loop/summary.txt new file mode 100644 index 0000000000..ae92138528 --- /dev/null +++ b/basis/core-foundation/run-loop/summary.txt @@ -0,0 +1 @@ +CoreFoundation run loop integration diff --git a/basis/core-foundation/run-loop/thread/authors.txt b/basis/core-foundation/run-loop/thread/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/basis/core-foundation/run-loop/thread/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/basis/core-foundation/run-loop/thread/summary.txt b/basis/core-foundation/run-loop/thread/summary.txt new file mode 100644 index 0000000000..e5818b3d78 --- /dev/null +++ b/basis/core-foundation/run-loop/thread/summary.txt @@ -0,0 +1 @@ +Vocabulary with init hook for running CoreFoundation event loop diff --git a/basis/core-foundation/run-loop/thread/tags.txt b/basis/core-foundation/run-loop/thread/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/core-foundation/run-loop/thread/tags.txt @@ -0,0 +1 @@ +unportable From bc5f19b919a9d13aa3434dfb54296a80aac8d2df Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 07:24:10 -0500 Subject: [PATCH 206/244] fix typo --- basis/db/db-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 0acd1f0245..16a8228fca 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -172,7 +172,7 @@ HELP: sql-row-typed HELP: with-db { $values { "db" db } { "quot" quotation } } -{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. The database called is based on the " { $snippet "class" } " with the " } ; +{ $description "Calls the quotation with a database bound to the " { $link db } " symbol. See " { $link "db-custom-database-combinators" } " for help setting up database access." } ; HELP: with-transaction { $values From d656509e24b82612ff1edc12d09657e0c510723e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 07:43:49 -0500 Subject: [PATCH 207/244] fix mac stat --- basis/unix/stat/macosx/macosx.factor | 2 +- basis/unix/stat/stat.factor | 44 ++++++++------------------- basis/unix/types/macosx/macosx.factor | 1 + 3 files changed, 14 insertions(+), 33 deletions(-) diff --git a/basis/unix/stat/macosx/macosx.factor b/basis/unix/stat/macosx/macosx.factor index 65e02b7986..b2574b474d 100644 --- a/basis/unix/stat/macosx/macosx.factor +++ b/basis/unix/stat/macosx/macosx.factor @@ -8,7 +8,7 @@ C-STRUCT: stat { "dev_t" "st_dev" } { "mode_t" "st_mode" } { "nlink_t" "st_nlink" } - { "ino_t" "st_ino" } + { "ino64_t" "st_ino" } { "uid_t" "st_uid" } { "gid_t" "st_gid" } { "dev_t" "st_rdev" } diff --git a/basis/unix/stat/stat.factor b/basis/unix/stat/stat.factor index 2bc60105b4..062ad7e1bb 100644 --- a/basis/unix/stat/stat.factor +++ b/basis/unix/stat/stat.factor @@ -1,12 +1,8 @@ - USING: kernel system combinators alien.syntax alien.c-types - math io.unix.backend vocabs.loader unix ; - +math io.unix.backend vocabs.loader unix ; IN: unix.stat -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! File Types -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : S_IFMT OCT: 170000 ; ! These bits determine file type. @@ -18,54 +14,38 @@ IN: unix.stat : S_IFLNK OCT: 120000 ; inline ! Symbolic link. : S_IFSOCK OCT: 140000 ; inline ! Socket. -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! File Access Permissions -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Read, write, execute/search by owner -: S_IRWXU OCT: 0000700 ; inline ! rwx mask owner +: S_ISUID OCT: 0004000 ; inline +: S_ISGID OCT: 0002000 ; inline +: S_ISVTX OCT: 0001000 ; inline : S_IRUSR OCT: 0000400 ; inline ! r owner : S_IWUSR OCT: 0000200 ; inline ! w owner : S_IXUSR OCT: 0000100 ; inline ! x owner -! Read, write, execute/search by group -: S_IRWXG OCT: 0000070 ; inline ! rwx mask group : S_IRGRP OCT: 0000040 ; inline ! r group : S_IWGRP OCT: 0000020 ; inline ! w group : S_IXGRP OCT: 0000010 ; inline ! x group -! Read, write, execute/search by others -: S_IRWXO OCT: 0000007 ; inline ! rwx mask other : S_IROTH OCT: 0000004 ; inline ! r other : S_IWOTH OCT: 0000002 ; inline ! w other : S_IXOTH OCT: 0000001 ; inline ! x other -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - FUNCTION: int chmod ( char* path, mode_t mode ) ; - FUNCTION: int fchmod ( int fd, mode_t mode ) ; - FUNCTION: int mkdir ( char* path, mode_t mode ) ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -<< - os - { +<< os { { linux [ "unix.stat.linux" require ] } { macosx [ "unix.stat.macosx" require ] } { freebsd [ "unix.stat.freebsd" require ] } { netbsd [ "unix.stat.netbsd" require ] } { openbsd [ "unix.stat.openbsd" require ] } - } - case ->> -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +} case >> : file-status ( pathname -- stat ) - "stat" dup >r - [ stat ] unix-system-call drop - r> ; + "stat" [ + [ stat ] unix-system-call drop + ] keep ; : link-status ( pathname -- stat ) - "stat" dup >r - [ lstat ] unix-system-call drop - r> ; + "stat" [ + [ lstat ] unix-system-call drop + ] keep ; diff --git a/basis/unix/types/macosx/macosx.factor b/basis/unix/types/macosx/macosx.factor index 8f9c5082df..156e756641 100644 --- a/basis/unix/types/macosx/macosx.factor +++ b/basis/unix/types/macosx/macosx.factor @@ -22,6 +22,7 @@ TYPEDEF: __uint32_t uid_t TYPEDEF: __uint32_t gid_t TYPEDEF: __int64_t off_t TYPEDEF: __int64_t blkcnt_t +TYPEDEF: __int64_t ino64_t TYPEDEF: __int32_t blksize_t TYPEDEF: long ssize_t TYPEDEF: __int32_t pid_t From 5cc44e8ad84dd1fc4b0459816e1ec443566e32f7 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 13:15:29 -0500 Subject: [PATCH 208/244] move passwd struct from macosx to bsd --- basis/unix/bsd/bsd.factor | 13 +++++++++++++ basis/unix/bsd/macosx/macosx.factor | 13 ------------- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/basis/unix/bsd/bsd.factor b/basis/unix/bsd/bsd.factor index 6934d5b8dc..7bbf2b4fdf 100644 --- a/basis/unix/bsd/bsd.factor +++ b/basis/unix/bsd/bsd.factor @@ -48,6 +48,19 @@ C-STRUCT: sockaddr-un { "uchar" "family" } { { "char" 104 } "path" } ; +C-STRUCT: passwd + { "char*" "pw_name" } + { "char*" "pw_passwd" } + { "uid_t" "pw_uid" } + { "gid_t" "pw_gid" } + { "time_t" "pw_change" } + { "char*" "pw_class" } + { "char*" "pw_gecos" } + { "char*" "pw_dir" } + { "char*" "pw_shell" } + { "time_t" "pw_expire" } + { "int" "pw_fields" } ; + : max-un-path 104 ; inline : SOCK_STREAM 1 ; inline diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index 6582d29687..9b4dd1c53b 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -13,19 +13,6 @@ C-STRUCT: addrinfo { "void*" "addr" } { "addrinfo*" "next" } ; -C-STRUCT: passwd - { "char*" "pw_name" } - { "char*" "pw_passwd" } - { "uid_t" "pw_uid" } - { "gid_t" "pw_gid" } - { "time_t" "pw_change" } - { "char*" "pw_class" } - { "char*" "pw_gecos" } - { "char*" "pw_dir" } - { "char*" "pw_shell" } - { "time_t" "pw_expire" } - { "int" "pw_fields" } ; - : EPERM 1 ; inline : ENOENT 2 ; inline : ESRCH 3 ; inline From 9e807a88c6ce3b461b71cdabbd81fb514325233e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 13:16:18 -0500 Subject: [PATCH 209/244] ffi work --- basis/unix/unix.factor | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index a68274f09b..facfa4b9d4 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -9,6 +9,7 @@ IN: unix TYPEDEF: uint in_addr_t TYPEDEF: uint socklen_t +TYPEDEF: int int32_t : PROT_NONE 0 ; inline : PROT_READ 1 ; inline @@ -78,6 +79,8 @@ MACRO:: unix-system-call ( quot -- ) FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ; FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ; FUNCTION: int chdir ( char* path ) ; +FUNCTION: int chmod ( char* path, mode_t mode ) ; +FUNCTION: int fchmod ( int fd, mode_t mode ) ; FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ; FUNCTION: int chroot ( char* path ) ; @@ -91,6 +94,7 @@ FUNCTION: int dup2 ( int oldd, int newd ) ; : _exit ( status -- * ) #! We throw to give this a terminating stack effect. "int" f "_exit" { "int" } alien-invoke "Exit failed" throw ; +FUNCTION: void endpwent ( ) ; FUNCTION: int fchdir ( int fd ) ; FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ; FUNCTION: int fcntl ( int fd, int cmd, int arg ) ; @@ -108,6 +112,8 @@ FUNCTION: gid_t getgid ; FUNCTION: int getgrgid_r ( gid_t gid, group* grp, char* buffer, size_t bufsize, group** result ) ; FUNCTION: int getgrnam_r ( char* name, group* grp, char* buffer, size_t bufsize, group** result ) ; FUNCTION: passwd* getpwent ( ) ; +FUNCTION: passwd* getpwuid ( uid_t uid ) ; +FUNCTION: passwd* getpwnam ( char* login ) ; FUNCTION: int getpwnam_r ( char* login, passwd* pwd, char* buffer, size_t bufsize, passwd** result ) ; FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ; FUNCTION: int getgrouplist ( char* name, int basegid, int* groups, int* ngroups ) ; From 6a5dd26c52ff727b72a1dde8d9558bc9ea7e493c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 7 Oct 2008 16:13:29 -0500 Subject: [PATCH 210/244] Working on new codegen again --- unfinished/compiler/alien/alien.factor | 21 +-------- unfinished/compiler/backend/backend.factor | 5 +-- .../compiler/cfg/builder/builder.factor | 44 ++++++++++++++----- unfinished/compiler/cfg/cfg.factor | 2 +- .../cfg/instructions/instructions.factor | 18 +++++--- .../cfg/stack-frame/stack-frame.factor | 38 +++++++++------- unfinished/compiler/cfg/stacks/stacks.factor | 2 +- .../compiler/cfg/templates/templates.factor | 11 ++--- unfinished/compiler/codegen/codegen.factor | 17 ++++--- 9 files changed, 86 insertions(+), 72 deletions(-) diff --git a/unfinished/compiler/alien/alien.factor b/unfinished/compiler/alien/alien.factor index 1d63a06057..e414d6e29b 100644 --- a/unfinished/compiler/alien/alien.factor +++ b/unfinished/compiler/alien/alien.factor @@ -1,15 +1,11 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel namespaces make math sequences layouts -alien.c-types alien.structs compiler.backend ; +alien.c-types alien.structs cpu.architecture ; IN: compiler.alien -! Common utilities - : large-struct? ( ctype -- ? ) - dup c-struct? [ - heap-size struct-small-enough? not - ] [ drop f ] if ; + dup c-struct? [ struct-small-enough? not ] [ drop f ] if ; : alien-parameters ( params -- seq ) dup parameters>> @@ -31,16 +27,3 @@ IN: compiler.alien [ parameter-align drop dup , ] keep stack-size + ] reduce cell align ] { } make ; - -: return-size ( ctype -- n ) - #! Amount of space we reserve for a return value. - dup large-struct? [ heap-size ] [ drop 0 ] if ; - -: alien-stack-frame ( params -- n ) - alien-parameters parameter-sizes drop ; - -: alien-invoke-frame ( params -- n ) - #! One cell is temporary storage, temp@ - dup return>> return-size - swap alien-stack-frame + - cell + ; diff --git a/unfinished/compiler/backend/backend.factor b/unfinished/compiler/backend/backend.factor index 2efd22610e..2a516c6ec4 100644 --- a/unfinished/compiler/backend/backend.factor +++ b/unfinished/compiler/backend/backend.factor @@ -33,10 +33,7 @@ GENERIC# load-literal 1 ( obj reg -- ) HOOK: load-indirect cpu ( obj reg -- ) -HOOK: stack-frame cpu ( frame-size -- n ) - -: stack-frame* ( -- n ) - \ stack-frame get stack-frame ; +HOOK: stack-frame-size cpu ( frame-size -- n ) ! Set up caller stack frame HOOK: %prologue cpu ( n -- ) diff --git a/unfinished/compiler/cfg/builder/builder.factor b/unfinished/compiler/cfg/builder/builder.factor index ff1ddd9747..c8add3ca09 100755 --- a/unfinished/compiler/cfg/builder/builder.factor +++ b/unfinished/compiler/cfg/builder/builder.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs combinators hashtables kernel math fry namespaces make sequences words byte-arrays -locals layouts +locals layouts alien.c-types alien.structs stack-checker.inlining compiler.intrinsics compiler.tree @@ -107,7 +107,7 @@ SYMBOL: +if-intrinsics+ : emit-call ( word -- next ) finalize-phantoms { - { [ tail-call? not ] [ 0 ##frame-required ##call iterate-next ] } + { [ tail-call? not ] [ ##simple-stack-frame ##call iterate-next ] } { [ dup loops get key? ] [ loops get at local-recursive-call ] } [ ##epilogue ##jump stop-iterating ] } cond ; @@ -235,7 +235,7 @@ M: #dispatch emit-node (write-barrier) } [ t "intrinsic" set-word-prop ] each -: allot-size ( #call -- n ) +: allot-size ( -- n ) 1 phantom-datastack get phantom-input first value>> ; :: emit-allot ( size type tag -- ) @@ -306,21 +306,41 @@ M: #return-recursive emit-node M: #terminate emit-node drop stop-iterating ; ! FFI +: return-size ( ctype -- n ) + #! Amount of space we reserve for a return value. + { + { [ dup c-struct? not ] [ drop 0 ] } + { [ dup large-struct? not ] [ drop 2 cells ] } + [ heap-size ] + } cond ; + +: ( params -- stack-frame ) + stack-frame new + swap + [ return>> return-size >>return ] + [ alien-parameters parameter-sizes drop >>params ] bi + dup [ params>> ] [ return>> ] bi + >>size ; + +: alien-stack-frame ( node -- ) + params>> ##stack-frame ; + +: emit-alien-node ( node quot -- next ) + [ drop alien-stack-frame ] + [ [ params>> ] dip call ] 2bi + iterate-next ; inline + M: #alien-invoke emit-node - params>> - [ alien-invoke-frame ##frame-required ] - [ ##alien-invoke iterate-next ] - bi ; + [ ##alien-invoke ] emit-alien-node ; M: #alien-indirect emit-node - params>> - [ alien-invoke-frame ##frame-required ] - [ ##alien-indirect iterate-next ] - bi ; + [ ##alien-indirect ] emit-alien-node ; M: #alien-callback emit-node params>> dup xt>> dup - [ init-phantoms ##alien-callback ] with-cfg-builder + [ + init-phantoms + [ ##alien-callback ] emit-alien-node drop + ] with-cfg-builder iterate-next ; ! No-op nodes diff --git a/unfinished/compiler/cfg/cfg.factor b/unfinished/compiler/cfg/cfg.factor index 140d406c4c..e32ad47890 100644 --- a/unfinished/compiler/cfg/cfg.factor +++ b/unfinished/compiler/cfg/cfg.factor @@ -19,7 +19,7 @@ successors ; V{ } clone >>instructions V{ } clone >>successors ; -TUPLE: mr instructions word label frame-size spill-counts ; +TUPLE: mr instructions word label ; : ( instructions word label -- mr ) mr new diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor index 9bb576dcb3..3014587edd 100644 --- a/unfinished/compiler/cfg/instructions/instructions.factor +++ b/unfinished/compiler/cfg/instructions/instructions.factor @@ -17,12 +17,19 @@ INSN: ##replace src loc ; INSN: ##inc-d n ; INSN: ##inc-r n ; -! Calling convention -INSN: ##return ; - ! Subroutine calls +TUPLE: stack-frame +{ size integer } +{ params integer } +{ return integer } +{ total-size integer } ; + +INSN: ##stack-frame stack-frame ; + : ##simple-stack-frame ( -- ) T{ stack-frame } ##stack-frame ; INSN: ##call word ; INSN: ##jump word ; +INSN: ##return ; + INSN: ##intrinsic quot defs-vregs uses-vregs ; ! Jump tables @@ -87,7 +94,6 @@ M: ##intrinsic uses-vregs intrinsic-uses-vregs ; ! Instructions used by CFG IR only. INSN: ##prologue ; INSN: ##epilogue ; -INSN: ##frame-required n ; INSN: ##branch ; INSN: ##branch-f < ##cond-branch ; @@ -100,8 +106,8 @@ M: ##if-intrinsic defs-vregs intrinsic-defs-vregs ; M: ##if-intrinsic uses-vregs intrinsic-uses-vregs ; ! Instructions used by machine IR only. -INSN: _prologue ; -INSN: _epilogue ; +INSN: _prologue stack-frame ; +INSN: _epilogue stack-frame ; INSN: _label id ; diff --git a/unfinished/compiler/cfg/stack-frame/stack-frame.factor b/unfinished/compiler/cfg/stack-frame/stack-frame.factor index 56282cfb09..6ec34d37c2 100644 --- a/unfinished/compiler/cfg/stack-frame/stack-frame.factor +++ b/unfinished/compiler/cfg/stack-frame/stack-frame.factor @@ -7,40 +7,47 @@ IN: compiler.cfg.stack-frame SYMBOL: frame-required? -SYMBOL: frame-size - SYMBOL: spill-counts : init-stack-frame-builder ( -- ) frame-required? off - 0 frame-size set ; + T{ stack-frame } clone stack-frame set ; -GENERIC: compute-frame-size* ( insn -- ) +GENERIC: compute-stack-frame* ( insn -- ) -M: ##frame-required compute-frame-size* +: max-stack-frame ( frame1 frame2 -- frame3 ) + { + [ [ size>> ] bi@ max ] + [ [ params>> ] bi@ max ] + [ [ return>> ] bi@ max ] + [ [ total-size>> ] bi@ max ] + } cleave + stack-frame boa ; + +M: ##stack-frame compute-stack-frame* frame-required? on - n>> frame-size [ max ] change ; + stack-frame>> stack-frame [ max-stack-frame ] change ; -M: _spill-integer compute-frame-size* +M: _spill-integer compute-stack-frame* drop frame-required? on ; -M: _spill-float compute-frame-size* +M: _spill-float compute-stack-frame* drop frame-required? on ; -M: insn compute-frame-size* drop ; +M: insn compute-stack-frame* drop ; -: compute-frame-size ( insns -- ) - [ compute-frame-size* ] each ; +: compute-stack-frame ( insns -- ) + [ compute-stack-frame* ] each ; GENERIC: insert-pro/epilogues* ( insn -- ) -M: ##frame-required insert-pro/epilogues* drop ; +M: ##stack-frame insert-pro/epilogues* drop ; M: ##prologue insert-pro/epilogues* - drop frame-required? get [ _prologue ] when ; + drop frame-required? get [ stack-frame get _prologue ] when ; M: ##epilogue insert-pro/epilogues* - drop frame-required? get [ _epilogue ] when ; + drop frame-required? get [ stack-frame get _epilogue ] when ; M: insn insert-pro/epilogues* , ; @@ -51,9 +58,8 @@ M: insn insert-pro/epilogues* , ; [ init-stack-frame-builder [ - [ compute-frame-size ] + [ compute-stack-frame ] [ insert-pro/epilogues ] bi ] change-instructions - frame-size get >>frame-size ] with-scope ; diff --git a/unfinished/compiler/cfg/stacks/stacks.factor b/unfinished/compiler/cfg/stacks/stacks.factor index 39cd942bb2..56be18c107 100755 --- a/unfinished/compiler/cfg/stacks/stacks.factor +++ b/unfinished/compiler/cfg/stacks/stacks.factor @@ -312,7 +312,7 @@ M: loc lazy-store finalize-contents finalize-heights fresh-objects get [ - empty? [ 0 ##frame-required ##gc ] unless + empty? [ ##simple-stack-frame ##gc ] unless ] [ delete-all ] bi ; : init-phantoms ( -- ) diff --git a/unfinished/compiler/cfg/templates/templates.factor b/unfinished/compiler/cfg/templates/templates.factor index 12a56704d0..72e092ad68 100644 --- a/unfinished/compiler/cfg/templates/templates.factor +++ b/unfinished/compiler/cfg/templates/templates.factor @@ -28,13 +28,10 @@ TUPLE: template input output scratch clobber gc ; : lazy-load ( specs -- seq ) [ length phantom-datastack get phantom-input ] keep - [ drop ] [ - [ - 2dup second clobbered? - [ first (eager-load) ] [ first (lazy-load) ] if - ] 2map - ] 2bi - [ substitute-vregs ] keep ; + [ + 2dup second clobbered? + [ first (eager-load) ] [ first (lazy-load) ] if + ] 2map ; : load-inputs ( template -- assoc ) [ diff --git a/unfinished/compiler/codegen/codegen.factor b/unfinished/compiler/codegen/codegen.factor index 15ebd691bf..fe6b45e88a 100644 --- a/unfinished/compiler/codegen/codegen.factor +++ b/unfinished/compiler/codegen/codegen.factor @@ -10,7 +10,8 @@ compiler.backend compiler.codegen.fixup compiler.cfg compiler.cfg.instructions -compiler.cfg.registers ; +compiler.cfg.registers +compiler.cfg.builder ; IN: compiler.codegen GENERIC: generate-insn ( insn -- ) @@ -71,10 +72,14 @@ M: _label generate-insn id>> lookup-label , ; M: _prologue generate-insn - drop %prologue ; + stack-frame>> + [ stack-frame set ] + [ dup size>> stack-frame-size >>total-size drop ] + [ total-size>> %prologue ] + tri ; M: _epilogue generate-insn - drop %epilogue ; + stack-frame>> total-size>> %epilogue ; M: ##load-literal generate-insn [ obj>> ] [ dst>> v>operand ] bi load-literal ; @@ -276,8 +281,8 @@ M: long-long-type flatten-value-type ( type -- types ) #! parameters. If the C function is returning a structure, #! the first parameter is an implicit target area pointer, #! so we need to use a different offset. - return>> dup large-struct? - [ heap-size %prepare-box-struct cell ] [ drop 0 ] if ; + return>> large-struct? + [ %prepare-box-struct cell ] [ 0 ] if ; : objects>registers ( params -- ) #! Generate code for unboxing a list of C types, then @@ -413,7 +418,7 @@ TUPLE: callback-context ; : callback-unwind ( params -- n ) { - { [ dup abi>> "stdcall" = ] [ alien-stack-frame ] } + { [ dup abi>> "stdcall" = ] [ size>> ] } { [ dup return>> large-struct? ] [ drop 4 ] } [ drop 0 ] } cond ; From a10fd92a33df1c2a17ec5a5414114f225679dc8c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 17:18:49 -0500 Subject: [PATCH 211/244] fix lambda-macro reset-word bug --- basis/locals/locals.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 05ea3cb524..bbcc8a6745 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -421,7 +421,7 @@ M: lambda-macro definition "lambda" word-prop body>> ; M: lambda-macro reset-word - [ f "lambda" set-word-prop ] [ call-next-method ] bi ; + [ call-next-method ] [ f "lambda" set-word-prop ] bi ; INTERSECTION: lambda-method method-body lambda-word ; From 9940031cda88a6a872f3842f31afb7128b6c873a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 17:47:20 -0500 Subject: [PATCH 212/244] removed dead code in unmaintained/io --- unmaintained/io/io.factor | 8 -- unmaintained/io/os-unix.factor | 213 --------------------------------- 2 files changed, 221 deletions(-) delete mode 100644 unmaintained/io/io.factor diff --git a/unmaintained/io/io.factor b/unmaintained/io/io.factor deleted file mode 100644 index 24151d96c6..0000000000 --- a/unmaintained/io/io.factor +++ /dev/null @@ -1,8 +0,0 @@ -USING: calendar io io-internals kernel math namespaces -nonblocking-io prettyprint quotations sequences ; -IN: libs-io - -: bit-set? ( m n -- ? ) [ bitand ] keep = ; -: set-bit ( m bit -- n ) bitor ; -: clear-bit ( m bit -- n ) bitnot bitand ; - diff --git a/unmaintained/io/os-unix.factor b/unmaintained/io/os-unix.factor index 7ae47cda3d..280908b406 100644 --- a/unmaintained/io/os-unix.factor +++ b/unmaintained/io/os-unix.factor @@ -11,219 +11,6 @@ IN: libs-io : SEEK_END 2 ; inline : EEXIST 17 ; inline -FUNCTION: off_t lseek ( int fildes, off_t offset, int whence ) ; -: append-mode - O_WRONLY O_APPEND O_CREAT bitor bitor ; foldable - -: open-append ( path -- fd ) - append-mode file-mode open dup io-error - [ 0 SEEK_END lseek io-error ] keep ; - -: touch-mode - O_WRONLY O_APPEND O_CREAT O_EXCL bitor bitor bitor ; foldable - -: open-touch ( path -- fd ) - touch-mode file-mode open - [ io-error close t ] - [ 2drop err_no EEXIST = [ err_no io-error ] unless -1 ] recover ; - -: ( path -- stream ) open-append ; - -FUNCTION: int unlink ( char* path ) ; -: delete-file ( path -- ) - unlink io-error ; - -FUNCTION: int mkdir ( char* path, mode_t mode ) ; - -: (create-directory) ( path mode -- ) - mkdir io-error ; - -: create-directory ( path -- ) - 0 (create-directory) ; - -FUNCTION: int rmdir ( char* path ) ; - -: delete-directory ( path -- ) - rmdir io-error ; - -FUNCTION: int chroot ( char* path ) ; -FUNCTION: int chdir ( char* path ) ; -FUNCTION: int fchdir ( int fd ) ; - -FUNCTION: int utimes ( char* path, timeval[2] times ) ; -FUNCTION: int futimes ( int id, timeval[2] times ) ; - -TYPEDEF: longlong blkcnt_t -TYPEDEF: int blksize_t -TYPEDEF: int dev_t -TYPEDEF: uint ino_t -TYPEDEF: ushort mode_t -TYPEDEF: ushort nlink_t -TYPEDEF: uint uid_t -TYPEDEF: uint gid_t -TYPEDEF: longlong quad_t -TYPEDEF: ulong u_long - -FUNCTION: int stat ( char* path, stat* sb ) ; - -C-STRUCT: stat - { "dev_t" "dev" } ! device inode resides on - { "ino_t" "ino" } ! inode's number - { "mode_t" "mode" } ! inode protection mode - { "nlink_t" "nlink" } ! number or hard links to the file - { "uid_t" "uid" } ! user-id of owner - { "gid_t" "gid" } ! group-id of owner - { "dev_t" "rdev" } ! device type, for special file inode - { "timespec" "atime" } ! time of last access - { "timespec" "mtime" } ! time of last data modification - { "timespec" "ctime" } ! time of last file status change - { "off_t" "size" } ! file size, in bytes - { "blkcnt_t" "blocks" } ! blocks allocated for file - { "blksize_t" "blksize" } ! optimal file sys I/O ops blocksize - { "u_long" "flags" } ! user defined flags for file - { "u_long" "gen" } ; ! file generation number - -: stat* ( path -- byte-array ) - "stat" [ stat io-error ] keep ; - -: make-timeval-array ( array -- byte-array ) - [ length "timeval" ] keep - dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ; - -: (set-file-times) ( timestamp timestamp -- alien ) - [ [ timestamp>timeval ] [ f ] if* ] 2apply 2array - make-timeval-array ; - -: set-file-times ( path timestamp timestamp -- ) - #! set access, write - (set-file-times) utimes io-error ; - -: set-file-times* ( fd timestamp timestamp -- ) - (set-file-times) futimes io-error ; - - -: set-file-access-time ( path timestamp -- ) - f set-file-times ; - -: set-file-write-time ( path timestamp -- ) - >r f r> set-file-times ; - - -: file-write-time ( path -- timestamp ) - stat* stat-mtime timespec>timestamp ; - -: file-access-time ( path -- timestamp ) - stat* stat-atime timespec>timestamp ; - -! File type -: S_IFMT OCT: 0170000 ; inline ! type of file -: S_IFIFO OCT: 0010000 ; inline ! named pipe (fifo) -: S_IFCHR OCT: 0020000 ; inline ! character special -: S_IFDIR OCT: 0040000 ; inline ! directory -: S_IFBLK OCT: 0060000 ; inline ! block special -: S_IFREG OCT: 0100000 ; inline ! regular -: S_IFLNK OCT: 0120000 ; inline ! symbolic link -: S_IFSOCK OCT: 0140000 ; inline ! socket -: S_IFWHT OCT: 0160000 ; inline ! whiteout -: S_IFXATTR OCT: 0200000 ; inline ! extended attribute - -! File mode -! Read, write, execute/search by owner -: S_IRWXU OCT: 0000700 ; inline ! rwx mask owner -: S_IRUSR OCT: 0000400 ; inline ! r owner -: S_IWUSR OCT: 0000200 ; inline ! w owner -: S_IXUSR OCT: 0000100 ; inline ! x owner -! Read, write, execute/search by group -: S_IRWXG OCT: 0000070 ; inline ! rwx mask group -: S_IRGRP OCT: 0000040 ; inline ! r group -: S_IWGRP OCT: 0000020 ; inline ! w group -: S_IXGRP OCT: 0000010 ; inline ! x group -! Read, write, execute/search by others -: S_IRWXO OCT: 0000007 ; inline ! rwx mask other -: S_IROTH OCT: 0000004 ; inline ! r other -: S_IWOTH OCT: 0000002 ; inline ! w other -: S_IXOTH OCT: 0000001 ; inline ! x other - -: S_ISUID OCT: 0004000 ; inline ! set user id on execution -: S_ISGID OCT: 0002000 ; inline ! set group id on execution -: S_ISVTX OCT: 0001000 ; inline ! sticky bit - -FUNCTION: uid_t getuid ; -FUNCTION: uid_t geteuid ; - -FUNCTION: gid_t getgid ; -FUNCTION: gid_t getegid ; - -FUNCTION: int setuid ( uid_t uid ) ; -FUNCTION: int seteuid ( uid_t euid ) ; -FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ; - -FUNCTION: int setgid ( gid_t gid ) ; -FUNCTION: int setegid ( gid_t egid ) ; -FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ; - -FUNCTION: int issetugid ; - -FUNCTION: int chmod ( char* path, mode_t mode ) ; -FUNCTION: int fchmod ( int fd, mode_t mode ) ; - -FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ; -FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ; -#! lchown does not follow symbolic links -FUNCTION: int lchown ( char* path, uid_t owner, gid_t group ) ; - -FUNCTION: int getgroups ( int gidsetlen, gid_t* gidset ) ; -FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ; - -FUNCTION: int flock ( int fd, int operation ) ; -! FUNCTION: int dup ( int oldd ) ; -! FUNCTION: int dup2 ( int oldd, int newd ) ; - -FUNCTION: int fcntl ( int fd, int cmd, int arg ) ; -FUNCTION: int getdtablesize ; - -: file-mode? ( path mask -- ? ) - >r stat* stat-mode r> bit-set? ; - -: user-read? ( path -- ? ) S_IRUSR file-mode? ; -: user-write? ( path -- ? ) S_IWUSR file-mode? ; -: user-execute? ( path -- ? ) S_IXUSR file-mode? ; - -: group-read? ( path -- ? ) S_IRGRP file-mode? ; -: group-write? ( path -- ? ) S_IWGRP file-mode? ; -: group-execute? ( path -- ? ) S_IXGRP file-mode? ; - -: other-read? ( path -- ? ) S_IROTH file-mode? ; -: other-write? ( path -- ? ) S_IWOTH file-mode? ; -: other-execute? ( path -- ? ) S_IXOTH file-mode? ; - -: set-uid? ( path -- ? ) S_ISUID bit-set? ; -: set-gid? ( path -- ? ) S_ISGID bit-set? ; -: set-sticky? ( path -- ? ) S_ISVTX bit-set? ; - -: chmod* ( path mask ? -- ) - >r >r dup stat* stat-mode r> r> [ - set-bit - ] [ - clear-bit - ] if chmod io-error ; - -: set-user-read ( path ? -- ) >r S_IRUSR r> chmod* ; -: set-user-write ( path ? -- ) >r S_IWUSR r> chmod* ; -: set-user-execute ( path ? -- ) >r S_IXUSR r> chmod* ; - -: set-group-read ( path ? -- ) >r S_IRGRP r> chmod* ; -: set-group-write ( path ? -- ) >r S_IWGRP r> chmod* ; -: set-group-execute ( path ? -- ) >r S_IXGRP r> chmod* ; - -: set-other-read ( path ? -- ) >r S_IROTH r> chmod* ; -: set-other-write ( path ? -- ) >r S_IWOTH r> chmod* ; -: set-other-execute ( path ? -- ) >r S_IXOTH r> chmod* ; - -: set-uid ( path ? -- ) >r S_ISUID r> chmod* ; -: set-gid ( path ? -- ) >r S_ISGID r> chmod* ; -: set-sticky ( path ? -- ) >r S_ISVTX r> chmod* ; - : mode>symbol ( mode -- ch ) S_IFMT bitand { From 9228d367a14d3003d67b079b1301bb7c2d708542 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 19:23:35 -0500 Subject: [PATCH 213/244] ffi structs and typedefs --- basis/unix/bsd/macosx/macosx.factor | 15 ++++++++++ basis/unix/bsd/netbsd/netbsd.factor | 45 ++++++++++++++++++++++++++++- basis/unix/stat/stat.factor | 24 +++++++-------- basis/unix/types/types.factor | 23 +++++++++++++++ basis/unix/unix.factor | 4 --- 5 files changed, 94 insertions(+), 17 deletions(-) diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index 9b4dd1c53b..ed2bdecf61 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -117,3 +117,18 @@ C-STRUCT: addrinfo : ETIME 101 ; inline : EOPNOTSUPP 102 ; inline : ENOPOLICY 103 ; inline + +: _UTX_USERSIZE 256 ; inline +: _UTX_LINESIZE 32 ; inline +: _UTX_IDSIZE 4 ; inline +: _UTX_HOSTSIZE 256 ; inline + +C-STRUCT: utmpx + { { "char" _UTX_USERSIZE } "ut_user" } + { { "char" _UTX_IDSIZE } "ut_id" } + { { "char" _UTX_LINESIZE } "ut_line" } + { "pid_t" "ut_pid" } + { "short" "ut_type" } + { "timeval" "ut_tv" } + { { "char" _UTX_HOSTSIZE } "ut_host" } + { { "uint" 16 } "ut_pad" } ; diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/bsd/netbsd/netbsd.factor index e646f87116..6bae953938 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/bsd/netbsd/netbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax ; +USING: alien.syntax alien.c-types math ; IN: unix : FD_SETSIZE 256 ; inline @@ -111,3 +111,46 @@ C-STRUCT: addrinfo : ENOLINK 95 ; inline : EPROTO 96 ; inline : ELAST 96 ; inline + +TYPEDEF: __uint8_t sa_family_t + +: _UTX_USERSIZE 32 ; inline +: _UTX_LINESIZE 32 ; inline +: _UTX_IDSIZE 4 ; inline +: _UTX_HOSTSIZE 256 ; inline + +: _SS_MAXSIZE ( -- n ) + 128 ; inline + +: _SS_ALIGNSIZE ( -- n ) + "__int64_t" heap-size ; inline + +: _SS_PAD1SIZE ( -- n ) + _SS_ALIGNSIZE 2 - ; inline + +: _SS_PAD2SIZE ( -- n ) + _SS_MAXSIZE 2 - _SS_PAD1SIZE - _SS_ALIGNSIZE - ; inline + +C-STRUCT: sockaddr_storage + { "__uint8_t" "ss_len" } + { "sa_family_t" "ss_family" } + { { "char" _SS_PAD1SIZE } "__ss_pad1" } + { "__int64_t" "__ss_align" } + { { "char" _SS_PAD2SIZE } "__ss_pad2" } ; + +C-STRUCT: exit_struct + { "uint16_t" "e_termination" } + { "uint16_t" "e_exit" } ; + +C-STRUCT: utmpx + { { "char" _UTX_USERSIZE } "ut_user" } + { { "char" _UTX_IDSIZE } "ut_id" } + { { "char" _UTX_LINESIZE } "ut_line" } + { { "char" _UTX_HOSTSIZE } "ut_host" } + { "uint16_t" "ut_session" } + { "uint16_t" "ut_type" } + { "pid_t" "ut_pid" } + { "exit_struct" "ut_exit" } + { "sockaddr_storage" "ut_ss" } + { "timeval" "ut_tv" } + { { "uint32_t" 10 } "ut_pad" } ; diff --git a/basis/unix/stat/stat.factor b/basis/unix/stat/stat.factor index 062ad7e1bb..139f1b1983 100644 --- a/basis/unix/stat/stat.factor +++ b/basis/unix/stat/stat.factor @@ -15,18 +15,18 @@ IN: unix.stat : S_IFSOCK OCT: 140000 ; inline ! Socket. ! File Access Permissions -: S_ISUID OCT: 0004000 ; inline -: S_ISGID OCT: 0002000 ; inline -: S_ISVTX OCT: 0001000 ; inline -: S_IRUSR OCT: 0000400 ; inline ! r owner -: S_IWUSR OCT: 0000200 ; inline ! w owner -: S_IXUSR OCT: 0000100 ; inline ! x owner -: S_IRGRP OCT: 0000040 ; inline ! r group -: S_IWGRP OCT: 0000020 ; inline ! w group -: S_IXGRP OCT: 0000010 ; inline ! x group -: S_IROTH OCT: 0000004 ; inline ! r other -: S_IWOTH OCT: 0000002 ; inline ! w other -: S_IXOTH OCT: 0000001 ; inline ! x other +: UID OCT: 0004000 ; inline +: GID OCT: 0002000 ; inline +: STICKY OCT: 0001000 ; inline +: USER-READ OCT: 0000400 ; inline ! r owner +: USER-WRITE OCT: 0000200 ; inline ! w owner +: USER-EXECUTE OCT: 0000100 ; inline ! x owner +: GROUP-READ OCT: 0000040 ; inline ! r group +: GROUP-WRITE OCT: 0000020 ; inline ! w group +: GROUP-EXECUTE OCT: 0000010 ; inline ! x group +: OTHER-READ OCT: 0000004 ; inline ! r other +: OTHER-WRITE OCT: 0000002 ; inline ! w other +: OTHER-EXECUTE OCT: 0000001 ; inline ! x other FUNCTION: int chmod ( char* path, mode_t mode ) ; FUNCTION: int fchmod ( int fd, mode_t mode ) ; diff --git a/basis/unix/types/types.factor b/basis/unix/types/types.factor index 0ac2fa608e..69d07a07f1 100644 --- a/basis/unix/types/types.factor +++ b/basis/unix/types/types.factor @@ -3,6 +3,29 @@ system ; IN: unix.types TYPEDEF: void* caddr_t +TYPEDEF: uint in_addr_t +TYPEDEF: uint socklen_t + +TYPEDEF: char int8_t +TYPEDEF: short int16_t +TYPEDEF: int int32_t +TYPEDEF: longlong int64_t + +TYPEDEF: uchar uint8_t +TYPEDEF: ushort uint16_t +TYPEDEF: uint uint32_t +TYPEDEF: ulonglong uint64_t + +TYPEDEF: char __int8_t +TYPEDEF: short __int16_t +TYPEDEF: int __int32_t +TYPEDEF: longlong __int64_t + +TYPEDEF: uchar __uint8_t +TYPEDEF: ushort __uint16_t +TYPEDEF: uint __uint32_t +TYPEDEF: ulonglong __uint64_t + os { { linux [ "unix.types.linux" require ] } diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index facfa4b9d4..960115d1a6 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -7,10 +7,6 @@ stack-checker macros locals generalizations unix.types debugger io prettyprint ; IN: unix -TYPEDEF: uint in_addr_t -TYPEDEF: uint socklen_t -TYPEDEF: int int32_t - : PROT_NONE 0 ; inline : PROT_READ 1 ; inline : PROT_WRITE 2 ; inline From 5916fcea75cc23f62cd0c6868803d315cdabafe0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 19:25:05 -0500 Subject: [PATCH 214/244] initial comit of groups, users, and utmpx --- basis/unix/groups/authors.txt | 1 + basis/unix/groups/groups.factor | 123 ++++++++++++++++++++ basis/unix/groups/tags.txt | 1 + basis/unix/users/authors.txt | 1 + basis/unix/users/bsd/authors.txt | 1 + basis/unix/users/bsd/bsd.factor | 19 +++ basis/unix/users/bsd/tags.txt | 1 + basis/unix/users/tags.txt | 1 + basis/unix/users/users.factor | 114 ++++++++++++++++++ basis/unix/utmpx/authors.txt | 1 + basis/unix/utmpx/macosx/authors.txt | 1 + basis/unix/utmpx/macosx/macosx-tests.factor | 4 + basis/unix/utmpx/macosx/macosx.factor | 6 + basis/unix/utmpx/macosx/tags.txt | 1 + basis/unix/utmpx/netbsd/authors.txt | 1 + basis/unix/utmpx/netbsd/netbsd-tests.factor | 4 + basis/unix/utmpx/netbsd/netbsd.factor | 22 ++++ basis/unix/utmpx/netbsd/tags.txt | 1 + basis/unix/utmpx/tags.txt | 1 + basis/unix/utmpx/utmpx.factor | 66 +++++++++++ 20 files changed, 370 insertions(+) create mode 100644 basis/unix/groups/authors.txt create mode 100644 basis/unix/groups/groups.factor create mode 100644 basis/unix/groups/tags.txt create mode 100644 basis/unix/users/authors.txt create mode 100644 basis/unix/users/bsd/authors.txt create mode 100644 basis/unix/users/bsd/bsd.factor create mode 100644 basis/unix/users/bsd/tags.txt create mode 100644 basis/unix/users/tags.txt create mode 100644 basis/unix/users/users.factor create mode 100644 basis/unix/utmpx/authors.txt create mode 100644 basis/unix/utmpx/macosx/authors.txt create mode 100644 basis/unix/utmpx/macosx/macosx-tests.factor create mode 100644 basis/unix/utmpx/macosx/macosx.factor create mode 100644 basis/unix/utmpx/macosx/tags.txt create mode 100644 basis/unix/utmpx/netbsd/authors.txt create mode 100644 basis/unix/utmpx/netbsd/netbsd-tests.factor create mode 100644 basis/unix/utmpx/netbsd/netbsd.factor create mode 100644 basis/unix/utmpx/netbsd/tags.txt create mode 100644 basis/unix/utmpx/tags.txt create mode 100644 basis/unix/utmpx/utmpx.factor diff --git a/basis/unix/groups/authors.txt b/basis/unix/groups/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/groups/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor new file mode 100644 index 0000000000..5a33bfe072 --- /dev/null +++ b/basis/unix/groups/groups.factor @@ -0,0 +1,123 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types alien.strings io.encodings.utf8 +io.unix.backend kernel math sequences splitting unix strings +combinators.short-circuit byte-arrays combinators qualified +accessors math.parser fry assocs namespaces continuations ; +IN: unix.groups + +QUALIFIED: grouping + +TUPLE: group id name passwd members ; + +SYMBOL: group-cache + +GENERIC: group-struct ( obj -- group ) + +string + [ alien-address "char**" heap-size + ] dip + ] [ ] produce nip ; + +: (group-struct) ( id -- group-struct id group-struct byte-array length void* ) + "group" tuck 1024 + [ ] keep f ; + +M: integer group-struct ( id -- group ) + (group-struct) getgrgid_r io-error ; + +M: string group-struct ( string -- group ) + (group-struct) getgrnam_r 0 = [ (io-error) ] unless ; + +: group-struct>group ( group-struct -- group ) + [ \ group new ] dip + { + [ group-gr_name >>name ] + [ group-gr_passwd >>passwd ] + [ group-gr_gid >>id ] + [ group-members >>members ] + } cleave ; + +PRIVATE> + +: group-name ( id -- string ) + dup group-cache get [ + at + ] [ + group-struct group-gr_name + ] if* + [ nip ] [ number>string ] if* ; + +: group-id ( string -- id ) + group-struct group-gr_gid ; + +groups ( byte-array n -- groups ) + [ 4 grouping:group ] dip head-slice [ *uint group-name ] map ; + +PRIVATE> + +: user-groups ( string -- seq ) + #! first group is -1337, legacy unix code + -1337 NGROUPS_MAX [ 4 * ] keep + [ getgrouplist io-error ] 2keep + [ 4 tail-slice ] [ *int 1- ] bi* >groups ; + +: all-groups ( -- seq ) + [ getgrent dup ] [ group-struct>group ] [ drop ] produce ; + +: with-group-cache ( quot -- ) + all-groups [ [ id>> ] keep ] H{ } map>assoc + group-cache rot with-variable ; inline + +: real-group-id ( -- id ) + getgid ; inline + +: real-group-name ( -- string ) + real-group-id group-name ; inline + +: effective-group-id ( -- string ) + getegid ; inline + +: effective-group-name ( -- string ) + effective-group-id group-name ; inline + +GENERIC: set-real-group ( obj -- ) + +GENERIC: set-effective-group ( obj -- ) + +: with-real-group ( string/id quot -- ) + '[ _ set-real-group @ ] + real-group-id '[ _ set-real-group ] [ ] cleanup ; inline + +: with-effective-group ( string/id quot -- ) + '[ _ set-effective-group @ ] + effective-group-id '[ _ set-effective-group ] [ ] cleanup ; inline + + + +M: string set-real-group ( string -- ) + group-id (set-real-group) ; + +M: integer set-real-group ( id -- ) + (set-real-group) ; + +M: integer set-effective-group ( id -- ) + (set-effective-group) ; + +M: string set-effective-group ( string -- ) + group-id (set-effective-group) ; diff --git a/basis/unix/groups/tags.txt b/basis/unix/groups/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/groups/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/users/authors.txt b/basis/unix/users/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/users/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/users/bsd/authors.txt b/basis/unix/users/bsd/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/users/bsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/users/bsd/bsd.factor b/basis/unix/users/bsd/bsd.factor new file mode 100644 index 0000000000..b3778ced70 --- /dev/null +++ b/basis/unix/users/bsd/bsd.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: combinators accessors kernel unix unix.users +system ; +IN: unix.users.bsd + +TUPLE: bsd-passwd < passwd change class expire fields ; + +M: bsd new-passwd ( -- bsd-passwd ) bsd-passwd new ; + +M: bsd passwd>new-passwd ( passwd -- bsd-passwd ) + [ call-next-method ] keep + { + [ passwd-pw_change >>change ] + [ passwd-pw_class >>class ] + [ passwd-pw_shell >>shell ] + [ passwd-pw_expire >>expire ] + [ passwd-pw_fields >>fields ] + } cleave ; diff --git a/basis/unix/users/bsd/tags.txt b/basis/unix/users/bsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/users/bsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/users/tags.txt b/basis/unix/users/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/users/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor new file mode 100644 index 0000000000..184312e0ce --- /dev/null +++ b/basis/unix/users/users.factor @@ -0,0 +1,114 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types alien.strings io.encodings.utf8 +io.unix.backend kernel math sequences splitting unix strings +combinators.short-circuit grouping byte-arrays combinators +accessors math.parser fry assocs namespaces continuations +vocabs.loader system ; +IN: unix.users + +TUPLE: passwd username password uid gid gecos dir shell ; + +HOOK: new-passwd os ( -- passwd ) +HOOK: passwd>new-passwd os ( passwd -- new-passwd ) + +new-passwd ( passwd -- seq ) + [ new-passwd ] dip + { + [ passwd-pw_name >>username ] + [ passwd-pw_passwd >>password ] + [ passwd-pw_uid >>uid ] + [ passwd-pw_gid >>gid ] + [ passwd-pw_gecos >>gecos ] + [ passwd-pw_dir >>dir ] + [ passwd-pw_shell >>shell ] + } cleave ; + +: with-pwent ( quot -- ) + [ endpwent ] [ ] cleanup ; inline + +PRIVATE> + +: all-users ( -- seq ) + [ + [ getpwent dup ] [ passwd>new-passwd ] [ drop ] produce + ] with-pwent ; + +SYMBOL: passwd-cache + +: with-passwd-cache ( quot -- ) + all-users [ [ uid>> ] keep ] H{ } map>assoc + passwd-cache swap with-variable ; inline + +GENERIC: user-passwd ( obj -- passwd ) + +M: integer user-passwd ( id -- passwd/f ) + passwd-cache get + [ at ] [ getpwuid passwd>new-passwd ] if* ; + +M: string user-passwd ( string -- passwd/f ) + getpwnam dup [ passwd>new-passwd ] when ; + +: username ( id -- string ) + user-passwd username>> ; + +: username-id ( string -- id ) + user-passwd username>> ; + +: real-username-id ( -- string ) + getuid ; inline + +: real-username ( -- string ) + real-username-id username ; inline + +: effective-username-id ( -- string ) + geteuid username ; inline + +: effective-username ( -- string ) + effective-username-id username ; inline + +GENERIC: set-real-username ( string/id -- ) + +GENERIC: set-effective-username ( string/id -- ) + +: with-real-username ( string/id quot -- ) + '[ _ set-real-username @ ] + real-username-id '[ _ set-real-username ] + [ ] cleanup ; inline + +: with-effective-username ( string/id quot -- ) + '[ _ set-effective-username @ ] + effective-username-id '[ _ set-effective-username ] + [ ] cleanup ; inline + + + +M: string set-real-username ( string -- ) + username-id (set-real-username) ; + +M: integer set-real-username ( id -- ) + (set-real-username) ; + +M: integer set-effective-username ( id -- ) + (set-effective-username) ; + +M: string set-effective-username ( string -- ) + username-id (set-effective-username) ; + +os { + { [ dup bsd? ] [ drop "unix.users.bsd" require ] } + { [ dup linux? ] [ drop ] } +} cond diff --git a/basis/unix/utmpx/authors.txt b/basis/unix/utmpx/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/basis/unix/utmpx/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/basis/unix/utmpx/macosx/authors.txt b/basis/unix/utmpx/macosx/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/utmpx/macosx/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/utmpx/macosx/macosx-tests.factor b/basis/unix/utmpx/macosx/macosx-tests.factor new file mode 100644 index 0000000000..b0aa97dbca --- /dev/null +++ b/basis/unix/utmpx/macosx/macosx-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.utmpx.macosx ; +IN: unix.utmpx.macosx.tests diff --git a/basis/unix/utmpx/macosx/macosx.factor b/basis/unix/utmpx/macosx/macosx.factor new file mode 100644 index 0000000000..92a0d9e3a4 --- /dev/null +++ b/basis/unix/utmpx/macosx/macosx.factor @@ -0,0 +1,6 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax unix.bsd.macosx ; +IN: unix.utmpx.macosx + +! empty diff --git a/basis/unix/utmpx/macosx/tags.txt b/basis/unix/utmpx/macosx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/utmpx/macosx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/utmpx/netbsd/authors.txt b/basis/unix/utmpx/netbsd/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/unix/utmpx/netbsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/unix/utmpx/netbsd/netbsd-tests.factor b/basis/unix/utmpx/netbsd/netbsd-tests.factor new file mode 100644 index 0000000000..5bd0e4622f --- /dev/null +++ b/basis/unix/utmpx/netbsd/netbsd-tests.factor @@ -0,0 +1,4 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.utmpx.netbsd ; +IN: unix.utmpx.netbsd.tests diff --git a/basis/unix/utmpx/netbsd/netbsd.factor b/basis/unix/utmpx/netbsd/netbsd.factor new file mode 100644 index 0000000000..40fce746b1 --- /dev/null +++ b/basis/unix/utmpx/netbsd/netbsd.factor @@ -0,0 +1,22 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax unix.utmpx unix.bsd.netbsd accessors +unix.utmpx system kernel unix combinators ; +IN: unix.utmpx.netbsd + +TUPLE: netbsd-utmpx-record < utmpx-record termination exit +sockaddr ; + +M: netbsd new-utmpx-record ( -- utmpx-record ) + netbsd-utmpx-record new ; + +M: netbsd utmpx>utmpx-record ( utmpx -- record ) + [ new-utmpx-record ] keep + { + [ + utmpx-ut_exit + [ exit_struct-e_termination >>termination ] + [ exit_struct-e_exit >>exit ] bi + ] + [ utmpx-ut_ss >>sockaddr ] + } cleave ; diff --git a/basis/unix/utmpx/netbsd/tags.txt b/basis/unix/utmpx/netbsd/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/utmpx/netbsd/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/utmpx/tags.txt b/basis/unix/utmpx/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/utmpx/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor new file mode 100644 index 0000000000..e1756daa00 --- /dev/null +++ b/basis/unix/utmpx/utmpx.factor @@ -0,0 +1,66 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.c-types alien.syntax combinators continuations +io.encodings.string io.encodings.utf8 kernel sequences strings +unix calendar system accessors unix.time calendar.unix +vocabs.loader ; +IN: unix.utmpx + +: EMPTY 0 ; inline +: RUN_LVL 1 ; inline +: BOOT_TIME 2 ; inline +: OLD_TIME 3 ; inline +: NEW_TIME 4 ; inline +: INIT_PROCESS 5 ; inline +: LOGIN_PROCESS 6 ; inline +: USER_PROCESS 7 ; inline +: DEAD_PROCESS 8 ; inline +: ACCOUNTING 9 ; inline +: SIGNATURE 10 ; inline +: SHUTDOWN_TIME 11 ; inline + +FUNCTION: void setutxent ( ) ; +FUNCTION: void endutxent ( ) ; +FUNCTION: utmpx* getutxent ( ) ; +FUNCTION: utmpx* getutxid ( utmpx* id ) ; +FUNCTION: utmpx* getutxline ( utmpx* line ) ; +FUNCTION: utmpx* pututxline ( utmpx* utx ) ; + +TUPLE: utmpx-record user id line pid type timestamp host ; + +HOOK: new-utmpx-record os ( -- utmpx-record ) + +HOOK: utmpx>utmpx-record os ( utmpx -- utmpx-record ) + +: memory>string ( alien n -- string ) + memory>byte-array utf8 decode [ 0 = ] trim-right ; + +M: unix new-utmpx-record + utmpx-record new ; + +M: unix utmpx>utmpx-record ( utmpx -- utmpx-record ) + [ new-utmpx-record ] dip + { + [ utmpx-ut_user _UTX_USERSIZE memory>string >>user ] + [ utmpx-ut_id _UTX_IDSIZE memory>string >>id ] + [ utmpx-ut_line _UTX_LINESIZE memory>string >>line ] + [ utmpx-ut_pid >>pid ] + [ utmpx-ut_type >>type ] + [ utmpx-ut_tv timeval>unix-time >>timestamp ] + [ utmpx-ut_host _UTX_HOSTSIZE memory>string >>host ] + } cleave ; + +: with-utmpx ( quot -- ) + setutxent [ endutxent ] [ ] cleanup ; inline + +: all-utmpx ( -- seq ) + [ + [ getutxent dup ] + [ utmpx>utmpx-record ] + [ drop ] produce + ] with-utmpx ; + +os { + { macosx [ "unix.utmpx.macosx" require ] } + { netbsd [ "unix.utmpx.netbsd" require ] } +} case From 5afbade0a54a6dd5f753ffd413d8b0436e85630f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 7 Oct 2008 19:25:22 -0500 Subject: [PATCH 215/244] setting permissions, file times --- basis/io/unix/files/files.factor | 102 ++++++++++++++++++++++++++++++- 1 file changed, 99 insertions(+), 3 deletions(-) diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 6ddb74f4a3..ba8f51da4c 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2008 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: io.backend io.ports io.unix.backend io.files io unix unix.stat unix.time kernel math continuations math.bitwise byte-arrays alien combinators calendar io.encodings.binary accessors sequences strings system -io.files.private destructors vocabs.loader calendar.unix ; - +io.files.private destructors vocabs.loader calendar.unix +unix.stat alien.c-types arrays unix.users unix.groups ; IN: io.unix.files M: unix cwd ( -- path ) @@ -136,3 +136,99 @@ os { { freebsd [ "io.unix.files.bsd" require ] } { linux [ ] } } case + + + +: set-uid? ( path -- ? ) UID file-mode? ; +: set-gid? ( path -- ? ) GID file-mode? ; +: set-sticky? ( path -- ? ) STICKY file-mode? ; +: user-read? ( path -- ? ) USER-READ file-mode? ; +: user-write? ( path -- ? ) USER-WRITE file-mode? ; +: user-execute? ( path -- ? ) USER-EXECUTE file-mode? ; +: group-read? ( path -- ? ) GROUP-READ file-mode? ; +: group-write? ( path -- ? ) GROUP-WRITE file-mode? ; +: group-execute? ( path -- ? ) GROUP-EXECUTE file-mode? ; +: other-read? ( path -- ? ) OTHER-READ file-mode? ; +: other-write? ( path -- ? ) OTHER-WRITE file-mode? ; +: other-execute? ( path -- ? ) OTHER-EXECUTE file-mode? ; + +: set-uid ( path ? -- ) UID swap chmod-set-bit ; +: set-gid ( path ? -- ) GID swap chmod-set-bit ; +: set-sticky ( path ? -- ) STICKY swap chmod-set-bit ; +: set-user-read ( path ? -- ) USER-READ swap chmod-set-bit ; +: set-user-write ( path ? -- ) USER-WRITE swap chmod-set-bit ; +: set-user-execute ( path ? -- ) USER-EXECUTE swap chmod-set-bit ; +: set-group-read ( path ? -- ) GROUP-READ swap chmod-set-bit ; +: set-group-write ( path ? -- ) GROUP-WRITE swap chmod-set-bit ; +: set-group-execute ( path ? -- ) GROUP-EXECUTE swap chmod-set-bit ; +: set-other-read ( path ? -- ) OTHER-READ swap chmod-set-bit ; +: set-other-write ( path ? -- ) OTHER-WRITE swap chmod-set-bit ; +: set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ; + +: set-file-permissions ( path octal-n -- ) + [ normalize-path ] dip chmod io-error ; + + ] keep + dup length [ over [ pick set-timeval-nth ] [ 2drop ] if ] 2each ; + +: timestamp>timeval ( timestamp -- timeval ) + unix-1970 time- duration>milliseconds make-timeval ; + +: timestamps>byte-array ( timestamps -- byte-array ) + [ dup [ timestamp>timeval ] when ] map make-timeval-array ; + +PRIVATE> + +: set-file-times ( path timestamps -- ) + #! set access, write + [ normalize-path ] dip + timestamps>byte-array utimes io-error ; + +: set-file-access-time ( path timestamp -- ) + f 2array set-file-times ; + +: set-file-write-time ( path timestamp -- ) + f swap 2array set-file-times ; + +: set-file-ids ( path uid gid -- ) + [ normalize-path ] 2dip + [ [ -1 ] unless* ] bi@ chown io-error ; + +GENERIC: set-file-username ( path string/id -- ) + +GENERIC: set-file-group ( path string/id -- ) + +M: integer set-file-username ( path uid -- ) + f set-file-ids ; + +M: string set-file-username ( path string -- ) + username-id f set-file-ids ; + +M: integer set-file-group ( path gid -- ) + f swap set-file-ids ; + +M: string set-file-group ( path string -- ) + group-id + f swap set-file-ids ; + +: file-uid ( path -- uid ) normalize-path file-info uid>> ; + +: file-user-name ( path -- string ) file-uid username ; + +: file-gid ( path -- gid ) normalize-path file-info gid>> ; + +: file-group ( path -- string ) file-gid group-name ; From fb23eca0d93df5689faa5e7f57f094d2eef5ffdd Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:03:55 -0500 Subject: [PATCH 216/244] move file flags to io.unix.files, change some word names for consistency --- basis/io/unix/files/files.factor | 39 +++++++++++++++++++++++++------- basis/unix/stat/stat.factor | 14 ------------ 2 files changed, 31 insertions(+), 22 deletions(-) diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index ba8f51da4c..49510f9841 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -150,9 +150,25 @@ os { PRIVATE> -: set-uid? ( path -- ? ) UID file-mode? ; -: set-gid? ( path -- ? ) GID file-mode? ; -: set-sticky? ( path -- ? ) STICKY file-mode? ; +: UID OCT: 0004000 ; inline +: GID OCT: 0002000 ; inline +: STICKY OCT: 0001000 ; inline +: USER-ALL OCT: 0000700 ; inline +: USER-READ OCT: 0000400 ; inline +: USER-WRITE OCT: 0000200 ; inline +: USER-EXECUTE OCT: 0000100 ; inline +: GROUP-ALL OCT: 0000070 ; inline +: GROUP-READ OCT: 0000040 ; inline +: GROUP-WRITE OCT: 0000020 ; inline +: GROUP-EXECUTE OCT: 0000010 ; inline +: OTHER-ALL OCT: 0000007 ; inline +: OTHER-READ OCT: 0000004 ; inline +: OTHER-WRITE OCT: 0000002 ; inline +: OTHER-EXECUTE OCT: 0000001 ; inline + +: uid? ( path -- ? ) UID file-mode? ; +: gid? ( path -- ? ) GID file-mode? ; +: sticky? ( path -- ? ) STICKY file-mode? ; : user-read? ( path -- ? ) USER-READ file-mode? ; : user-write? ( path -- ? ) USER-WRITE file-mode? ; : user-execute? ( path -- ? ) USER-EXECUTE file-mode? ; @@ -176,9 +192,12 @@ PRIVATE> : set-other-write ( path ? -- ) OTHER-WRITE swap chmod-set-bit ; : set-other-execute ( path ? -- ) OTHER-EXECUTE swap chmod-set-bit ; -: set-file-permissions ( path octal-n -- ) +: set-file-permissions ( path n -- ) [ normalize-path ] dip chmod io-error ; +: file-permissions ( path -- n ) + normalize-path file-info permissions>> ; + > ; +: file-username-id ( path -- uid ) + normalize-path file-info uid>> ; -: file-user-name ( path -- string ) file-uid username ; +: file-username ( path -- string ) + file-username-id username ; -: file-gid ( path -- gid ) normalize-path file-info gid>> ; +: file-group-id ( path -- gid ) + normalize-path file-info gid>> ; -: file-group ( path -- string ) file-gid group-name ; +: file-group-name ( path -- string ) + file-group-id group-name ; diff --git a/basis/unix/stat/stat.factor b/basis/unix/stat/stat.factor index 139f1b1983..46fe7d98f9 100644 --- a/basis/unix/stat/stat.factor +++ b/basis/unix/stat/stat.factor @@ -14,20 +14,6 @@ IN: unix.stat : S_IFLNK OCT: 120000 ; inline ! Symbolic link. : S_IFSOCK OCT: 140000 ; inline ! Socket. -! File Access Permissions -: UID OCT: 0004000 ; inline -: GID OCT: 0002000 ; inline -: STICKY OCT: 0001000 ; inline -: USER-READ OCT: 0000400 ; inline ! r owner -: USER-WRITE OCT: 0000200 ; inline ! w owner -: USER-EXECUTE OCT: 0000100 ; inline ! x owner -: GROUP-READ OCT: 0000040 ; inline ! r group -: GROUP-WRITE OCT: 0000020 ; inline ! w group -: GROUP-EXECUTE OCT: 0000010 ; inline ! x group -: OTHER-READ OCT: 0000004 ; inline ! r other -: OTHER-WRITE OCT: 0000002 ; inline ! w other -: OTHER-EXECUTE OCT: 0000001 ; inline ! x other - FUNCTION: int chmod ( char* path, mode_t mode ) ; FUNCTION: int fchmod ( int fd, mode_t mode ) ; FUNCTION: int mkdir ( char* path, mode_t mode ) ; From 0f891e002bd3801434a7c300af55409d29e1ae60 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:04:23 -0500 Subject: [PATCH 217/244] add io.unix.files docs --- basis/io/unix/files/files-docs.factor | 277 ++++++++++++++++++++++++++ 1 file changed, 277 insertions(+) create mode 100644 basis/io/unix/files/files-docs.factor diff --git a/basis/io/unix/files/files-docs.factor b/basis/io/unix/files/files-docs.factor new file mode 100644 index 0000000000..7b4ce10b86 --- /dev/null +++ b/basis/io/unix/files/files-docs.factor @@ -0,0 +1,277 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: classes help.markup help.syntax io.streams.string +strings math calendar io.files ; +IN: io.unix.files + +HELP: file-group-id +{ $values + { "path" "a pathname string" } + { "gid" integer } } +{ $description "Returns the group id for a given file." } ; + +HELP: file-group-name +{ $values + { "path" "a pathname string" } + { "string" string } } +{ $description "Returns the group name for a given file." } ; + +HELP: file-permissions +{ $values + { "path" "a pathname string" } + { "n" integer } } +{ $description "Returns the Unix file permissions for a given file." } ; + +HELP: file-username +{ $values + { "path" "a pathname string" } + { "string" string } } +{ $description "Returns the username for a given file." } ; + +HELP: file-username-id +{ $values + { "path" "a pathname string" } + { "uid" integer } } +{ $description "Returns the user id for a given file." } ; + +HELP: group-execute? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "group execute" } " bit is set on a file." } ; + +HELP: group-read? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "group read" } " bit is set on a file." } ; + +HELP: group-write? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "group write" } " bit is set on a file." } ; + +HELP: other-execute? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "other execute" } " bit is set on a file." } ; + +HELP: other-read? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "other read" } " bit is set on a file." } ; + +HELP: other-write? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "other write" } " bit is set on a file." } ; + +HELP: set-file-access-time +{ $values + { "path" "a pathname string" } { "timestamp" timestamp } } +{ $description "Sets a file's last access timestamp." } ; + +HELP: set-file-group +{ $values + { "path" "a pathname string" } { "string/id" "a string or a group id" } } +{ $description "Sets a file's group id from the given group id or group name." } ; + +HELP: set-file-ids +{ $values + { "path" "a pathname string" } { "uid" integer } { "gid" integer } } +{ $description "Sets the user id and group id of a file with a single library call." } ; + +HELP: set-file-permissions +{ $values + { "path" "a pathname string" } { "n" "an integer, interepreted as a string of bits" } } +{ $description "Sets the file permissions for a given file with the supplied Unix permissions integer. Supplying an octal number with " { $link POSTPONE: OCT: } " is recommended." } +{ $examples "Using the tradidional octal value:" + { $unchecked-example "USING: io.unix.files kernel ;" + "\"resource:license.txt\" OCT: 755 set-file-permissions" + "" + } + "Higher-level, setting named bits:" + { $unchecked-example "USING: io.unix.files kernel math.bitwise ;" + "\"resource:license.txt\"" + "{ USER-ALL GROUP-READ GROUP-EXECUTE OTHER-READ OTHER-EXECUTE }" + "flags set-file-permissions" + "" } +} ; + +HELP: set-file-times +{ $values + { "path" "a pathname string" } { "timestamps" "an array of two timestamps" } } +{ $description "Sets the access and write timestamps for a file as provided in the input array. A value of " { $link f } " provided for either of the timestamps will not change that timestamp." } ; + +HELP: set-file-username +{ $values + { "path" "a pathname string" } { "string/id" "a string or a user id" } } +{ $description "Sets a file's user id from the given user id or username." } ; + +HELP: set-file-write-time +{ $values + { "path" "a pathname string" } { "timestamp" timestamp } } +{ $description "Sets a file's last write timestamp." } ; + +HELP: set-gid +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "gid" } " bit of a file to true or false." } ; + +HELP: gid? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "gid" } " bit is set on a file." } ; + +HELP: set-group-execute +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "group execute" } " bit of a file to true or false." } ; + +HELP: set-group-read +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "group read" } " bit of a file to true or false." } ; + +HELP: set-group-write +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "group write" } " bit of a file to true or false." } ; + +HELP: set-other-execute +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ; + +HELP: set-other-read +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "other read" } " bit of a file to true or false." } ; + +HELP: set-other-write +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "other execute" } " bit of a file to true or false." } ; + +HELP: set-sticky +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "sticky" } " bit of a file to true or false." } ; + +HELP: sticky? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "sticky" } " bit of a file is set." } ; + +HELP: set-uid +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "uid" } " bit of a file to true or false." } ; + +HELP: uid? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "uid" } " bit of a file is set." } ; + +HELP: set-user-execute +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "user execute" } " bit of a file to true or false." } ; + +HELP: set-user-read +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "user read" } " bit of a file to true or false." } ; + +HELP: set-user-write +{ $values + { "path" "a pathname string" } { "?" "a boolean" } } +{ $description "Sets the " { $snippet "user write" } " bit of a file to true or false." } ; + +HELP: user-execute? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "user execute" } " bit is set on a file." } ; + +HELP: user-read? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "user read" } " bit is set on a file." } ; + +HELP: user-write? +{ $values + { "path" "a pathname string" } + { "?" "a boolean" } } +{ $description "Tests whether the " { $snippet "user write" } " bit is set on a file." } ; + +ARTICLE: "unix-file-permissions" "Unix file permissions" +"Reading all file permissions:" +{ $subsection file-permissions } +"Reading individual file permissions:" +{ $subsection uid? } +{ $subsection gid? } +{ $subsection sticky? } +{ $subsection user-read? } +{ $subsection user-write? } +{ $subsection user-execute? } +{ $subsection group-read? } +{ $subsection group-write? } +{ $subsection group-execute? } +{ $subsection other-read? } +{ $subsection other-write? } +{ $subsection other-execute? } +"Writing all file permissions:" +{ $subsection set-file-permissions } +"Writing individual file permissions:" +{ $subsection set-uid } +{ $subsection set-gid } +{ $subsection set-sticky } +{ $subsection set-user-read } +{ $subsection set-user-write } +{ $subsection set-user-execute } +{ $subsection set-group-read } +{ $subsection set-group-write } +{ $subsection set-group-execute } +{ $subsection set-other-read } +{ $subsection set-other-write } +{ $subsection set-other-execute } ; + +ARTICLE: "unix-file-timestamps" "Unix file timestamps" +"To read file times, use the accessors on the object returned by the " { $link file-info } " word." $nl +"Setting multiple file times:" +{ $subsection set-file-times } +"Setting just the last access time:" +{ $subsection set-file-access-time } +"Setting just the last write time:" +{ $subsection set-file-write-time } ; + + +ARTICLE: "unix-file-ids" "Unix file user and group ids" +"Reading file user data:" +{ $subsection file-username-id } +{ $subsection file-username } +"Setting file user data:" +{ $subsection set-file-username } +"Reading file group data:" +{ $subsection file-group-id } +{ $subsection file-group-name } +"Setting file group data:" +{ $subsection set-file-group } ; + + +ARTICLE: "io.unix.files" "Unix file attributes" +"The " { $vocab-link "io.unix.files" } " vocabulary implements the Unix backend for opening files and provides a high-level way to set permissions, timestamps, and user and group ids for files." +{ $subsection "unix-file-permissions" } +{ $subsection "unix-file-timestamps" } +{ $subsection "unix-file-ids" } ; + +ABOUT: "io.unix.files" From 65b891a687cd0558b53cd6ee14d4b835c1e0dcd5 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:05:00 -0500 Subject: [PATCH 218/244] document unix.users --- basis/unix/users/users-docs.factor | 120 +++++++++++++++++++++++++++++ basis/unix/users/users.factor | 4 +- 2 files changed, 122 insertions(+), 2 deletions(-) create mode 100644 basis/unix/users/users-docs.factor diff --git a/basis/unix/users/users-docs.factor b/basis/unix/users/users-docs.factor new file mode 100644 index 0000000000..caa938f047 --- /dev/null +++ b/basis/unix/users/users-docs.factor @@ -0,0 +1,120 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string kernel quotations sequences strings math ; +IN: unix.users + +HELP: all-users +{ $values + + { "seq" sequence } } +{ $description "Returns a sequence of high-level " { $link passwd } " tuples that are platform-dependent and field for field complete with the Unix " { $link passwd } " structure." } ; + +HELP: effective-username +{ $values + + { "string" string } } +{ $description "Returns the effective username for the current user." } ; + +HELP: effective-username-id +{ $values + + { "id" integer } } +{ $description "Returns the effective username id for the current user." } ; + +HELP: new-passwd +{ $values + + { "passwd" passwd } } +{ $description "Creates a new passwd tuple dependent on the operating system." } ; + +HELP: passwd +{ $description "A platform-specific tuple correspding to every field from the Unix passwd struct. BSD passwd structures have four extra slots: " { $slot "change" } ", " { $slot "class" } "," { $slot "expire" } ", " { $slot "fields" } "." } ; + +HELP: passwd-cache +{ $description "A symbol storing passwd structures indexed by user-ids when within a " { $link with-passwd-cache } "." } ; + +HELP: passwd>new-passwd +{ $values + { "passwd" "a passwd struct" } + { "new-passwd" "a passwd tuple" } } +{ $description "A platform-specific conversion routine from a passwd structure to a passwd tuple." } ; + +HELP: real-username +{ $values + + { "string" string } } +{ $description "The real username of the current user." } ; + +HELP: real-username-id +{ $values + + { "id" integer } } +{ $description "The real user id of the current user." } ; + +HELP: set-effective-username +{ $values + { "string/id" "a string or a user id" } } +{ $description "Sets the current effective username." } ; + +HELP: set-real-username +{ $values + { "string/id" "a string or a user id" } } +{ $description "Sets the current real username." } ; + +HELP: user-passwd +{ $values + { "obj" object } + { "passwd" passwd } } +{ $description "Returns the passwd tuple given a username string or user id." } ; + +HELP: username +{ $values + { "id" integer } + { "string" string } } +{ $description "Returns the username associated with the user id." } ; + +HELP: username-id +{ $values + { "string" string } + { "id" integer } } +{ $description "Returns the user id associated with the username." } ; + +HELP: with-effective-username +{ $values + { "string/id" "a string or a uid" } { "quot" quotation } } +{ $description "Sets the effective username and calls the quotation. Restores the current username on success or on error after the call." } ; + +HELP: with-passwd-cache +{ $values + { "quot" quotation } } +{ $description "Iterates over the password file using library calls and creates a cache in the " { $link passwd-cache } " symbol. The cache is a hashtable indexed by user id. When looking up many users, this approach is much faster than calling system calls." } ; + +HELP: with-real-username +{ $values + { "string/id" "a string or a uid" } { "quot" quotation } } +{ $description "Sets the real username and calls the quotation. Restores the current username on success or on error after the call." } ; + +{ + real-username real-username-id set-real-username + effective-username effective-username-id + set-effective-username +} related-words + +ARTICLE: "unix.users" "unix.users" +"The " { $vocab-link "unix.users" } " vocabulary contains words that return information about Unix users." +"Listing all users:" +{ $subsection all-users } +"Returning a passwd tuple:" +"Real user:" +{ $subsection real-username } +{ $subsection real-username-id } +{ $subsection set-real-username } +"Effective user:" +{ $subsection effective-username } +{ $subsection effective-username-id } +{ $subsection set-effective-username } +"Combinators to change users:" +{ $subsection with-real-username } +{ $subsection with-effective-username } ; + +ABOUT: "unix.users" diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index 184312e0ce..1b2e414a88 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -60,13 +60,13 @@ M: string user-passwd ( string -- passwd/f ) : username-id ( string -- id ) user-passwd username>> ; -: real-username-id ( -- string ) +: real-username-id ( -- id ) getuid ; inline : real-username ( -- string ) real-username-id username ; inline -: effective-username-id ( -- string ) +: effective-username-id ( -- id ) geteuid username ; inline : effective-username ( -- string ) From 1ba5b448d7654b737d9c19bfa7e4457c53ae91ec Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:05:16 -0500 Subject: [PATCH 219/244] document unix.groups --- basis/unix/groups/groups-docs.factor | 108 +++++++++++++++++++++++++++ basis/unix/groups/groups.factor | 17 ++++- 2 files changed, 121 insertions(+), 4 deletions(-) create mode 100644 basis/unix/groups/groups-docs.factor diff --git a/basis/unix/groups/groups-docs.factor b/basis/unix/groups/groups-docs.factor new file mode 100644 index 0000000000..ef2631ae3f --- /dev/null +++ b/basis/unix/groups/groups-docs.factor @@ -0,0 +1,108 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax io.streams.string kernel quotations sequences strings math ; +IN: unix.groups + +HELP: all-groups +{ $values + + { "seq" sequence } } +{ $description "Returns a sequence of " { $link group } " tuples that are platform-dependent and field for field complete with the Unix " { $link group } " structure." } ; + +HELP: effective-group-id +{ $values + + { "string" string } } +{ $description "Returns the effective group id for the current user." } ; + +HELP: effective-group-name +{ $values + + { "string" string } } +{ $description "Returns the effective group name for the current user." } ; + +HELP: group +{ $description "A platform-specific tuple corresponding to every field from the Unix group struct including the group name, the group id, the group passwd, and a list of users in each group." } ; + +HELP: group-cache +{ $description "A symbol containing a cache of groups returned from " { $link all-groups } " and indexed by group id. Can be more efficient than using the system call words for many group lookups." } ; + +HELP: group-id +{ $values + { "string" string } + { "id" integer } } +{ $description "Returns the group id given a group name." } ; + +HELP: group-name +{ $values + { "id" integer } + { "string" string } } +{ $description "Returns the group name given a group id." } ; + +HELP: group-struct +{ $values + { "obj" object } + { "group" "a group struct" } } +{ $description "Returns an alien group struct to be turned into a group tuple by calling subsequent words." } ; + +HELP: real-group-id +{ $values + + { "id" integer } } +{ $description "Returns the real group id for the current user." } ; + +HELP: real-group-name +{ $values + + { "string" string } } +{ $description "Returns the real group name for the current user." } ; + +HELP: set-effective-group +{ $values + { "obj" object } } +{ $description "Sets the effective group id for the current user." } ; + +HELP: set-real-group +{ $values + { "obj" object } } +{ $description "Sets the real group id for the current user." } ; + +HELP: user-groups +{ $values + { "string/id" "a string or a group id" } + { "seq" sequence } } +{ $description "Returns the sequence of groups to which the user belongs." } ; + +HELP: with-effective-group +{ $values + { "string/id" "a string or a group id" } { "quot" quotation } } +{ $description "Sets the effective group name and calls the quotation. Restors the effective group name on success or on error after the call." } ; + +HELP: with-group-cache +{ $values + { "quot" quotation } } +{ $description "Iterates over the group file using library calls and creates a cache in the " { $link group-cache } " symbol. The cache is a hashtable indexed by group id. When looking up many groups, this approach is much faster than calling system calls." } ; + +HELP: with-real-group +{ $values + { "string/id" "a string or a group id" } { "quot" quotation } } +{ $description "Sets the real group name and calls the quotation. Restores the current group name on success or on error after the call." } ; + +ARTICLE: "unix.groups" "unix.groups" +"The " { $vocab-link "unix.groups" } " vocabulary contains words that return information about Unix groups." +"Listing all groups:" +{ $subsection all-groups } +"Returning a passwd tuple:" +"Real groups:" +{ $subsection real-group-name } +{ $subsection real-group-id } +{ $subsection set-real-group } +"Effective groups:" +{ $subsection effective-group-name } +{ $subsection effective-group-id } +{ $subsection set-effective-group } +"Combinators to change groups:" +{ $subsection with-real-group } +{ $subsection with-effective-group } ; + +ABOUT: "unix.groups" diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 5a33bfe072..7f3aa9ae98 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -3,7 +3,8 @@ USING: alien alien.c-types alien.strings io.encodings.utf8 io.unix.backend kernel math sequences splitting unix strings combinators.short-circuit byte-arrays combinators qualified -accessors math.parser fry assocs namespaces continuations ; +accessors math.parser fry assocs namespaces continuations +unix.users ; IN: unix.groups QUALIFIED: grouping @@ -61,14 +62,22 @@ PRIVATE> : >groups ( byte-array n -- groups ) [ 4 grouping:group ] dip head-slice [ *uint group-name ] map ; -PRIVATE> - -: user-groups ( string -- seq ) +: (user-groups) ( string -- seq ) #! first group is -1337, legacy unix code -1337 NGROUPS_MAX [ 4 * ] keep [ getgrouplist io-error ] 2keep [ 4 tail-slice ] [ *int 1- ] bi* >groups ; +PRIVATE> + +GENERIC: user-groups ( string/id -- seq ) + +M: string user-groups ( string -- seq ) + (user-groups) ; + +M: integer user-groups ( id -- seq ) + username (user-groups) ; + : all-groups ( -- seq ) [ getgrent dup ] [ group-struct>group ] [ drop ] produce ; From e7e0e7ad695ead652cd4fb68589411e6081cc208 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:13:25 -0500 Subject: [PATCH 220/244] fix bugs in unix.users found by adding unit tests. oops --- basis/unix/users/users.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index 1b2e414a88..9545a2c5c6 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -58,7 +58,7 @@ M: string user-passwd ( string -- passwd/f ) user-passwd username>> ; : username-id ( string -- id ) - user-passwd username>> ; + user-passwd uid>> ; : real-username-id ( -- id ) getuid ; inline @@ -67,7 +67,7 @@ M: string user-passwd ( string -- passwd/f ) real-username-id username ; inline : effective-username-id ( -- id ) - geteuid username ; inline + geteuid ; inline : effective-username ( -- string ) effective-username-id username ; inline From f026177e2730d95e07afa95b282bea77d3970862 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:22:53 -0500 Subject: [PATCH 221/244] add users tests, fix naming inconsistencies --- basis/unix/users/users-docs.factor | 36 +++++++++++----------- basis/unix/users/users-tests.factor | 24 +++++++++++++++ basis/unix/users/users.factor | 46 ++++++++++++++--------------- 3 files changed, 65 insertions(+), 41 deletions(-) create mode 100644 basis/unix/users/users-tests.factor diff --git a/basis/unix/users/users-docs.factor b/basis/unix/users/users-docs.factor index caa938f047..f8586ffc35 100644 --- a/basis/unix/users/users-docs.factor +++ b/basis/unix/users/users-docs.factor @@ -15,7 +15,7 @@ HELP: effective-username { "string" string } } { $description "Returns the effective username for the current user." } ; -HELP: effective-username-id +HELP: effective-user-id { $values { "id" integer } } @@ -45,21 +45,21 @@ HELP: real-username { "string" string } } { $description "The real username of the current user." } ; -HELP: real-username-id +HELP: real-user-id { $values { "id" integer } } { $description "The real user id of the current user." } ; -HELP: set-effective-username +HELP: set-effective-user { $values { "string/id" "a string or a user id" } } -{ $description "Sets the current effective username." } ; +{ $description "Sets the current effective user given a username or a user id." } ; -HELP: set-real-username +HELP: set-real-user { $values { "string/id" "a string or a user id" } } -{ $description "Sets the current real username." } ; +{ $description "Sets the current real user given a username or a user id." } ; HELP: user-passwd { $values @@ -73,13 +73,13 @@ HELP: username { "string" string } } { $description "Returns the username associated with the user id." } ; -HELP: username-id +HELP: user-id { $values { "string" string } { "id" integer } } { $description "Returns the user id associated with the username." } ; -HELP: with-effective-username +HELP: with-effective-user { $values { "string/id" "a string or a uid" } { "quot" quotation } } { $description "Sets the effective username and calls the quotation. Restores the current username on success or on error after the call." } ; @@ -89,15 +89,15 @@ HELP: with-passwd-cache { "quot" quotation } } { $description "Iterates over the password file using library calls and creates a cache in the " { $link passwd-cache } " symbol. The cache is a hashtable indexed by user id. When looking up many users, this approach is much faster than calling system calls." } ; -HELP: with-real-username +HELP: with-real-user { $values { "string/id" "a string or a uid" } { "quot" quotation } } { $description "Sets the real username and calls the quotation. Restores the current username on success or on error after the call." } ; { - real-username real-username-id set-real-username - effective-username effective-username-id - set-effective-username + real-username real-user-id set-real-user + effective-username effective-user-id + set-effective-user } related-words ARTICLE: "unix.users" "unix.users" @@ -107,14 +107,14 @@ ARTICLE: "unix.users" "unix.users" "Returning a passwd tuple:" "Real user:" { $subsection real-username } -{ $subsection real-username-id } -{ $subsection set-real-username } +{ $subsection real-user-id } +{ $subsection set-real-user } "Effective user:" { $subsection effective-username } -{ $subsection effective-username-id } -{ $subsection set-effective-username } +{ $subsection effective-user-id } +{ $subsection set-effective-user } "Combinators to change users:" -{ $subsection with-real-username } -{ $subsection with-effective-username } ; +{ $subsection with-real-user } +{ $subsection with-effective-user } ; ABOUT: "unix.users" diff --git a/basis/unix/users/users-tests.factor b/basis/unix/users/users-tests.factor new file mode 100644 index 0000000000..a85c322aca --- /dev/null +++ b/basis/unix/users/users-tests.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.users kernel strings math ; +IN: unix.users.tests + + +[ ] [ all-users drop ] unit-test + +\ all-users must-infer + +[ t ] [ real-username string? ] unit-test +[ t ] [ effective-username string? ] unit-test + +[ t ] [ real-user-id integer? ] unit-test +[ t ] [ effective-user-id integer? ] unit-test + +[ ] [ real-user-id set-real-user ] unit-test +[ ] [ effective-user-id set-effective-user ] unit-test + +[ ] [ real-username [ ] with-real-user ] unit-test +[ ] [ real-user-id [ ] with-real-user ] unit-test + +[ ] [ effective-username [ ] with-effective-user ] unit-test +[ ] [ effective-user-id [ ] with-effective-user ] unit-test diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index 9545a2c5c6..eac771160b 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -57,56 +57,56 @@ M: string user-passwd ( string -- passwd/f ) : username ( id -- string ) user-passwd username>> ; -: username-id ( string -- id ) +: user-id ( string -- id ) user-passwd uid>> ; -: real-username-id ( -- id ) +: real-user-id ( -- id ) getuid ; inline : real-username ( -- string ) - real-username-id username ; inline + real-user-id username ; inline -: effective-username-id ( -- id ) +: effective-user-id ( -- id ) geteuid ; inline : effective-username ( -- string ) - effective-username-id username ; inline + effective-user-id username ; inline -GENERIC: set-real-username ( string/id -- ) +GENERIC: set-real-user ( string/id -- ) -GENERIC: set-effective-username ( string/id -- ) +GENERIC: set-effective-user ( string/id -- ) -: with-real-username ( string/id quot -- ) - '[ _ set-real-username @ ] - real-username-id '[ _ set-real-username ] +: with-real-user ( string/id quot -- ) + '[ _ set-real-user @ ] + real-user-id '[ _ set-real-user ] [ ] cleanup ; inline -: with-effective-username ( string/id quot -- ) - '[ _ set-effective-username @ ] - effective-username-id '[ _ set-effective-username ] +: with-effective-user ( string/id quot -- ) + '[ _ set-effective-user @ ] + effective-user-id '[ _ set-effective-user ] [ ] cleanup ; inline -M: string set-real-username ( string -- ) - username-id (set-real-username) ; +M: string set-real-user ( string -- ) + user-id (set-real-user) ; -M: integer set-real-username ( id -- ) - (set-real-username) ; +M: integer set-real-user ( id -- ) + (set-real-user) ; -M: integer set-effective-username ( id -- ) - (set-effective-username) ; +M: integer set-effective-user ( id -- ) + (set-effective-user) ; -M: string set-effective-username ( string -- ) - username-id (set-effective-username) ; +M: string set-effective-user ( string -- ) + user-id (set-effective-user) ; os { { [ dup bsd? ] [ drop "unix.users.bsd" require ] } From e0ad27401e3f874fda887adbfa003b29e0e9bafb Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:23:23 -0500 Subject: [PATCH 222/244] add groups tests --- basis/unix/groups/groups-tests.factor | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 basis/unix/groups/groups-tests.factor diff --git a/basis/unix/groups/groups-tests.factor b/basis/unix/groups/groups-tests.factor new file mode 100644 index 0000000000..0fdd6ff08d --- /dev/null +++ b/basis/unix/groups/groups-tests.factor @@ -0,0 +1,24 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test unix.groups kernel strings math ; +IN: unix.groups.tests + + +[ ] [ all-groups drop ] unit-test + +\ all-groups must-infer + +[ t ] [ real-group-name string? ] unit-test +[ t ] [ effective-group-name string? ] unit-test + +[ t ] [ real-group-id integer? ] unit-test +[ t ] [ effective-group-id integer? ] unit-test + +[ ] [ real-group-id set-real-group ] unit-test +[ ] [ effective-group-id set-effective-group ] unit-test + +[ ] [ real-group-name [ ] with-real-group ] unit-test +[ ] [ real-group-id [ ] with-real-group ] unit-test + +[ ] [ effective-group-name [ ] with-effective-group ] unit-test +[ ] [ effective-group-id [ ] with-effective-group ] unit-test From 402126d0389fa528e3098e2f47b4defa51ec6828 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 13:26:43 -0500 Subject: [PATCH 223/244] fix spacing --- basis/unix/groups/groups-tests.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/groups/groups-tests.factor b/basis/unix/groups/groups-tests.factor index 0fdd6ff08d..9e7122fc34 100644 --- a/basis/unix/groups/groups-tests.factor +++ b/basis/unix/groups/groups-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test unix.groups kernel strings math ; +USING: tools.test unix.groups kernel strings math ; IN: unix.groups.tests From e464941d5281481fd48affaab0dd4836b8537eb0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 14:18:50 -0500 Subject: [PATCH 224/244] rename words for consistency, update docs, add unit tests --- basis/io/unix/files/files-docs.factor | 16 ++-- basis/io/unix/files/files-tests.factor | 110 ++++++++++++++++++++++++- basis/io/unix/files/files.factor | 16 ++-- 3 files changed, 125 insertions(+), 17 deletions(-) diff --git a/basis/io/unix/files/files-docs.factor b/basis/io/unix/files/files-docs.factor index 7b4ce10b86..5b5e257c5e 100644 --- a/basis/io/unix/files/files-docs.factor +++ b/basis/io/unix/files/files-docs.factor @@ -28,7 +28,7 @@ HELP: file-username { "string" string } } { $description "Returns the username for a given file." } ; -HELP: file-username-id +HELP: file-user-id { $values { "path" "a pathname string" } { "uid" integer } } @@ -107,15 +107,15 @@ HELP: set-file-times { "path" "a pathname string" } { "timestamps" "an array of two timestamps" } } { $description "Sets the access and write timestamps for a file as provided in the input array. A value of " { $link f } " provided for either of the timestamps will not change that timestamp." } ; -HELP: set-file-username +HELP: set-file-user { $values { "path" "a pathname string" } { "string/id" "a string or a user id" } } { $description "Sets a file's user id from the given user id or username." } ; -HELP: set-file-write-time +HELP: set-file-modified-time { $values { "path" "a pathname string" } { "timestamp" timestamp } } -{ $description "Sets a file's last write timestamp." } ; +{ $description "Sets a file's last modified timestamp, or write timestamp." } ; HELP: set-gid { $values @@ -251,16 +251,16 @@ ARTICLE: "unix-file-timestamps" "Unix file timestamps" { $subsection set-file-times } "Setting just the last access time:" { $subsection set-file-access-time } -"Setting just the last write time:" -{ $subsection set-file-write-time } ; +"Setting just the last modified time:" +{ $subsection set-file-modified-time } ; ARTICLE: "unix-file-ids" "Unix file user and group ids" "Reading file user data:" -{ $subsection file-username-id } +{ $subsection file-user-id } { $subsection file-username } "Setting file user data:" -{ $subsection set-file-username } +{ $subsection set-file-user } "Reading file group data:" { $subsection file-group-id } { $subsection file-group-name } diff --git a/basis/io/unix/files/files-tests.factor b/basis/io/unix/files/files-tests.factor index 040b191d27..28c25c0964 100644 --- a/basis/io/unix/files/files-tests.factor +++ b/basis/io/unix/files/files-tests.factor @@ -1,4 +1,6 @@ -USING: tools.test io.files ; +USING: tools.test io.files continuations kernel io.unix.files +math.bitwise calendar accessors math.functions math unix.users +unix.groups arrays sequences ; IN: io.unix.files.tests [ "/usr/libexec/" ] [ "/usr/libexec/awk/" parent-directory ] unit-test @@ -27,3 +29,109 @@ IN: io.unix.files.tests [ "/lib/bux" ] [ "/usr" "/lib/bux" append-path ] unit-test [ "/lib/bux/" ] [ "/usr" "/lib/bux/" append-path ] unit-test [ t ] [ "/foo" absolute-path? ] unit-test + +: test-file ( -- path ) + "permissions" temp-file ; + +: prepare-test-file ( -- ) + [ test-file delete-file ] ignore-errors + test-file touch-file ; + +: perms ( -- n ) + test-file file-permissions OCT: 7777 mask ; + +prepare-test-file + +[ t ] +[ test-file { USER-ALL GROUP-ALL OTHER-ALL } flags set-file-permissions perms OCT: 777 = ] unit-test + +[ t ] [ test-file user-read? ] unit-test +[ t ] [ test-file user-write? ] unit-test +[ t ] [ test-file user-execute? ] unit-test +[ t ] [ test-file group-read? ] unit-test +[ t ] [ test-file group-write? ] unit-test +[ t ] [ test-file group-execute? ] unit-test +[ t ] [ test-file other-read? ] unit-test +[ t ] [ test-file other-write? ] unit-test +[ t ] [ test-file other-execute? ] unit-test + +[ t ] +[ test-file f set-other-execute perms OCT: 776 = ] unit-test + +[ t ] +[ test-file f set-other-write perms OCT: 774 = ] unit-test + +[ t ] +[ test-file f set-other-read perms OCT: 770 = ] unit-test + +[ t ] +[ test-file f set-group-execute perms OCT: 760 = ] unit-test + +[ t ] +[ test-file f set-group-write perms OCT: 740 = ] unit-test + +[ t ] +[ test-file f set-group-read perms OCT: 700 = ] unit-test + +[ t ] +[ test-file f set-user-execute perms OCT: 600 = ] unit-test + +[ t ] +[ test-file f set-user-write perms OCT: 400 = ] unit-test + +[ t ] +[ test-file f set-user-read perms OCT: 000 = ] unit-test + +[ t ] +[ test-file { USER-ALL GROUP-ALL OTHER-EXECUTE } flags set-file-permissions perms OCT: 771 = ] unit-test + +prepare-test-file + +[ t ] +[ + test-file now + [ set-file-access-time ] 2keep + [ file-info accessed>> ] + [ [ truncate >integer ] change-second ] bi* = +] unit-test + +[ t ] +[ + test-file now + [ set-file-modified-time ] 2keep + [ file-info modified>> ] + [ [ truncate >integer ] change-second ] bi* = +] unit-test + +[ t ] +[ + test-file now [ dup 2array set-file-times ] 2keep + [ file-info [ modified>> ] [ accessed>> ] bi ] dip + 3array + [ [ truncate >integer ] change-second ] map all-equal? +] unit-test + +[ ] [ test-file f now 2array set-file-times ] unit-test +[ ] [ test-file now f 2array set-file-times ] unit-test +[ ] [ test-file f f 2array set-file-times ] unit-test + + +[ ] [ test-file real-username set-file-user ] unit-test +[ ] [ test-file real-user-id set-file-user ] unit-test +[ ] [ test-file real-group-name set-file-group ] unit-test +[ ] [ test-file real-group-id set-file-group ] unit-test + +[ t ] [ test-file file-username real-username = ] unit-test +[ t ] [ test-file file-group-name real-group-name = ] unit-test + +[ ] +[ test-file real-user-id real-group-id set-file-ids ] unit-test + +[ ] +[ test-file f real-group-id set-file-ids ] unit-test + +[ ] +[ test-file real-user-id f set-file-ids ] unit-test + +[ ] +[ test-file f f set-file-ids ] unit-test diff --git a/basis/io/unix/files/files.factor b/basis/io/unix/files/files.factor index 49510f9841..40ef9ad859 100644 --- a/basis/io/unix/files/files.factor +++ b/basis/io/unix/files/files.factor @@ -144,7 +144,7 @@ os { : chmod-set-bit ( path mask ? -- ) [ dup stat-mode ] 2dip - [ set-bit ] [ clear-bit ] if chmod io-error ; + [ bitor ] [ unmask ] if chmod io-error ; : file-mode? ( path mask -- ? ) [ stat-mode ] dip mask? ; @@ -220,22 +220,22 @@ PRIVATE> : set-file-access-time ( path timestamp -- ) f 2array set-file-times ; -: set-file-write-time ( path timestamp -- ) +: set-file-modified-time ( path timestamp -- ) f swap 2array set-file-times ; : set-file-ids ( path uid gid -- ) [ normalize-path ] 2dip [ [ -1 ] unless* ] bi@ chown io-error ; -GENERIC: set-file-username ( path string/id -- ) +GENERIC: set-file-user ( path string/id -- ) GENERIC: set-file-group ( path string/id -- ) -M: integer set-file-username ( path uid -- ) +M: integer set-file-user ( path uid -- ) f set-file-ids ; -M: string set-file-username ( path string -- ) - username-id f set-file-ids ; +M: string set-file-user ( path string -- ) + user-id f set-file-ids ; M: integer set-file-group ( path gid -- ) f swap set-file-ids ; @@ -244,11 +244,11 @@ M: string set-file-group ( path string -- ) group-id f swap set-file-ids ; -: file-username-id ( path -- uid ) +: file-user-id ( path -- uid ) normalize-path file-info uid>> ; : file-username ( path -- string ) - file-username-id username ; + file-user-id username ; : file-group-id ( path -- gid ) normalize-path file-info gid>> ; From 5b86d3a51e5b3cc4e3b2428359ca8e07acfe99c9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 14:40:19 -0500 Subject: [PATCH 225/244] mac bootstrap --- basis/unix/bsd/macosx/macosx.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/bsd/macosx/macosx.factor b/basis/unix/bsd/macosx/macosx.factor index ed2bdecf61..c41ae6df7d 100644 --- a/basis/unix/bsd/macosx/macosx.factor +++ b/basis/unix/bsd/macosx/macosx.factor @@ -1,4 +1,4 @@ -USING: alien.syntax ; +USING: alien.syntax unix.time ; IN: unix : FD_SETSIZE 1024 ; inline From a78636024ca2eec808e8a97562d113ebddde25b8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 14:57:53 -0500 Subject: [PATCH 226/244] don't define structs in the same file as the constants --- basis/unix/bsd/netbsd/structs/structs.factor | 29 ++++++++++++++++++++ basis/unix/bsd/netbsd/structs/tags.txt | 1 + 2 files changed, 30 insertions(+) create mode 100644 basis/unix/bsd/netbsd/structs/structs.factor create mode 100644 basis/unix/bsd/netbsd/structs/tags.txt diff --git a/basis/unix/bsd/netbsd/structs/structs.factor b/basis/unix/bsd/netbsd/structs/structs.factor new file mode 100644 index 0000000000..f1a5ed09c0 --- /dev/null +++ b/basis/unix/bsd/netbsd/structs/structs.factor @@ -0,0 +1,29 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax vocabs.loader ; +IN: unix + +C-STRUCT: sockaddr_storage + { "__uint8_t" "ss_len" } + { "sa_family_t" "ss_family" } + { { "char" _SS_PAD1SIZE } "__ss_pad1" } + { "__int64_t" "__ss_align" } + { { "char" _SS_PAD2SIZE } "__ss_pad2" } ; + +C-STRUCT: exit_struct + { "uint16_t" "e_termination" } + { "uint16_t" "e_exit" } ; + +C-STRUCT: utmpx + { { "char" _UTX_USERSIZE } "ut_user" } + { { "char" _UTX_IDSIZE } "ut_id" } + { { "char" _UTX_LINESIZE } "ut_line" } + { { "char" _UTX_HOSTSIZE } "ut_host" } + { "uint16_t" "ut_session" } + { "uint16_t" "ut_type" } + { "pid_t" "ut_pid" } + { "exit_struct" "ut_exit" } + { "sockaddr_storage" "ut_ss" } + { "timeval" "ut_tv" } + { { "uint32_t" 10 } "ut_pad" } ; + diff --git a/basis/unix/bsd/netbsd/structs/tags.txt b/basis/unix/bsd/netbsd/structs/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/unix/bsd/netbsd/structs/tags.txt @@ -0,0 +1 @@ +unportable From 8627a30b6c4be00f34f3497c874693e01c0fcf97 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 14:58:16 -0500 Subject: [PATCH 227/244] remove old structs --- basis/unix/bsd/netbsd/netbsd.factor | 24 +----------------------- 1 file changed, 1 insertion(+), 23 deletions(-) diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/bsd/netbsd/netbsd.factor index 6bae953938..c82259d48a 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/bsd/netbsd/netbsd.factor @@ -131,26 +131,4 @@ TYPEDEF: __uint8_t sa_family_t : _SS_PAD2SIZE ( -- n ) _SS_MAXSIZE 2 - _SS_PAD1SIZE - _SS_ALIGNSIZE - ; inline -C-STRUCT: sockaddr_storage - { "__uint8_t" "ss_len" } - { "sa_family_t" "ss_family" } - { { "char" _SS_PAD1SIZE } "__ss_pad1" } - { "__int64_t" "__ss_align" } - { { "char" _SS_PAD2SIZE } "__ss_pad2" } ; - -C-STRUCT: exit_struct - { "uint16_t" "e_termination" } - { "uint16_t" "e_exit" } ; - -C-STRUCT: utmpx - { { "char" _UTX_USERSIZE } "ut_user" } - { { "char" _UTX_IDSIZE } "ut_id" } - { { "char" _UTX_LINESIZE } "ut_line" } - { { "char" _UTX_HOSTSIZE } "ut_host" } - { "uint16_t" "ut_session" } - { "uint16_t" "ut_type" } - { "pid_t" "ut_pid" } - { "exit_struct" "ut_exit" } - { "sockaddr_storage" "ut_ss" } - { "timeval" "ut_tv" } - { { "uint32_t" 10 } "ut_pad" } ; +"unix.bsd.netbsd.structs" require From 967a8375ec93c310b7306494759435ce3a781e00 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 14:59:05 -0500 Subject: [PATCH 228/244] fix using --- basis/unix/bsd/netbsd/netbsd.factor | 2 +- basis/unix/bsd/netbsd/structs/structs.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/unix/bsd/netbsd/netbsd.factor b/basis/unix/bsd/netbsd/netbsd.factor index c82259d48a..ca42b7840c 100644 --- a/basis/unix/bsd/netbsd/netbsd.factor +++ b/basis/unix/bsd/netbsd/netbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax alien.c-types math ; +USING: alien.syntax alien.c-types math vocabs.loader ; IN: unix : FD_SETSIZE 256 ; inline diff --git a/basis/unix/bsd/netbsd/structs/structs.factor b/basis/unix/bsd/netbsd/structs/structs.factor index f1a5ed09c0..ced6f6df5d 100644 --- a/basis/unix/bsd/netbsd/structs/structs.factor +++ b/basis/unix/bsd/netbsd/structs/structs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax vocabs.loader ; +USING: alien.syntax ; IN: unix C-STRUCT: sockaddr_storage From b7095ff39ff5eafb0a2e149ffebb909bcb6fb18c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 15:14:08 -0500 Subject: [PATCH 229/244] fix using --- basis/unix/bsd/netbsd/structs/structs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/unix/bsd/netbsd/structs/structs.factor b/basis/unix/bsd/netbsd/structs/structs.factor index ced6f6df5d..dba7590a93 100644 --- a/basis/unix/bsd/netbsd/structs/structs.factor +++ b/basis/unix/bsd/netbsd/structs/structs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.syntax ; +USING: alien.syntax unix.time ; IN: unix C-STRUCT: sockaddr_storage From 031ebe98b1565f5cc9adbefb278d2bcdb4258531 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 15:57:47 -0500 Subject: [PATCH 230/244] largert group buffer, openbsd apparently keeps the microseconds in their file timestamps. fix unit tests for this --- basis/io/unix/files/files-tests.factor | 4 ++-- basis/unix/groups/groups.factor | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/io/unix/files/files-tests.factor b/basis/io/unix/files/files-tests.factor index 28c25c0964..5a24c1314a 100644 --- a/basis/io/unix/files/files-tests.factor +++ b/basis/io/unix/files/files-tests.factor @@ -92,7 +92,7 @@ prepare-test-file test-file now [ set-file-access-time ] 2keep [ file-info accessed>> ] - [ [ truncate >integer ] change-second ] bi* = + [ [ [ truncate >integer ] change-second ] bi@ ] bi* = ] unit-test [ t ] @@ -100,7 +100,7 @@ prepare-test-file test-file now [ set-file-modified-time ] 2keep [ file-info modified>> ] - [ [ truncate >integer ] change-second ] bi* = + [ [ [ truncate >integer ] change-second ] bi@ ] bi* = ] unit-test [ t ] diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 7f3aa9ae98..c3af9cc83d 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -26,7 +26,7 @@ GENERIC: group-struct ( obj -- group ) ] [ ] produce nip ; : (group-struct) ( id -- group-struct id group-struct byte-array length void* ) - "group" tuck 1024 + "group" tuck 4096 [ ] keep f ; M: integer group-struct ( id -- group ) From ea69c8996fe9f20f304b8b00af034c15f9f66773 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 8 Oct 2008 19:06:19 -0500 Subject: [PATCH 231/244] use ERROR:, inline database combinator examples --- basis/db/db-docs.factor | 4 ++-- basis/db/sqlite/sqlite.factor | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 16a8228fca..7c84e6205e 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -285,7 +285,7 @@ ARTICLE: "db-custom-database-combinators" "Custom database combinators" { $code <" USING: db.sqlite db io.files ; : with-sqlite-db ( quot -- ) - "my-database.db" temp-file swap with-db ;"> } + "my-database.db" temp-file swap with-db ; inline"> } "PostgreSQL example combinator:" { $code <" USING: db.postgresql db ; @@ -296,7 +296,7 @@ USING: db.sqlite db io.files ; "erg" >>username "secrets?" >>password "factor-test" >>database - swap with-db ;"> + swap with-db ; inline"> } ; ABOUT: "db" diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 8580b9012c..4aa41483d8 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -87,9 +87,11 @@ M: sqlite-statement bind-tuple ( tuple statement -- ) in-params>> [ sqlite-bind-conversion ] with map ] keep bind-statement ; +ERROR: sqlite-last-id-fail ; + : last-insert-id ( -- id ) db get handle>> sqlite3_last_insert_rowid - dup zero? [ "last-id failed" throw ] when ; + dup zero? [ sqlite-last-id-fail ] when ; M: sqlite-db insert-tuple-set-key ( tuple statement -- ) execute-statement last-insert-id swap set-primary-key ; From d2dd7288b3a09fc2c9daae82725b6495bfcd4f3c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 8 Oct 2008 23:43:37 -0500 Subject: [PATCH 232/244] Fix parser bug with multi-line tuple literals --- core/classes/tuple/parser/parser-tests.factor | 13 +++++++++++++ core/classes/tuple/parser/parser.factor | 1 + 2 files changed, 14 insertions(+) diff --git a/core/classes/tuple/parser/parser-tests.factor b/core/classes/tuple/parser/parser-tests.factor index 17376a594f..6b9a953ab9 100644 --- a/core/classes/tuple/parser/parser-tests.factor +++ b/core/classes/tuple/parser/parser-tests.factor @@ -96,3 +96,16 @@ TUPLE: syntax-test bar baz ; [ T{ syntax-test } ] [ T{ syntax-test } ] unit-test [ T{ syntax-test f { 2 3 } { 4 { 5 } } } ] [ T{ syntax-test { bar { 2 3 } } { baz { 4 { 5 } } } } ] unit-test + +! Corner case +TUPLE: parsing-corner-case x ; + +[ T{ parsing-corner-case f 3 } ] [ + { + "USE: classes.tuple.parser.tests" + "T{ parsing-corner-case" + " f" + " 3" + "}" + } "\n" join eval +] unit-test diff --git a/core/classes/tuple/parser/parser.factor b/core/classes/tuple/parser/parser.factor index dd78b4ba3e..7888635641 100644 --- a/core/classes/tuple/parser/parser.factor +++ b/core/classes/tuple/parser/parser.factor @@ -86,6 +86,7 @@ ERROR: bad-literal-tuple ; : parse-tuple-literal ( -- tuple ) scan-word scan { + { f [ unexpected-eof ] } { "f" [ \ } parse-until boa>tuple ] } { "{" [ parse-slot-values assoc>tuple ] } { "}" [ new ] } From 6130aeb88f9a926786ab1419e8a4deebd8d7033b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 9 Oct 2008 00:13:04 -0500 Subject: [PATCH 233/244] Fix fep looping --- vm/debug.c | 8 ++++++++ vm/debug.h | 2 ++ vm/errors.c | 6 +++--- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/vm/debug.c b/vm/debug.c index b374aceb9f..0869d6a885 100755 --- a/vm/debug.c +++ b/vm/debug.c @@ -325,6 +325,12 @@ void find_code_references(CELL look_for_) void factorbug(void) { + if(fep_disabled) + { + printf("Low level debugger disabled\n"); + exit(1); + } + open_console(); printf("Starting low level debugger...\n"); @@ -366,6 +372,8 @@ void factorbug(void) dump stacks. This is useful for builder and other cases where Factor is run with stdin redirected to /dev/null */ + fep_disabled = true; + print_datastack(); print_retainstack(); print_callstack(); diff --git a/vm/debug.h b/vm/debug.h index 2ca6f8944c..547fdba436 100755 --- a/vm/debug.h +++ b/vm/debug.h @@ -4,4 +4,6 @@ void dump_generations(void); void factorbug(void); void dump_zone(F_ZONE *z); +bool fep_disabled; + DECLARE_PRIMITIVE(die); diff --git a/vm/errors.c b/vm/errors.c index f2147041a2..7a23e3e53f 100755 --- a/vm/errors.c +++ b/vm/errors.c @@ -57,10 +57,10 @@ void throw_error(CELL error, F_STACK_FRAME *callstack_top) crash. */ else { - fprintf(stderr,"You have triggered a bug in Factor. Please report.\n"); - fprintf(stderr,"early_error: "); + printf("You have triggered a bug in Factor. Please report.\n"); + printf("early_error: "); print_obj(error); - fprintf(stderr,"\n"); + printf("\n"); factorbug(); } } From bb6b99868607ada1b51a025238b7eae5843fc050 Mon Sep 17 00:00:00 2001 From: sheeple Date: Thu, 9 Oct 2008 14:04:33 -0500 Subject: [PATCH 234/244] Fix alien-indirect on ppc --- basis/cpu/ppc/architecture/architecture.factor | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor index 357349193e..117ab51fe2 100644 --- a/basis/cpu/ppc/architecture/architecture.factor +++ b/basis/cpu/ppc/architecture/architecture.factor @@ -96,9 +96,9 @@ M: ppc %epilogue ( n -- ) 1 1 rot ADDI 0 MTLR ; -: (%call) ( -- ) 11 MTLR BLRL ; +: (%call) ( reg -- ) MTLR BLRL ; -: (%jump) ( -- ) 11 MTCTR BCTR ; +: (%jump) ( reg -- ) MTCTR BCTR ; : %load-dlsym ( symbol dll register -- ) 0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ; @@ -117,7 +117,7 @@ M: ppc %dispatch ( -- ) "offset" operand "n" operand 1 SRAWI 11 11 "offset" operand ADD 11 dup 6 cells LWZ - (%jump) + 11 (%jump) ] H{ { +input+ { { f "n" } } } { +scratch+ { { f "offset" } } } @@ -244,17 +244,17 @@ M: ppc %prepare-alien-invoke rs-reg 11 12 STW ; M: ppc %alien-invoke ( symbol dll -- ) - 11 %load-dlsym (%call) ; + 11 %load-dlsym 11 (%call) ; M: ppc %alien-callback ( quot -- ) 3 load-indirect "c_to_factor" f %alien-invoke ; M: ppc %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke - 3 11 MR ; + 13 3 MR ; M: ppc %alien-indirect ( -- ) - (%call) ; + 13 (%call) ; M: ppc %callback-value ( ctype -- ) ! Save top of data stack From 7b9a3b61c35c78ba40794a5fac792934fc712293 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 9 Oct 2008 14:07:11 -0500 Subject: [PATCH 235/244] partial fix for db, going to make it use dispose* soon --- basis/db/db.factor | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/basis/db/db.factor b/basis/db/db.factor index bf23005bc2..a124914a35 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -6,6 +6,7 @@ tools.walker accessors combinators fry ; IN: db TUPLE: db + disposed handle insert-statements update-statements @@ -24,12 +25,10 @@ HOOK: db-close db ( handle -- ) : db-dispose ( db -- ) dup db [ - { - [ insert-statements>> dispose-statements ] - [ update-statements>> dispose-statements ] - [ delete-statements>> dispose-statements ] - [ handle>> db-close ] - } cleave + [ dispose-statements H{ } clone ] change-insert-statements + [ dispose-statements H{ } clone ] change-update-statements + [ dispose-statements H{ } clone ] change-delete-statements + handle>> db-close ] with-variable ; TUPLE: result-set sql in-params out-params handle n max ; From 83f1634219f2a281a27d138466aa007313e6b89d Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 9 Oct 2008 15:42:23 -0500 Subject: [PATCH 236/244] clean up dispose a bit --- basis/db/db.factor | 6 +++--- basis/db/postgresql/postgresql.factor | 4 ++-- basis/db/sqlite/sqlite.factor | 1 - 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/basis/db/db.factor b/basis/db/db.factor index a124914a35..3ee0fe3d09 100644 --- a/basis/db/db.factor +++ b/basis/db/db.factor @@ -6,7 +6,6 @@ tools.walker accessors combinators fry ; IN: db TUPLE: db - disposed handle insert-statements update-statements @@ -23,12 +22,13 @@ HOOK: db-close db ( handle -- ) : dispose-statements ( assoc -- ) values dispose-each ; -: db-dispose ( db -- ) +M: db dispose ( db -- ) dup db [ [ dispose-statements H{ } clone ] change-insert-statements [ dispose-statements H{ } clone ] change-update-statements [ dispose-statements H{ } clone ] change-delete-statements - handle>> db-close + [ db-close f ] change-handle + drop ] with-variable ; TUPLE: result-set sql in-params out-params handle n max ; diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 08df25c13a..f9c9ea73ec 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -30,8 +30,8 @@ M: postgresql-db db-open ( db -- db ) [ password>> ] } cleave connect-postgres >>handle ; -M: postgresql-db dispose ( db -- ) - handle>> PQfinish ; +M: postgresql-db db-close ( handle -- ) + PQfinish ; M: postgresql-statement bind-statement* ( statement -- ) drop ; diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 4aa41483d8..216f324bbf 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -19,7 +19,6 @@ M: sqlite-db db-open ( db -- db ) dup path>> sqlite-open >>handle ; M: sqlite-db db-close ( handle -- ) sqlite-close ; -M: sqlite-db dispose ( db -- ) db-dispose ; TUPLE: sqlite-statement < statement ; From ace2ce2ce7a069f60239b346af0e4abc108dd88e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 9 Oct 2008 16:40:19 -0500 Subject: [PATCH 237/244] remove old word --- basis/db/db-docs.factor | 4 ---- 1 file changed, 4 deletions(-) diff --git a/basis/db/db-docs.factor b/basis/db/db-docs.factor index 7c84e6205e..52dc389fe6 100644 --- a/basis/db/db-docs.factor +++ b/basis/db/db-docs.factor @@ -26,10 +26,6 @@ HELP: dispose-statements { $values { "assoc" assoc } } { $description "Disposes an associative list of statements." } ; -HELP: db-dispose -{ $values { "db" db } } -{ $description "Disposes of all the statements stored in the " { $link db } " object." } ; - HELP: statement { $description "A " { $snippet "statement" } " stores the information about a statemen, such as the SQL statement text, the in/out parameters, and type information." } ; From 620f4e96a3338a4b61a6696979703afac7ac68a8 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Fri, 10 Oct 2008 16:48:07 +1100 Subject: [PATCH 238/244] Jamshred is working again, hopefully even less buggy than ever! --- extra/jamshred/game/game.factor | 2 +- extra/jamshred/gl/gl.factor | 3 ++- extra/jamshred/jamshred.factor | 4 ++-- extra/jamshred/player/player.factor | 28 ++++++++++++++++++++-------- extra/jamshred/sound/sound.factor | 2 ++ extra/jamshred/tunnel/tunnel.factor | 4 ++-- 6 files changed, 29 insertions(+), 14 deletions(-) diff --git a/extra/jamshred/game/game.factor b/extra/jamshred/game/game.factor index 938605ce9f..9cb5bc7c3a 100644 --- a/extra/jamshred/game/game.factor +++ b/extra/jamshred/game/game.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2007 Alex Chapman +! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel opengl arrays sequences jamshred.log jamshred.player jamshred.sound jamshred.tunnel math math.constants math.vectors ; IN: jamshred.game diff --git a/extra/jamshred/gl/gl.factor b/extra/jamshred/gl/gl.factor index 69af7ab986..6c553147a1 100644 --- a/extra/jamshred/gl/gl.factor +++ b/extra/jamshred/gl/gl.factor @@ -41,8 +41,9 @@ IN: jamshred.gl : equally-spaced-radians ( n -- seq ) #! return a sequence of n numbers between 0 and 2pi dup [ / pi 2 * * ] curry map ; + : draw-segment-vertex ( segment theta -- ) - over color>> gl-color segment-vertex-and-normal + over color>> set-color segment-vertex-and-normal gl-normal gl-vertex ; : draw-vertex-pair ( theta next-segment segment -- ) diff --git a/extra/jamshred/jamshred.factor b/extra/jamshred/jamshred.factor index aa9c164b8f..2357742fde 100755 --- a/extra/jamshred/jamshred.factor +++ b/extra/jamshred/jamshred.factor @@ -23,7 +23,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- ) ] [ [ jamshred>> jamshred-update ] [ relayout-1 ] - [ yield jamshred-loop ] tri + [ 10 sleep yield jamshred-loop ] tri ] if ; : fullscreen ( gadget -- ) @@ -36,7 +36,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- ) [ fullscreen? not ] keep set-fullscreen* ; M: jamshred-gadget graft* ( gadget -- ) - [ jamshred-loop ] in-thread drop ; + [ jamshred-loop ] curry in-thread ; M: jamshred-gadget ungraft* ( gadget -- ) jamshred>> t swap (>>quit) ; diff --git a/extra/jamshred/player/player.factor b/extra/jamshred/player/player.factor index 418847673b..72f26a2c79 100644 --- a/extra/jamshred/player/player.factor +++ b/extra/jamshred/player/player.factor @@ -1,9 +1,15 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle system ; +USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle strings system ; IN: jamshred.player -TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; +TUPLE: player < oint + { name string } + { sounds sounds } + tunnel + nearest-segment + { last-move integer } + { speed float } ; ! speeds are in GL units / second : default-speed ( -- speed ) 1.0 ; @@ -11,7 +17,7 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; : ( name sounds -- player ) [ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip - f f f default-speed player boa ; + f f 0 default-speed player boa ; : turn-player ( player x-radians y-radians -- ) >r over r> left-pivot up-pivot ; @@ -69,6 +75,9 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; : distance-to-collision ( player -- distance ) dup nearest-segment>> (distance-to-collision) ; +: almost-to-collision ( player -- distance ) + distance-to-collision 0.1 - dup 0 < [ drop 0 ] when ; + : from ( player -- radius distance-from-centre ) [ nearest-segment>> dup radius>> swap ] [ location>> ] bi distance-from-centre ; @@ -93,14 +102,17 @@ TUPLE: player < oint name sounds tunnel nearest-segment last-move speed ; heading player update-nearest-segment2 d-left d-to-move - player ] ; -: move-toward-wall ( d-left player d-to-wall -- d-left' player ) - over [ forward>> ] keep distance-to-heading-segment-area min - over forward>> move-player-on-heading ; +: distance-to-move-freely ( player -- distance ) + [ almost-to-collision ] + [ [ forward>> ] keep distance-to-heading-segment-area ] bi min ; : ?move-player-freely ( d-left player -- d-left' player ) over 0 > [ - dup distance-to-collision dup 0.2 > [ ! bug! should be 0, not 0.2 - move-toward-wall ?move-player-freely + ! must make sure we are moving a significant distance, otherwise + ! we can recurse endlessly due to floating-point imprecision. + ! (at least I /think/ that's what causes it...) + dup distance-to-move-freely dup 0.1 > [ + over forward>> move-player-on-heading ?move-player-freely ] [ drop ] if ] when ; diff --git a/extra/jamshred/sound/sound.factor b/extra/jamshred/sound/sound.factor index fd1b1127bd..c19c67671f 100644 --- a/extra/jamshred/sound/sound.factor +++ b/extra/jamshred/sound/sound.factor @@ -1,3 +1,5 @@ +! Copyright (C) 2008 Alex Chapman +! See http://factorcode.org/license.txt for BSD license. USING: accessors io.files kernel openal sequences ; IN: jamshred.sound diff --git a/extra/jamshred/tunnel/tunnel.factor b/extra/jamshred/tunnel/tunnel.factor index 8d2cc8e766..7082acec47 100755 --- a/extra/jamshred/tunnel/tunnel.factor +++ b/extra/jamshred/tunnel/tunnel.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007, 2008 Alex Chapman ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays combinators float-arrays kernel jamshred.oint locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ; +USING: accessors arrays colors combinators float-arrays kernel jamshred.oint locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences vectors ; USE: tools.walker IN: jamshred.tunnel @@ -13,7 +13,7 @@ C: segment [ number>> 1+ ] keep (>>number) ; : random-color ( -- color ) - { 100 100 100 } [ random 100 / >float ] map { 1.0 } append ; + { 100 100 100 } [ random 100 / >float ] map first3 1.0 ; : tunnel-segment-distance ( -- n ) 0.4 ; : random-rotation-angle ( -- theta ) pi 20 / ; From f1286a353f1e24a8036628323a3e75ae2d4fcc32 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 10 Oct 2008 13:43:58 -0500 Subject: [PATCH 239/244] Fix typo --- core/alien/alien-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 814ca8613e..ce3497439a 100644 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -302,8 +302,8 @@ ARTICLE: "embedding" "Embedding Factor into C applications" "The Factor " { $snippet "Makefile" } " builds the Factor VM both as an executable and a library. The library can be used by other applications. File names for the library on various operating systems:" { $table { "OS" "Library name" "Shared?" } - { "Windows XP/Vista" { $snippet "factor-nt.dll" } "Yes" } - { "Windows CE" { $snippet "factor-ce.dll" } "Yes" } + { "Windows XP/Vista" { $snippet "factor.dll" } "Yes" } + ! { "Windows CE" { $snippet "factor-ce.dll" } "Yes" } { "Mac OS X" { $snippet "libfactor.dylib" } "Yes" } { "Other Unix" { $snippet "libfactor.a" } "No" } } From 2779103b63c5d596ceef6430796fe61b91d2bcec Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 10 Oct 2008 15:32:36 -0500 Subject: [PATCH 240/244] add on-update --- basis/db/postgresql/postgresql.factor | 1 + basis/db/sqlite/sqlite.factor | 1 + basis/db/types/types.factor | 4 ++-- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index f9c9ea73ec..2b4cadf489 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -230,6 +230,7 @@ M: postgresql-db persistent-table ( -- hashtable ) { +foreign-id+ { f f "references" } } + { +on-update+ { f f "on update" } } { +on-delete+ { f f "on delete" } } { +restrict+ { f f "restrict" } } { +cascade+ { f f "cascade" } } diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 216f324bbf..93135a23e3 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -178,6 +178,7 @@ M: sqlite-db persistent-table ( -- assoc ) { +random-id+ { "integer" "integer" f } } { +foreign-id+ { "integer" "integer" "references" } } + { +on-update+ { f f "on update" } } { +on-delete+ { f f "on delete" } } { +restrict+ { f f "restrict" } } { +cascade+ { f f "cascade" } } diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index ac9e3397f8..ad9c9b0acf 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -26,8 +26,8 @@ SINGLETONS: +db-assigned-id+ +user-assigned-id+ +random-id+ ; UNION: +primary-key+ +db-assigned-id+ +user-assigned-id+ +random-id+ ; SYMBOLS: +autoincrement+ +serial+ +unique+ +default+ +null+ +not-null+ -+foreign-id+ +has-many+ +on-delete+ +restrict+ +cascade+ +set-null+ -+set-default+ ; ++foreign-id+ +has-many+ +on-update+ +on-delete+ +restrict+ +cascade+ ++set-null+ +set-default+ ; SYMBOL: IGNORE From ad533918066481c633c2afbe84b3b5fbc3de8610 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 10 Oct 2008 20:52:28 -0500 Subject: [PATCH 241/244] make all types singletons instead of symbols, add NULL support for select statements --- basis/db/queries/queries.factor | 3 +++ basis/db/tuples/tuples-tests.factor | 7 ++++++- basis/db/types/types.factor | 2 +- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 768ec70185..3cf4d98215 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -114,6 +114,9 @@ M: sequence where ( spec obj -- ) [ " or " 0% ] [ dupd where ] interleave drop ] in-parens ; +M: NULL where ( spec obj -- ) + drop column-name>> 0% " is NULL" 0% ; + : object-where ( spec obj -- ) over column-name>> 0% " = " 0% bind# ; diff --git a/basis/db/tuples/tuples-tests.factor b/basis/db/tuples/tuples-tests.factor index f5569a97cd..192986484e 100644 --- a/basis/db/tuples/tuples-tests.factor +++ b/basis/db/tuples/tuples-tests.factor @@ -472,7 +472,12 @@ TUPLE: exam id name score ; T{ exam } select-tuples ] unit-test - [ 4 ] [ T{ exam } count-tuples ] unit-test ; + [ 4 ] [ T{ exam } count-tuples ] unit-test + + [ ] [ T{ exam { score 10 } } insert-tuple ] unit-test + + [ 10 ] + [ T{ exam { name NULL } } select-tuples first score>> ] unit-test ; TUPLE: bignum-test id m n o ; : ( m n o -- obj ) diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index ad9c9b0acf..6a889689ce 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -91,7 +91,7 @@ ERROR: not-persistent class ; : relation? ( spec -- ? ) [ +has-many+ = ] deep-find ; -SYMBOLS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER +SINGLETONS: INTEGER BIG-INTEGER SIGNED-BIG-INTEGER UNSIGNED-BIG-INTEGER DOUBLE REAL BOOLEAN TEXT VARCHAR DATE TIME DATETIME TIMESTAMP BLOB FACTOR-BLOB NULL URL ; From 3161a85736c77f7d49f14d0fde67ec5cea1e57ee Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 11 Oct 2008 00:35:19 -0600 Subject: [PATCH 242/244] fix calculator --- extra/webapps/calculator/calculator.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/calculator/calculator.factor b/extra/webapps/calculator/calculator.factor index f1416fb02d..d19946d39b 100644 --- a/extra/webapps/calculator/calculator.factor +++ b/extra/webapps/calculator/calculator.factor @@ -33,7 +33,7 @@ TUPLE: calculator < dispatcher ; ! Deployment example USING: db.sqlite furnace.alloy namespaces http.server ; -: calculator-db ( -- params db ) "calculator.db" sqlite-db ; +: calculator-db ( -- db ) "calculator.db" ; : run-calculator ( -- ) From 3368866fc307616f529ced38971bbc4213fbad77 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 12 Oct 2008 07:25:03 -0600 Subject: [PATCH 243/244] fix counter --- extra/webapps/counter/counter.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/webapps/counter/counter.factor b/extra/webapps/counter/counter.factor index a5c9fbc6b9..d62096fffc 100644 --- a/extra/webapps/counter/counter.factor +++ b/extra/webapps/counter/counter.factor @@ -32,7 +32,7 @@ M: counter-app init-session* drop 0 count sset ; ! Deployment example USING: db.sqlite furnace.alloy namespaces ; -: counter-db ( -- params db ) "counter.db" sqlite-db ; +: counter-db ( -- db ) "counter.db" ; : run-counter ( -- ) From 72be15283234e99acea31c451d1ae8293a65ed06 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 12 Oct 2008 07:25:16 -0600 Subject: [PATCH 244/244] fix db tutorial --- basis/db/tuples/tuples-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/db/tuples/tuples-docs.factor b/basis/db/tuples/tuples-docs.factor index 02f5dfa38c..51830ee610 100644 --- a/basis/db/tuples/tuples-docs.factor +++ b/basis/db/tuples/tuples-docs.factor @@ -229,7 +229,7 @@ T{ book "Now we've created a book. Let's save it to the database." { $code <" USING: db db.sqlite fry io.files ; : with-book-tutorial ( quot -- ) - '[ "book-tutorial.db" temp-file sqlite-db _ with-db ] call ; + '[ "book-tutorial.db" temp-file _ with-db ] call ; [ book recreate-table