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

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." } ;
@@ -46,25 +49,41 @@ 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: <simple-statement>
 { $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 <prepared-statement> } " as the sole kind of statement; simple statements alias to prepared ones." } ;
 
 HELP: <prepared-statement>
 { $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 +180,18 @@ 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" }
-;
+{ $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."
@@ -234,32 +249,54 @@ 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" } "."
-;
-
-ARTICLE: "db-porting-the-library" "Porting the database library"
-"There are two layers to implement when porting the database library."
-{ $subsection "db-protocol" }
-;
+"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 <sqlite-db> 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-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 <sqlite-db> rot with-db ;"> } 
+    "my-database.db" temp-file <sqlite-db> swap with-db ;"> } 
 
+"PostgreSQL example combinator:"
 { $code <" USING: db.postgresql db ;
 : with-postgresql-db ( quot -- )
     <postgresql-db>
         "localhost" >>host
+        5432 >>port
         "erg" >>username
         "secrets?" >>password
         "factor-test" >>database
     swap with-db ;">
-}
-
-;
+} ;
 
 ABOUT: "db"

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 <simple-statement> [ default-query ] with-disposal ;
 
-: sql-command ( sql -- )
-    dup string? [
-        f f <simple-statement> [ execute-statement ] with-disposal
-    ] [
-        ! [
-            [ sql-command ] each
-        ! ] with-transaction
-    ] if ;
+: (sql-command) ( string -- )
+    f f <simple-statement> [ 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 ( -- )

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

basis/db/tuples/tuples-docs.factor

@@ -1,9 +1,63 @@
 ! 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: 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: <count-statement>
+{ $values
+     { "query" query }
+     { "statement" statement } }
+{ $description "A database-specific hook for generating the SQL for a count statement." } ;
+
+HELP: <delete-tuples-statement>
+{ $values
+     { "tuple" tuple } { "class" class }
+     { "object" object } }
+{ $description "A database-specific hook for generating the SQL for an delete statement." } ;
+
+HELP: <insert-db-assigned-statement>
+{ $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: <insert-user-assigned-statement>
+{ $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: <select-by-slots-statement>
+{ $values
+     { "tuple" tuple } { "class" class }
+     { "tuple" tuple } }
+{ $description "A database-specific hook for generating the SQL for a select statement." } ;
+
+HELP: <update-tuple-statement>
+{ $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 +182,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 <insert-db-assigned-statement> }
+{ $subsection <insert-user-assigned-statement> }
+"Updating a tuple:"
+{ $subsection <update-tuple-statement> }
+"Deleting tuples:"
+{ $subsection <delete-tuples-statement> }
+"Selecting tuples:"
+{ $subsection <select-by-slots-statement> }
+"Counting tuples:"
+{ $subsection <count-statement> } ;
 
 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

basis/db/tuples/tuples.factor

@@ -6,8 +6,6 @@ math.parser io prettyprint db.types continuations
 destructors mirrors sets db.types ;
 IN: db.tuples
 
-<PRIVATE
-
 HOOK: create-sql-statement db ( class -- object )
 HOOK: drop-sql-statement db ( class -- object )
 
@@ -18,10 +16,12 @@ HOOK: <delete-tuples-statement> db ( tuple class -- object )
 HOOK: <select-by-slots-statement> db ( tuple class -- tuple )
 HOOK: <count-statement> db ( query -- statement )
 HOOK: query>statement db ( query -- statement )
-
 HOOK: insert-tuple-set-key db ( tuple statement -- )
 
+<PRIVATE
+
 SYMBOL: sql-counter
+
 : next-sql-counter ( -- str )
     sql-counter [ inc ] [ get ] bi number>string ;
 
@@ -68,7 +68,6 @@ GENERIC: eval-generator ( singleton -- object )
 
 PRIVATE>
 
-
 ! High level
 ERROR: no-slots-named class seq ;
 : check-columns ( class columns -- )

basis/heaps/authors.txt

@@ -1,2 +1,3 @@
 Doug Coleman
 Ryan Murphy
+Slava Pestov

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 ;
 

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

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 => <range> ;
 IN: math.intervals
 
 SYMBOL: empty-interval
@@ -396,3 +397,37 @@ SYMBOL: incomparable
         [ to>> first2 [ 1- ] unless ]
         bi [a,b]
     ] unless ;
+
+<PRIVATE
+
+: open-left? ( interval -- ? ) from>> 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 <range> 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 ;

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 <mersenne-twister> 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

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"

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

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 ;
 
+<PRIVATE
+
+: random-integer ( n -- n' )
+    dup log2 7 + 8 /i 1+
+    [ random-bytes byte-array>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
 

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)." }

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" = ;

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

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>

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." } ;

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 ;
 
 <PRIVATE
 
-: relative-url? ( url -- ? ) protocol>> 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 ;