Merge branch 'master' into new_ui

basis/csv/csv-tests.factor

@@ -1,11 +1,11 @@
-USING: io.streams.string csv tools.test shuffle kernel strings
+USING: io.streams.string csv tools.test kernel strings
 io.pathnames io.files.unique io.encodings.utf8 io.files
 io.directories ;
 IN: csv.tests
 
 ! I like to name my unit tests
 : named-unit-test ( name output input -- ) 
-  nipd unit-test ; inline
+  unit-test drop ; inline
 
 ! tests nicked from the wikipedia csv article
 ! http://en.wikipedia.org/wiki/Comma-separated_values

basis/db/postgresql/lib/lib.factor

@@ -3,7 +3,7 @@
 USING: arrays continuations db io kernel math namespaces
 quotations sequences db.postgresql.ffi alien alien.c-types
 db.types tools.walker ascii splitting math.parser combinators
-libc shuffle calendar.format byte-arrays destructors prettyprint
+libc calendar.format byte-arrays destructors prettyprint
 accessors strings serialize io.encodings.binary io.encodings.utf8
 alien.strings io.streams.byte-array summary present urls
 specialized-arrays.uint specialized-arrays.alien db.private ;
@@ -117,7 +117,7 @@ M: postgresql-result-null summary ( obj -- str )
 
 : pq-get-string ( handle row column -- obj )
     3dup PQgetvalue utf8 alien>string
-    dup empty? [ [ pq-get-is-null f ] dip ? ] [ 3nip ] if ;
+    dup empty? [ [ pq-get-is-null f ] dip ? ] [ [ 3drop ] dip ] if ;
 
 : pq-get-number ( handle row column -- obj )
     pq-get-string dup [ string>number ] when ;
@@ -134,7 +134,7 @@ M: postgresql-malloc-destructor dispose ( obj -- )
 : pq-get-blob ( handle row column -- obj/f )
     [ PQgetvalue ] 3keep 3dup PQgetlength
     dup 0 > [
-        3nip
+        [ 3drop ] dip
         [
             memory>byte-array >string
             0 <uint>

basis/furnace/chloe-tags/chloe-tags.factor

@@ -81,11 +81,18 @@ CHLOE: a
 CHLOE: base
     compile-a-url [ [XML <base href=<->/> XML] ] [xml-code] ;
 
+: hidden-nested-fields ( -- xml )
+    nested-forms get " " join f like nested-forms-key
+    hidden-form-field ;
+
+: render-hidden ( for -- xml )
+    [ "," split [ hidden render>xml ] map ] [ f ] if* ;
+
 : compile-hidden-form-fields ( for -- )
     '[
-        _ [ "," split [ hidden render>xml ] map ] [ f ] if*
+        _ render-hidden
-        nested-forms get " " join f like nested-forms-key hidden-form-field>xml
+        hidden-nested-fields
-        [ [ modify-form ] each-responder ] with-string-writer <unescaped>
+        form-modifications
         [XML <div style="display: none;"><-><-><-></div> XML]
     ] [code] ;
 

basis/furnace/furnace-tests.factor

@@ -1,7 +1,7 @@
 IN: furnace.tests
 USING: http http.server.dispatchers http.server.responses
 http.server furnace furnace.utilities tools.test kernel
-namespaces accessors io.streams.string urls ;
+namespaces accessors io.streams.string urls xml.writer ;
 TUPLE: funny-dispatcher < dispatcher ;
 
 : <funny-dispatcher> funny-dispatcher new-dispatcher ;
@@ -31,7 +31,7 @@ M: base-path-check-responder call-responder*
 ] unit-test
 
 [ "<input type=\"hidden\" value=\"&amp;&amp;&amp;\" name=\"foo\"/>" ]
-[ [ "&&&" "foo" hidden-form-field ] with-string-writer ]
+[ "&&&" "foo" hidden-form-field xml>string ]
 unit-test
 
 [ f ] [ <request> request [ referrer ] with-variable ] unit-test

basis/furnace/utilities/utilities-docs.factor

@@ -20,13 +20,13 @@ HELP: each-responder
 { $description "Applies the quotation to each responder involved in processing the current request." } ;
 
 HELP: hidden-form-field
-{ $values { "value" string } { "name" string } }
+{ $values { "value" string } { "name" string } { "xml" "an XML chunk" } }
-{ $description "Renders an HTML hidden form field tag." }
+{ $description "Renders an HTML hidden form field tag as XML." }
 { $notes "This word is used by session management, conversation scope and asides." }
 { $examples
     { $example
-        "USING: furnace.utilities io ;"
+        "USING: furnace.utilities io xml.writer ;"
-        "\"bar\" \"foo\" hidden-form-field nl"
+        "\"bar\" \"foo\" hidden-form-field write-xml nl"
         "<input type=\"hidden\" value=\"bar\" name=\"foo\"/>"
     }
 } ;
@@ -38,7 +38,7 @@ HELP: link-attr
 { $examples "Conversation scope adds attributes to link tags." } ;
 
 HELP: modify-form
-{ $values { "responder" "a responder" } }
+{ $values { "responder" "a responder" } { "xml/f" "an XML chunk or f" } }
 { $contract "Emits hidden form fields using " { $link hidden-form-field } "." }
 { $notes "This word is called by " { $link "html.templates.chloe.tags.form" } "." }
 { $examples "Session management, conversation scope and asides use hidden form fields to pass state." } ;

basis/furnace/utilities/utilities.factor

@@ -77,18 +77,18 @@ GENERIC: link-attr ( tag responder -- )
 
 M: object link-attr 2drop ;
 
-GENERIC: modify-form ( responder -- )
+GENERIC: modify-form ( responder -- xml/f )
 
-M: object modify-form drop ;
+M: object modify-form drop f ;
 
-: hidden-form-field>xml ( value name -- xml )
+: form-modifications ( -- xml )
+    [ [ modify-form [ , ] when* ] each-responder ] { } make ;
+
+: hidden-form-field ( value name -- xml )
     over [
         [XML <input type="hidden" value=<-> name=<->/> XML]
     ] [ drop ] if ;
 
-: hidden-form-field ( value name -- )
-    hidden-form-field>xml write-xml ;
-
 : nested-forms-key "__n" ;
 
 : request-params ( request -- assoc )

basis/generalizations/generalizations-docs.factor

@@ -58,7 +58,7 @@ HELP: npick
 "placed on the top of the stack."
 }
 { $examples
-  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 npick .s" "1\n2\n3\n4\n1" }
+  { $example "USING: kernel prettyprint generalizations ;" "1 2 3 4 4 npick .s clear" "1\n2\n3\n4\n1" }
   "Some core words expressed in terms of " { $link npick } ":"
     { $table
         { { $link dup } { $snippet "1 npick" } }
@@ -75,7 +75,7 @@ HELP: ndup
 "placed on the top of the stack."
 }
 { $examples
-  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 ndup .s" "1\n2\n3\n4\n1\n2\n3\n4" }
+  { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 ndup .s clear" "1\n2\n3\n4\n1\n2\n3\n4" }
   "Some core words expressed in terms of " { $link ndup } ":"
     { $table
         { { $link dup } { $snippet "1 ndup" } }
@@ -91,7 +91,7 @@ HELP: nnip
 "for any number of items."
 }
 { $examples
-  { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 nnip .s" "4" }
+  { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 nnip .s clear" "4" }
   "Some core words expressed in terms of " { $link nnip } ":"
     { $table
         { { $link nip } { $snippet "1 nnip" } }
@@ -106,7 +106,7 @@ HELP: ndrop
 "for any number of items."
 }
 { $examples
-  { $example "USING: prettyprint generalizations ;" "1 2 3 4 3 ndrop .s" "1" }
+  { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 3 ndrop .s clear" "1" }
   "Some core words expressed in terms of " { $link ndrop } ":"
     { $table
         { { $link drop } { $snippet "1 ndrop" } }
@@ -121,7 +121,7 @@ HELP: nrot
 "number of items on the stack. "
 }
 { $examples
-  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 nrot .s" "2\n3\n4\n1" }
+  { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 nrot .s clear" "2\n3\n4\n1" }
   "Some core words expressed in terms of " { $link nrot } ":"
     { $table
         { { $link swap } { $snippet "1 nrot" } }
@@ -135,7 +135,7 @@ HELP: -nrot
 "number of items on the stack. "
 }
 { $examples
-  { $example "USING: prettyprint generalizations ;" "1 2 3 4 4 -nrot .s" "4\n1\n2\n3" }
+  { $example "USING: prettyprint generalizations kernel ;" "1 2 3 4 4 -nrot .s clear" "4\n1\n2\n3" }
   "Some core words expressed in terms of " { $link -nrot } ":"
     { $table
         { { $link swap } { $snippet "1 -nrot" } }
@@ -151,8 +151,8 @@ HELP: ndip
 "stack. The quotation can consume and produce any number of items."
 } 
 { $examples
-  { $example "USING: generalizations kernel prettyprint ;" "1 2 [ dup ] 1 ndip .s" "1\n1\n2" }
+  { $example "USING: generalizations kernel prettyprint kernel ;" "1 2 [ dup ] 1 ndip .s clear" "1\n1\n2" }
-  { $example "USING: generalizations kernel prettyprint ;" "1 2 3 [ drop ] 2 ndip .s" "2\n3" }
+  { $example "USING: generalizations kernel prettyprint kernel ;" "1 2 3 [ drop ] 2 ndip .s clear" "2\n3" }
   "Some core words expressed in terms of " { $link ndip } ":"
     { $table
         { { $link dip } { $snippet "1 ndip" } }
@@ -168,7 +168,7 @@ HELP: nslip
 "removed from the stack, the quotation called, and the items restored."
 } 
 { $examples
-  { $example "USING: generalizations prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s" "99\n1\n2\n3\n4\n5" }
+  { $example "USING: generalizations kernel prettyprint ;" "[ 99 ] 1 2 3 4 5 5 nslip .s clear" "99\n1\n2\n3\n4\n5" }
   "Some core words expressed in terms of " { $link nslip } ":"
     { $table
         { { $link slip } { $snippet "1 nslip" } }
@@ -184,7 +184,7 @@ HELP: nkeep
 "saved, the quotation called, and the items restored."
 } 
 { $examples
-  { $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s" "99\n1\n2\n3\n4\n5" }
+  { $example "USING: generalizations kernel prettyprint ;" "1 2 3 4 5 [ drop drop drop drop drop 99 ] 5 nkeep .s clear" "99\n1\n2\n3\n4\n5" }
   "Some core words expressed in terms of " { $link nkeep } ":"
     { $table
         { { $link keep } { $snippet "1 nkeep" } }

basis/lists/lazy/lazy-docs.factor

@@ -1,11 +1,54 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-
 USING: help.markup help.syntax sequences strings lists ;
 IN: lists.lazy 
 
+ABOUT: "lists.lazy"
+
+ARTICLE: "lists.lazy" "Lazy lists"
+"The " { $vocab-link "lists.lazy" } " vocabulary implements lazy lists and standard operations to manipulate them."
+{ $subsection { "lists.lazy" "construction" } }
+{ $subsection { "lists.lazy" "manipulation" } }
+{ $subsection { "lists.lazy" "combinators" } }
+{ $subsection { "lists.lazy" "io" } } ;
+
+ARTICLE: { "lists.lazy" "combinators" } "Combinators for manipulating lazy lists"
+"The following combinators create lazy lists from other lazy lists:"
+{ $subsection lmap }
+{ $subsection lfilter }
+{ $subsection luntil }
+{ $subsection lwhile }
+{ $subsection lfrom-by }
+{ $subsection lcomp }
+{ $subsection lcomp* } ;
+
+ARTICLE: { "lists.lazy" "io" } "Lazy list I/O"
+"Input from a stream can be read through a lazy list, using the following words:"
+{ $subsection lcontents }
+{ $subsection llines } ;
+
+ARTICLE: { "lists.lazy" "construction" } "Constructing lazy lists"
+"Words for constructing lazy lists:"
+{ $subsection lazy-cons }
+{ $subsection 1lazy-list }
+{ $subsection 2lazy-list }
+{ $subsection 3lazy-list }
+{ $subsection seq>list }
+{ $subsection >list }
+{ $subsection lfrom } ;
+
+ARTICLE: { "lists.lazy" "manipulation" } "Manipulating lazy lists"
+"To make new lazy lists from old ones:"
+{ $subsection <memoized-cons> }
+{ $subsection lappend }
+{ $subsection lconcat }
+{ $subsection lcartesian-product }
+{ $subsection lcartesian-product* }
+{ $subsection lmerge }
+{ $subsection ltake } ;
+
 HELP: lazy-cons
-{ $values { "car" { $quotation "( -- X )" } } { "cdr" { $quotation "( -- cons )" } } { "promise" "the resulting cons object" } }
+{ $values { "car" { $quotation "( -- elt )" } } { "cdr" { $quotation "( -- cons )" } } { "promise" "the resulting cons object" } }
 { $description "Constructs a cons object for a lazy list from two quotations. The " { $snippet "car" } " quotation should return the head of the list, and the " { $snippet "cons" } " quotation the tail when called. When " { $link cons } " or " { $link cdr } " are called on the lazy-cons object then the appropriate quotation is called." } 
 { $see-also cons car cdr nil nil? } ;
 
@@ -28,16 +71,12 @@ HELP: <memoized-cons>
 { $description "Constructs a cons object that wraps an existing cons object. Requests for the car, cdr and nil? will be remembered after the first call, and the previous result returned on subsequent calls." } 
 { $see-also cons car cdr nil nil? } ;
 
-{ lazy-map lazy-map-with ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
+{ lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
 
 HELP: lazy-map
 { $values { "list" "a cons object" } { "quot" { $quotation "( obj -- X )" } } { "result" "resulting cons object" } }
 { $description "Perform a similar functionality to that of the " { $link map } " word, but in a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-map> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ;
 
-HELP: lazy-map-with
-{ $values { "value" "an object" } { "list" "a cons object" } { "quot" { $quotation "( obj elt -- X )" } } { "result" "resulting cons object" } }
-{ $description "Variant of " { $link lazy-map } " which pushes a retained object on each invocation of the quotation." } ;
-
 HELP: ltake
 { $values { "n" "a non negative integer" } { "list" "a cons object" } { "result" "resulting cons object" } }
 { $description "Outputs a lazy list containing the first n items in the list. This is done a lazy manner. No evaluation of the list elements occurs initially but a " { $link <lazy-take> } " object is returned which conforms to the list protocol. Calling " { $link car } ", " { $link cdr } " or " { $link nil? } " on this will evaluate elements as required." } ;
@@ -86,7 +125,7 @@ HELP: >list
 { $description "Convert the object into a list. Existing lists are passed through intact, sequences are converted using " { $link seq>list } " and other objects cause an error to be thrown." } 
 { $see-also seq>list } ;
     
-{ leach foldl lazy-map lazy-map-with ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
+{ leach foldl lazy-map ltake lfilter lappend lfrom lfrom-by lconcat lcartesian-product lcartesian-product* lcomp lcomp* lmerge lwhile luntil } related-words
 
 HELP: lconcat
 { $values { "list" "a list of lists" } { "result" "a list" } }

basis/lists/lazy/lazy-tests.factor

@@ -24,7 +24,7 @@ IN: lists.lazy.tests
 ] unit-test
 
 [ { 4 5 6 } ] [ 
-    3 { 1 2 3 } >list [ + ] lazy-map-with list>array
+    3 { 1 2 3 } >list [ + ] with lazy-map list>array
 ] unit-test
 
 [ [ ] lmap ] must-infer

basis/lists/lazy/lazy.factor

@@ -90,9 +90,6 @@ M: lazy-map cdr ( lazy-map -- cdr )
 M: lazy-map nil? ( lazy-map -- bool )
     cons>> nil? ;
 
-: lazy-map-with ( value list quot -- result )
-    with lazy-map ;
-
 TUPLE: lazy-take n cons ;
 
 C: <lazy-take> lazy-take
@@ -125,7 +122,7 @@ M: lazy-until car ( lazy-until -- car )
      cons>> car ;
 
 M: lazy-until cdr ( lazy-until -- cdr )
-     [ cons>> uncons ] keep quot>> tuck call( elt -- ? )
+     [ cons>> unswons ] keep quot>> tuck call( elt -- ? )
      [ 2drop nil ] [ luntil ] if ;
 
 M: lazy-until nil? ( lazy-until -- bool )
@@ -284,7 +281,7 @@ DEFER: lconcat
     dup nil? [
         drop nil
     ] [
-        uncons swap (lconcat)
+        uncons (lconcat)
     ] if ;
 
 M: lazy-concat car ( lazy-concat -- car )
@@ -301,14 +298,14 @@ M: lazy-concat nil? ( lazy-concat -- bool )
     ] if ;
 
 : lcartesian-product ( list1 list2 -- result )
-    swap [ swap [ 2array ] lazy-map-with  ] lazy-map-with  lconcat ;
+    swap [ swap [ 2array ] with lazy-map  ] with lazy-map  lconcat ;
 
 : lcartesian-product* ( lists -- result )
     dup nil? [
         drop nil
     ] [
         [ car ] keep cdr [ car lcartesian-product ] keep cdr list>array swap [
-            swap [ swap [ suffix ] lazy-map-with  ] lazy-map-with  lconcat
+            swap [ swap [ suffix ] with lazy-map  ] with lazy-map  lconcat
         ] reduce
     ] if ;
 

basis/lists/lists-docs.factor

@@ -1,15 +1,68 @@
 ! Copyright (C) 2006 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel help.markup help.syntax ;
+USING: kernel help.markup help.syntax arrays sequences math quotations ;
-
 IN: lists
 
-{ car cons cdr nil nil? list? uncons } related-words
+ABOUT: "lists"
+
+ARTICLE: "lists" "Lists"
+"The " { $vocab-link "lists" } " vocabulary implements linked lists. There are simple strict linked lists, but a generic list protocol allows the implementation of lazy lists as well."
+{ $subsection { "lists" "protocol" } }
+{ $subsection { "lists" "strict" } }
+{ $subsection { "lists" "manipulation" } }
+{ $subsection { "lists" "combinators" } }
+{ $vocab-subsection "Lazy lists" "lists.lazy" } ;
+
+ARTICLE: { "lists" "protocol" } "The list protocol"
+"Lists are instances of a mixin class"
+{ $subsection list }
+"Instances of the mixin must implement the following words:"
+{ $subsection car }
+{ $subsection cdr }
+{ $subsection nil? } ;
+
+ARTICLE: { "lists" "strict" } "Strict lists"
+"Strict lists are simply cons cells where the car and cdr have already been evaluated. These are the lists of Lisp. To construct a strict list, the following words are provided:"
+{ $subsection cons }
+{ $subsection swons }
+{ $subsection sequence>cons }
+{ $subsection deep-sequence>cons }
+{ $subsection 1list }
+{ $subsection 2list }
+{ $subsection 3list } ;
+
+ARTICLE: { "lists" "combinators" } "Combinators for lists"
+"Several combinators exist for list traversal."
+{ $subsection leach }
+{ $subsection lmap }
+{ $subsection foldl }
+{ $subsection foldr }
+{ $subsection lmap>array }
+{ $subsection lmap-as }
+{ $subsection traverse } ;
+
+ARTICLE: { "lists" "manipulation" } "Manipulating lists"
+"To get at the contents of a list:"
+{ $subsection uncons }
+{ $subsection unswons }
+{ $subsection lnth }
+{ $subsection cadr }
+{ $subsection llength }
+"To get a new list from an old one:"
+{ $subsection lreverse }
+{ $subsection lappend }
+{ $subsection lcut } ;
 
 HELP: cons 
-{ $values { "car" "the head of the lazy list" } { "cdr" "the tail of the lazy list" } { "cons" "a cons object" } }
+{ $values { "car" "the head of the list cell" } { "cdr" "the tail of the list cell" } { "cons" "a cons object" } }
 { $description "Constructs a cons cell." } ;
 
+HELP: swons 
+{ $values { "cdr" "the tail of the list cell" } { "car" "the head of the list cell" } { "cons" "a cons object" } }
+{ $description "Constructs a cons cell." } ;
+
+{ cons swons uncons unswons } related-words
+
 HELP: car
 { $values { "cons" "a cons object" } { "car" "the first item in the list" } }
 { $description "Returns the first item in the list." } ;
@@ -17,7 +70,9 @@ HELP: car
 HELP: cdr
 { $values { "cons" "a cons object" } { "cdr" "a cons object" } }
 { $description "Returns the tail of the list." } ;
-    
+
+{ car cdr } related-words
+
 HELP: nil 
 { $values { "symbol" "The empty cons (+nil+)" } }
 { $description "Returns a symbol representing the empty list" } ;
@@ -26,6 +81,8 @@ HELP: nil?
 { $values { "object" object } { "?" "a boolean" } }
 { $description "Return true if the cons object is the nil cons." } ;
 
+{ nil nil? } related-words
+
 HELP: list? ( object -- ? )
 { $values { "object" "an object" } { "?" "a boolean" } }
 { $description "Returns true if the object conforms to the list protocol." } ;
@@ -43,7 +100,7 @@ HELP: 2list
 HELP: 3list
 { $values { "a" "an object" } { "b" "an object" } { "c" "an object" } { "cons" "a cons object" } }
 { $description "Create a list with 3 elements." } ;
-    
+
 HELP: lnth
 { $values { "n" "an integer index" } { "list" "a cons object" } { "elt" "the element at the nth index" } }
 { $description "Outputs the nth element of the list." } 
@@ -55,7 +112,11 @@ HELP: llength
 { $see-also lnth cons car cdr } ;
 
 HELP: uncons
-{ $values { "cons" "a cons object" }  { "cdr" "the tail of the list" } { "car" "the head of the list" } }
+{ $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } }
+{ $description "Put the head and tail of the list on the stack." } ;
+
+HELP: unswons
+{ $values { "cons" "a cons object" } { "car" "the head of the list" } { "cdr" "the tail of the list" } }
 { $description "Put the head and tail of the list on the stack." } ;
 
 { leach foldl lmap>array } related-words
@@ -75,30 +136,52 @@ HELP: foldr
 HELP: lmap
 { $values { "list" "a cons object" } { "quot" { $quotation "( old -- new )" } } { "result" "the final result" } }
 { $description "Applies the quotation to each element of the list in order, collecting the new elements into a new list." } ;
-    
+
 HELP: lreverse
-{ $values { "list" "a cons object" } { "newlist" "a new cons object" } }
+{ $values { "list" list } { "newlist" list } }
-{ $description "Reverses the input list, outputing a new, reversed list" } ;
+{ $description "Reverses the input list, outputing a new, reversed list. The output is a strict cons list." } ;
-    
+
-HELP: list>seq    
+HELP: list>array    
-{ $values { "list" "a cons object" } { "array" "an array object" } }
+{ $values { "list" "a cons object" } { "array" array } }
 { $description "Turns the given cons object into an array, maintaing order." } ;
-    
+
-HELP: seq>list
+HELP: sequence>cons
-{ $values { "seq" "a sequence" } { "list" "a cons object" } }
+{ $values { "sequence" sequence } { "list" cons } }
 { $description "Turns the given array into a cons object, maintaing order." } ;
-    
+
-HELP: cons>seq
+HELP: deep-list>array
-{ $values { "cons" "a cons object" } { "array" "an array object" } }
+{ $values { "list" list } { "array" array } }
 { $description "Recursively turns the given cons object into an array, maintaing order and also converting nested lists." } ;
-    
+
-HELP: seq>cons
+HELP: deep-sequence>cons
-{ $values { "seq" "a sequence object" } { "cons" "a cons object" } }
+{ $values { "sequence" sequence } { "cons" cons } }
 { $description "Recursively turns the given sequence into a cons object, maintaing order and also converting nested lists." } ;
-    
+
 HELP: traverse    
 { $values { "list"  "a cons object" } { "pred" { $quotation "( list/elt -- ? )" } }
           { "quot" { $quotation "( list/elt -- result)" } }  { "result" "a new cons object" } }
 { $description "Recursively traverses the list object, replacing any elements (which can themselves be sublists) that pred" 
-    " returns true for with the result of applying quot to." } ;
+ " returns true for with the result of applying quot to." } ;
-    
+
+HELP: list
+{ $class-description "The class of lists. All lists are expected to conform to " { $link { "lists" "protocol" } } "." } ;
+
+HELP: cadr
+{ $values { "list" list } { "elt" object } }
+{ $description "Returns the second element of the list, ie the car of the cdr." } ;
+
+HELP: lappend
+{ $values { "list1" list } { "list2" list } { "newlist" list } }
+{ $description "Appends the two lists to form a new list. The first list must be finite. The result is a strict cons cell, and the first list is exausted." } ;
+
+HELP: lcut
+{ $values { "list" list } { "index" integer } { "before" cons } { "after" cons } }
+{ $description "Analogous to " { $link cut } ", this word cuts a list into two pieces at the given index." } ;
+
+HELP: lmap>array
+{ $values { "list" list } { "quot" quotation } { "array" array } }
+{ $description "Executes the quotation on each element of the list, collecting the results in an array." } ;
+
+HELP: lmap-as
+{ $values { "list" list } { "quot" quotation } { "exemplar" sequence } { "sequence" sequence } }
+{ $description "Executes the quotation on each element of the list, collecting the results in a sequence of the type given by the exemplar." } ;

basis/lists/lists-tests.factor

@@ -1,11 +1,10 @@
 ! Copyright (C) 2008 James Cash
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test lists math ;
+USING: tools.test lists math kernel ;
-
 IN: lists.tests
 
 { { 3 4 5 6 7 } } [
-    { 1 2 3 4 5 } seq>list [ 2 + ] lmap list>seq 
+    { 1 2 3 4 5 } sequence>cons [ 2 + ] lmap list>array
 ] unit-test
 
 { { 3 4 5 6 } } [
@@ -38,33 +37,35 @@ IN: lists.tests
                           +nil+ } } }
           +nil+ } } }
 } [
-    { 1 2 { 3 4 { 5 } } } seq>cons
+    { 1 2 { 3 4 { 5 } } } deep-sequence>cons
 ] unit-test
     
 { { 1 2 { 3 4 { 5 } } } } [
-  { 1 2 { 3 4 { 5 } } } seq>cons cons>seq
+  { 1 2 { 3 4 { 5 } } } deep-sequence>cons deep-list>array
 ] unit-test
     
 { T{ cons f 2 T{ cons f 3 T{ cons f 4 T{ cons f 5 +nil+ } } } } } [
-    { 1 2 3 4 } seq>cons [ 1+ ] lmap
+    { 1 2 3 4 } sequence>cons [ 1+ ] lmap
 ] unit-test
     
 { 15 } [
- { 1 2 3 4 5 } seq>list 0 [ + ] foldr
+ { 1 2 3 4 5 } sequence>cons 0 [ + ] foldr
 ] unit-test
     
 { { 5 4 3 2 1 } } [
-    { 1 2 3 4 5 } seq>list lreverse list>seq
+    { 1 2 3 4 5 } sequence>cons lreverse list>array
 ] unit-test
     
 { 5 } [
-    { 1 2 3 4 5 } seq>list llength
+    { 1 2 3 4 5 } sequence>cons llength
 ] unit-test
     
 { { 3 4 { 5 6 { 7 } } } } [
-  { 1 2 { 3 4 { 5 } } } seq>cons [ atom? ] [ 2 + ] traverse cons>seq
+  { 1 2 { 3 4 { 5 } } } deep-sequence>cons [ atom? ] [ 2 + ] traverse deep-list>array
 ] unit-test
     
 { { 1 2 3 4 5 6 } } [
-    { 1 2 3 } seq>list { 4 5 6 } seq>list lappend list>seq
+    { 1 2 3 } sequence>cons { 4 5 6 } sequence>cons lappend list>array
-] unit-test
+] unit-test
+
+[ { 1 } { 2 } ] [ { 1 2 } sequence>cons 1 lcut [ list>array ] bi@ ] unit-test

basis/lists/lists.factor

@@ -1,15 +1,16 @@
 ! Copyright (C) 2008 James Cash
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences accessors math arrays vectors classes words locals ;
+USING: kernel sequences accessors math arrays vectors classes words
+combinators.short-circuit combinators locals ;
 IN: lists
 
 ! List Protocol
 MIXIN: list
-GENERIC: car   ( cons -- car )
+GENERIC: car ( cons -- car )
-GENERIC: cdr   ( cons -- cdr )
+GENERIC: cdr ( cons -- cdr )
-GENERIC: nil?  ( object -- ?   )
+GENERIC: nil? ( object -- ?   )
     
-TUPLE: cons car cdr ;
+TUPLE: cons { car read-only } { cdr read-only } ;
 
 C: cons cons
 
@@ -18,41 +19,53 @@ M: cons car ( cons -- car )
 
 M: cons cdr ( cons -- cdr )
     cdr>> ;
-    
+
-SYMBOL: +nil+
+SINGLETON: +nil+
-M: word nil? +nil+ eq? ;
+M: +nil+ nil? drop t ;
 M: object nil? drop f ;
-    
+
-: atom? ( obj -- ? ) [ list? ] [ nil? ] bi or not ;
+: atom? ( obj -- ? )
+    list? not ;
 
 : nil ( -- symbol ) +nil+ ; 
-    
+
-: uncons ( cons -- cdr car )
+: uncons ( cons -- car cdr )
-    [ cdr ] [ car ] bi ;
+    [ car ] [ cdr ] bi ;
-    
+
+: swons ( cdr car -- cons )
+    swap cons ;
+
+: unswons ( cons -- cdr car )
+    uncons swap ;
+
 : 1list ( obj -- cons )
     nil cons ;
-    
+
+: 1list? ( list -- ? )
+    { [ nil? not ] [ cdr nil? ] } 1&& ;
+
 : 2list ( a b -- cons )
     nil cons cons ;
 
 : 3list ( a b c -- cons )
     nil cons cons cons ;
-    
+
-: cadr ( cons -- elt )    
+: cadr ( list -- elt )    
     cdr car ;
-    
+ 
-: 2car ( cons -- car caar )    
+: 2car ( list -- car caar )    
     [ car ] [ cdr car ] bi ;
-    
+ 
-: 3car ( cons -- car cadr caddr )    
+: 3car ( list -- car cadr caddr )    
     [ car ] [ cdr car ] [ cdr cdr car ] tri ;
 
 : lnth ( n list -- elt )
     swap [ cdr ] times car ;
-    
+
+<PRIVATE
 : (leach) ( list quot -- cdr quot )
     [ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline
+PRIVATE>
 
 : leach ( list quot: ( elt -- ) -- )
     over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive
@@ -63,49 +76,72 @@ M: object nil? drop f ;
 : foldl ( list identity quot: ( obj1 obj2 -- obj ) -- result )
     swapd leach ; inline
 
-: foldr ( list identity quot: ( obj1 obj2 -- obj ) -- result )
+:: foldr ( list identity quot: ( obj1 obj2 -- obj ) -- result )
-    pick nil? [ [ drop ] [ ] [ drop ] tri* ] [
+    list nil? [ identity ] [
-        [ [ cdr ] 2dip foldr ] [ nip [ car ] dip ] 3bi
+        list cdr identity quot foldr
-        call
+        list car quot call
     ] if ; inline recursive
 
 : llength ( list -- n )
     0 [ drop 1+ ] foldl ;
-    
+
 : lreverse ( list -- newlist )    
     nil [ swap cons ] foldl ;
-    
+
 : lappend ( list1 list2 -- newlist )    
     [ lreverse ] dip [ swap cons ] foldl ;
-    
+
-: seq>list ( seq -- list )    
+: lcut ( list index -- before after )
+    [ nil ] dip
+    [ [ [ cdr ] [ car ] bi ] dip cons ] times
+    lreverse swap ;
+
+: sequence>cons ( sequence -- list )    
     <reversed> nil [ swap cons ] reduce ;
-    
+
+<PRIVATE
 : same? ( obj1 obj2 -- ? ) 
     [ class ] bi@ = ;
-    
+PRIVATE>
-: seq>cons ( seq -- cons )
+
-    [ <reversed> ] keep nil [ tuck same? [ seq>cons ] when f cons swap >>cdr ] with reduce ;
+: deep-sequence>cons ( sequence -- cons )
-    
+    [ <reversed> ] keep nil
-: (lmap>array) ( acc cons quot: ( elt -- elt' ) -- newcons )
+    [ tuck same? [ deep-sequence>cons ] when swons ] with reduce ;
-    over nil? [ 2drop ]
+
-    [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ;
+<PRIVATE
-    inline recursive
+:: (lmap>vector) ( acc list quot: ( elt -- elt' ) -- acc )
-    
+    list nil? [ acc ] [
-: lmap>array ( cons quot -- newcons )
+        list car quot call acc push
-    { } -rot (lmap>array) ; inline
+        acc list cdr quot (lmap>vector)
-    
+    ] if ; inline recursive
-: lmap-as ( cons quot exemplar -- seq )
+
-    [ lmap>array ] dip like ;
+: lmap>vector ( list quot -- array )
-    
+    [ V{ } clone ] 2dip (lmap>vector) ; inline
-: cons>seq ( cons -- array )    
+PRIVATE>
-    [ dup cons? [ cons>seq ] when dup nil? [ drop { } ] when ] lmap>array ;
+
-    
+: lmap-as ( list quot exemplar -- sequence )
-: list>seq ( list -- array )    
+    [ lmap>vector ] dip like ; inline
+
+: lmap>array ( list quot -- array )
+    { } lmap-as ; inline
+
+: deep-list>array ( list -- array )    
+    [
+        {
+            { [ dup nil? ] [ drop { } ] }
+            { [ dup list? ] [ deep-list>array ] }
+            [ ]
+        } cond
+    ] lmap>array ;
+
+: list>array ( list -- array )    
     [ ] lmap>array ;
-    
+
-: traverse ( list pred quot: ( list/elt -- result ) -- result )
+:: traverse ( list pred quot: ( list/elt -- result ) -- result )
-    [ 2over call [ tuck [ call ] 2dip ] when
+    list [| elt |
-      pick list? [ traverse ] [ 2drop ] if ] 2curry lmap ; inline recursive
+        elt dup pred call [ quot call ] when
-    
+        dup list? [ pred quot traverse ] when
+    ] lmap ; inline recursive
+
 INSTANCE: cons list
+INSTANCE: +nil+ list

basis/math/polynomials/polynomials.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel make math math.order math.vectors sequences shuffle
+USING: arrays kernel make math math.order math.vectors sequences
     splitting vectors ;
 IN: math.polynomials
 
@@ -75,7 +75,7 @@ PRIVATE>
 PRIVATE>
 
 : pgcd ( p q -- a d )
-    swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) [ >array ] bi@ ;
+    [ V{ 0 } clone V{ 1 } clone ] 2dip swap (pgcd) [ >array ] bi@ ;
 
 : pdiff ( p -- p' )
     dup length v* { 0 } ?head drop ;

basis/persistent/deques/deques-docs.factor

@@ -1,3 +1,5 @@
+! Copyright (C) 2008 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax kernel sequences ;
 IN: persistent.deques
 

basis/persistent/deques/deques.factor

@@ -1,7 +1,6 @@
-! Copyback (C) 2008 Daniel Ehrenberg
+! Copyright (C) 2008 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors math lists ;
+USING: kernel accessors math lists sequences combinators.short-circuit ;
-QUALIFIED: sequences
 IN: persistent.deques
 
 ! Amortized O(1) push/pop on both ends for single-threaded access
@@ -9,30 +8,13 @@ IN: persistent.deques
 !   same source, it could take O(m) amortized time per update.
 
 <PRIVATE
-
-: each ( list quot: ( elt -- ) -- )
-    over
-    [ [ [ car ] dip call ] [ [ cdr ] dip ] 2bi each ]
-    [ 2drop ] if ; inline recursive
-
-: reduce ( list start quot -- end )
-    swapd each ; inline
-
-: reverse ( list -- reversed )
-    f [ swap cons ] reduce ;
-
-: length ( list -- length )
-    0 [ drop 1+ ] reduce ;
-
-: cut ( list index -- back front-reversed )
-    f swap [ [ [ cdr ] [ car ] bi ] dip cons ] times ;
-
 : split-reverse ( list -- back-reversed front )
-    dup length 2/ cut [ reverse ] bi@ ;
+    dup llength 2/ lcut lreverse swap ;
 PRIVATE>
 
 TUPLE: deque { front read-only } { back read-only } ;
-: <deque> ( -- deque ) T{ deque } ;
+: <deque> ( -- deque )
+    T{ deque f +nil+ +nil+ } ;
 
 <PRIVATE
 : flip ( deque -- newdeque )
@@ -43,7 +25,7 @@ TUPLE: deque { front read-only } { back read-only } ;
 PRIVATE>
 
 : deque-empty? ( deque -- ? )
-    [ front>> ] [ back>> ] bi or not ;
+    { [ front>> nil? ] [ back>> nil? ] } 1&& ;
 
 <PRIVATE
 : push ( item deque -- newdeque )
@@ -61,11 +43,12 @@ PRIVATE>
     [ front>> car ] [ [ front>> cdr ] [ back>> ] bi deque boa ] bi ; inline
 
 : transfer ( deque -- item newdeque )
-    back>> [ split-reverse deque boa remove ]
+    back>> dup nil?
-    [ "Popping from an empty deque" throw ] if* ; inline
+    [ "Popping from an empty deque" throw ]
+    [ split-reverse deque boa remove ] if ; inline
 
 : pop ( deque -- item newdeque )
-    dup front>> [ remove ] [ transfer ] if ; inline
+    dup front>> nil? [ transfer ] [ remove ] if ; inline
 PRIVATE>
 
 : pop-front ( deque -- item newdeque )
@@ -74,12 +57,14 @@ PRIVATE>
 : pop-back ( deque -- item newdeque )
     [ pop ] flipped ;
 
-: peek-front ( deque -- item ) pop-front drop ;
+: peek-front ( deque -- item )
+    pop-front drop ;
 
-: peek-back ( deque -- item ) pop-back drop ;
+: peek-back ( deque -- item )
+    pop-back drop ;
 
 : sequence>deque ( sequence -- deque )
-    <deque> [ push-back ] sequences:reduce ;
+    <deque> [ push-back ] reduce ;
 
 : deque>sequence ( deque -- sequence )
-    [ dup deque-empty? not ] [ pop-front swap ] [ ] sequences:produce nip ;
+    [ dup deque-empty? not ] [ pop-front swap ] [ ] produce nip ;

basis/regexp/traversal/traversal.factor

@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs combinators kernel math
 quotations sequences regexp.parser regexp.classes fry arrays
-combinators.short-circuit regexp.utils prettyprint regexp.nfa
+combinators.short-circuit regexp.utils prettyprint regexp.nfa ;
-shuffle ;
 IN: regexp.traversal
 
 TUPLE: dfa-traverser
@@ -170,7 +169,7 @@ M: capture-group-off flag-action ( dfa-traverser flag -- )
     ] [ drop ] if ;
 
 : match-default ( transition from-state table -- to-state/f )
-    nipd transitions>> at t swap at ;
+    [ drop ] 2dip transitions>> at t swap at ;
 
 : match-transition ( obj from-state dfa -- to-state/f )
     { [ match-literal ] [ match-class ] [ match-default ] } 3|| ;

basis/shuffle/shuffle-tests.factor

@@ -1,5 +1,3 @@
 USING: shuffle tools.test ;
 
-[ 8 ] [ 5 6 7 8 3nip ] unit-test
-[ 3 1 2 3 ] [ 1 2 3 tuckd ] unit-test
 [ 1 2 3 4 ] [ 3 4 1 2 2swap ] unit-test

basis/shuffle/shuffle.factor

@@ -6,14 +6,6 @@ IN: shuffle
 
 : 2swap ( x y z t -- z t x y ) 2 2 mnswap ; inline
 
-: nipd ( a b c -- b c ) rot drop ; inline
-
-: 3nip ( a b c d -- d ) 3 nnip ; inline
-
-: 4nip ( a b c d e -- e ) 4 nnip ; inline
-
 : 4dup ( a b c d -- a b c d a b c d ) 4 ndup ; inline
 
 : 4drop ( a b c d -- ) 3drop drop ; inline
-
-: tuckd ( x y z -- z x y z ) 2 ntuck ; inline

basis/urls/urls-docs.factor

@@ -82,8 +82,8 @@ HELP: parse-host
 { $notes "This word is used by " { $link >url } ". It can also be used directly to parse " { $snippet "host:port" } " strings which are not full URLs." }
 { $examples
     { $example
-        "USING: prettyprint urls ;"
+        "USING: prettyprint urls kernel ;"
-        "\"sbcl.org:80\" parse-host .s"
+        "\"sbcl.org:80\" parse-host .s 2drop"
         "\"sbcl.org\"\n80"
     }
 } ;

basis/wrap/words/words.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences kernel splitting.monotonic accessors wrap grouping ;
+USING: sequences kernel splitting.monotonic accessors grouping wrap ;
 IN: wrap.words
 
 TUPLE: word key width break? ;

basis/wrap/wrap.factor

@@ -12,18 +12,6 @@ C: <element> element
 : element-length ( element -- n )
     [ black>> ] [ white>> ] bi + ;
 
-: swons ( cdr car -- cons )
-    swap cons ;
-
-: unswons ( cons -- cdr car )
-    [ cdr ] [ car ] bi ;
-
-: 1list? ( list -- ? )
-    { [ ] [ cdr +nil+ = ] } 1&& ;
-
-: lists>arrays ( lists -- arrays )
-    [ list>seq ] lmap>array ;
-
 TUPLE: paragraph lines head-width tail-cost ;
 C: <paragraph> paragraph
 
@@ -78,7 +66,7 @@ SYMBOL: line-ideal
     0 <paragraph> ;
 
 : post-process ( paragraph -- array )
-    lines>> lists>arrays
+    lines>> deep-list>array
     [ [ contents>> ] map ] map ;
 
 : initialize ( elements -- elements paragraph )

core/kernel/kernel-docs.factor

@@ -658,7 +658,7 @@ HELP: loop
     "hi hi hi" }
     "A fun loop:"
     { $example "USING: kernel prettyprint math ; "
-    "3 [ dup . 7 + 11 mod dup 3 = not ] loop"
+    "3 [ dup . 7 + 11 mod dup 3 = not ] loop drop"
     "3\n10\n6\n2\n9\n5\n1\n8\n4\n0\n7" }
 } ;
 

core/math/math-docs.factor

@@ -254,7 +254,7 @@ HELP: fp-infinity?
 { $description "Tests if " { $snippet "x" } " is an IEEE Infinity value. While " { $snippet "x" } " can be any real number, this word will only ever yield true if " { $snippet "x" } " is a " { $link float } "." }
 { $examples
     { $example "USING: math prettyprint ;" "1/0. fp-infinity? ." "t" }
-    { $example "USING: io kernel math ;" "-1/0. [ fp-infinity? ] [ 0 < ] bi [ \"negative infinity\" print ] when" "negative infinity" }
+    { $example "USING: io kernel math ;" "-1/0. [ fp-infinity? ] [ 0 < ] bi and [ \"negative infinity\" print ] when" "negative infinity" }
 } ;
 
 { fp-nan? fp-infinity? } related-words

extra/parser-combinators/parser-combinators.factor

@@ -17,7 +17,7 @@ ERROR: cannot-parse input ;
 
 : parse-1 ( input parser -- result )
     dupd parse dup nil? [
-        rot cannot-parse
+        swap cannot-parse
     ] [
         nip car parsed>>
     ] if ;
@@ -149,8 +149,8 @@ TUPLE: and-parser parsers ;
             [ parsed>> ] dip
             [ parsed>> 2array ] keep
             unparsed>> <parse-result>
-        ] lazy-map-with
+        ] with lazy-map
-    ] lazy-map-with lconcat ;
+    ] with lazy-map lconcat ;
 
 M: and-parser parse ( input parser -- list )
     #! Parse 'input' by sequentially combining the
@@ -173,7 +173,7 @@ M: or-parser parse ( input parser1 -- list )
     #! of parser1 and parser2 being applied to the same
     #! input. This implements the choice parsing operator.
     parsers>> 0 swap seq>list
-    [ parse ] lazy-map-with lconcat ;
+    [ parse ] with lazy-map lconcat ;
 
 : trim-head-slice ( string -- string )
     #! Return a new string without any leading whitespace
@@ -218,7 +218,7 @@ M: apply-parser parse ( input parser -- result )
     -rot parse [
         [ parsed>> swap call ] keep
         unparsed>> <parse-result>
-    ] lazy-map-with ;
+    ] with lazy-map ;
 
 TUPLE: some-parser p1 ;
 

extra/project-euler/002/002.factor

@@ -1,6 +1,6 @@
 ! Copyright (c) 2007, 2008 Aaron Schaefer, Alexander Solovyov, Vishal Talwar.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences shuffle ;
+USING: kernel math sequences ;
 IN: project-euler.002
 
 ! http://projecteuler.net/index.php?section=problems&id=2
@@ -41,7 +41,7 @@ PRIVATE>
 ! -------------------
 
 : fib-upto* ( n -- seq )
-    0 1 [ pick over >= ] [ tuck + dup ] [ ] produce 3nip
+    0 1 [ pick over >= ] [ tuck + dup ] [ ] produce [ 3drop ] dip
     but-last-slice { 0 1 } prepend ;
 
 : euler002a ( -- answer )

extra/project-euler/134/134.factor

@@ -39,7 +39,7 @@ IN: project-euler.134
 PRIVATE>
 
 : euler134 ( -- answer )
-    0 5 lprimes-from uncons swap [ 1000000 > ] luntil
+    0 5 lprimes-from uncons [ 1000000 > ] luntil
     [ [ s + ] keep ] leach drop ;
 
 ! [ euler134 ] 10 ave-time

extra/reports/noise/noise.factor

@@ -25,7 +25,6 @@ IN: reports.noise
         { 3drop 1 }
         { 3dup 2 }
         { 3keep 3 }
-        { 3nip 4 }
         { 3slip 3 }
         { 4drop 2 }
         { 4dup 3 }
@@ -50,7 +49,6 @@ IN: reports.noise
         { ndrop 2 }
         { ndup 3 }
         { nip 2 }
-        { nipd 3 }
         { nkeep 5 }
         { npick 6 }
         { nrot 5 }
@@ -66,7 +64,6 @@ IN: reports.noise
         { swap 1 }
         { swapd 3 }
         { tuck 2 }
-        { tuckd 4 }
         { with 1/2 }
 
         { bi 1/2 }