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

basis/alarms/alarms-docs.factor

@@ -9,13 +9,19 @@ HELP: add-alarm
 { $description "Creates and registers an alarm. If " { $snippet "frequency" } " is " { $link f } ", this will be a one-time alarm, otherwise it will fire with the given frequency. The quotation will be called from the alarm thread." } ;
 
 HELP: later
-{ $values { "quot" quotation } { "dt" duration } { "alarm" alarm } }
+{ $values { "quot" quotation } { "duration" duration } { "alarm" alarm } }
 { $description "Creates and registers an alarm which calls the quotation once at " { $snippet "time" } " from now." } ;
 
 HELP: cancel-alarm
 { $values { "alarm" alarm } }
 { $description "Cancels an alarm. Does nothing if the alarm is not active." } ;
 
+HELP: every
+{ $values
+     { "quot" quotation } { "duration" duration }
+     { "alarm" alarm } }
+{ $description "Creates and registers an alarm which calls the quotation repeatedly, using " { $snippet "dt" } " as the frequency." } ;
+
 ARTICLE: "alarms" "Alarms"
 "Alarms provide a lightweight way to schedule one-time and recurring tasks without spawning a new thread."
 { $subsection alarm }

basis/alarms/alarms.factor

@@ -82,10 +82,10 @@ PRIVATE>
 : add-alarm ( quot time frequency -- alarm )
     <alarm> [ register-alarm ] keep ;
 
-: later ( quot dt -- alarm )
+: later ( quot duration -- alarm )
     hence f add-alarm ;
 
-: every ( quot dt -- alarm )
+: every ( quot duration -- alarm )
     [ hence ] keep add-alarm ;
 
 : cancel-alarm ( alarm -- )

basis/bit-arrays/bit-arrays.factor

@@ -91,5 +91,5 @@ M: bit-array byte-length length 7 + -3 shift ;
 INSTANCE: bit-array sequence
 
 M: bit-array pprint-delims drop \ ?{ \ } ;
-
 M: bit-array >pprint-sequence ;
+M: bit-array pprint* pprint-object ;

basis/bit-vectors/bit-vectors.factor

@@ -34,5 +34,5 @@ INSTANCE: bit-vector growable
 : ?V{ \ } [ >bit-vector ] parse-literal ; parsing
 
 M: bit-vector >pprint-sequence ;
-
 M: bit-vector pprint-delims drop \ ?V{ \ } ;
+M: bit-vector pprint* pprint-object ;

basis/calendar/calendar-docs.factor

@@ -21,8 +21,8 @@ HELP: <date>
 { $description "Returns a timestamp object representing the start of the specified day in your current timezone." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "12 25 2010 <date> ."
+               "2010 12 25 <date> ."
-                "T{ timestamp f 12 25 2010 0 0 0 T{ duration f 0 0 0 -5 0 0 } }"
+               "T{ timestamp\n    { year 2010 }\n    { month 12 }\n    { day 25 }\n    { gmt-offset T{ duration { hour -5 } } }\n}"
     }
 } ;
 

basis/channels/channels.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 !
 ! Channels - based on ideas from newsqueak
-USING: kernel sequences sequences.lib threads continuations
+USING: kernel sequences threads continuations
-random math accessors ;
+random math accessors random ;
 IN: channels
 
 TUPLE: channel receivers senders ;

basis/checksums/common/common.factor

@@ -0,0 +1,21 @@
+! Copyright (C) 2006, 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.bitwise strings io.binary namespaces
+grouping ;
+IN: checksums.common
+
+SYMBOL: bytes-read
+
+: calculate-pad-length ( length -- pad-length )
+    dup 56 < 55 119 ? swap - ;
+
+: pad-last-block ( str big-endian? length -- str )
+    [
+        rot %
+        HEX: 80 ,
+        dup HEX: 3f bitand calculate-pad-length 0 <string> %
+        3 shift 8 rot [ >be ] [ >le ] if %
+    ] "" make 64 group ;
+
+: update-old-new ( old new -- )
+    [ get >r get r> ] 2keep >r >r w+ dup r> set r> set ; inline

basis/checksums/common/summary.txt

@@ -0,0 +1 @@
+Some code shared by MD5, SHA1 and SHA2 implementations

basis/checksums/md5/md5.factor

@@ -1,11 +1,14 @@
-! See http://www.faqs.org/rfcs/rfc1321.html
+! Copyright (C) 2006, 2008 Doug Coleman.
-
+! See http://factorcode.org/license.txt for BSD license.
 USING: kernel io io.binary io.files io.streams.byte-array math
 math.functions math.parser namespaces splitting grouping strings
-sequences crypto.common byte-arrays locals sequences.private
+sequences byte-arrays locals sequences.private
-io.encodings.binary symbols math.bitfields.lib checksums ;
+io.encodings.binary symbols math.bitwise checksums
+checksums.common ;
 IN: checksums.md5
 
+! See http://www.faqs.org/rfcs/rfc1321.html
+
 <PRIVATE
 
 SYMBOLS: a b c d old-a old-b old-c old-d ;

basis/checksums/sha1/sha1.factor

@@ -1,7 +1,9 @@
-USING: arrays combinators crypto.common kernel io
+! Copyright (C) 2006, 2008 Doug Coleman.
-io.encodings.binary io.files io.streams.byte-array math.vectors
+! See http://factorcode.org/license.txt for BSD license.
-strings sequences namespaces math parser sequences vectors
+USING: arrays combinators kernel io io.encodings.binary io.files
-io.binary hashtables symbols math.bitfields.lib checksums ;
+io.streams.byte-array math.vectors strings sequences namespaces
+math parser sequences assocs grouping vectors io.binary hashtables
+symbols math.bitwise checksums checksums.common ;
 IN: checksums.sha1
 
 ! Implemented according to RFC 3174.
@@ -45,6 +47,9 @@ SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ;
         { 3 [ bitxor bitxor ] }
     } case ;
 
+: nth-int-be ( string n -- int )
+    4 * dup 4 + rot <slice> be> ; inline
+
 : make-w ( str -- )
     #! compute w, steps a-b of RFC 3174, section 6.1
     16 [ nth-int-be w get push ] with each
@@ -113,8 +118,16 @@ INSTANCE: sha1 checksum
 M: sha1 checksum-stream ( stream -- sha1 )
     drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ;
 
+: seq>2seq ( seq -- seq1 seq2 )
+    #! { abcdefgh } -> { aceg } { bdfh }
+    2 group flip dup empty? [ drop { } { } ] [ first2 ] if ;
+
+: 2seq>seq ( seq1 seq2 -- seq )
+    #! { aceg } { bdfh } -> { abcdefgh }
+    [ zip concat ] keep like ;
+
 : sha1-interleave ( string -- seq )
-    [ zero? ] left-trim
+    [ zero? ] trim-left
     dup length odd? [ rest ] when
     seq>2seq [ sha1 checksum-bytes ] bi@
     2seq>seq ;

basis/checksums/sha2/sha2.factor

@@ -1,6 +1,8 @@
-USING: crypto.common kernel splitting grouping
+! Copyright (C) 2008 Doug Coleman.
-math sequences namespaces io.binary symbols
+! See http://factorcode.org/license.txt for BSD license.
-math.bitfields.lib checksums ;
+USING: kernel splitting grouping math sequences namespaces
+io.binary symbols math.bitwise checksums checksums.common
+sbufs strings ;
 IN: checksums.sha2
 
 <PRIVATE
@@ -81,6 +83,8 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
     [ -11 bitroll-32 ] keep
     -25 bitroll-32 bitxor bitxor ; inline
 
+: slice3 ( n seq -- a b c ) >r dup 3 + r> <slice> first3 ; inline
+
 : T1 ( W n -- T1 )
     [ swap nth ] keep
     K get nth +
@@ -112,6 +116,15 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
 : seq>byte-array ( n seq -- string )
     [ swap [ >be % ] curry each ] B{ } make ;
 
+: preprocess-plaintext ( string big-endian? -- padded-string )
+    #! pad 0x80 then 00 til 8 bytes left, then 64bit length in bits
+    >r >sbuf r> over [
+        HEX: 80 ,
+        dup length HEX: 3f bitand
+        calculate-pad-length 0 <string> %
+        length 3 shift 8 rot [ >be ] [ >le ] if %
+    ] "" make over push-all ;
+
 : byte-array>sha2 ( byte-array -- string )
     t preprocess-plaintext
     block-size get group [ process-chunk ] each

basis/cocoa/windows/windows.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math cocoa cocoa.messages cocoa.classes
-sequences math.bitfields ;
+sequences math.bitwise ;
 IN: cocoa.windows
 
 : NSBorderlessWindowMask     0 ; inline

basis/compiler/generator/fixup/fixup.factor

@@ -3,7 +3,7 @@
 USING: arrays byte-arrays generic assocs hashtables io.binary
 kernel kernel.private math namespaces sequences words
 quotations strings alien.accessors alien.strings layouts system
-combinators math.bitfields words.private cpu.architecture
+combinators math.bitwise words.private cpu.architecture
 math.order accessors growable ;
 IN: compiler.generator.fixup
 

basis/compiler/generator/registers/registers.factor

@@ -647,7 +647,7 @@ UNION: immediate fixnum POSTPONE: f ;
 
 : phantom-shuffle ( shuffle -- )
     [ in>> length phantom-datastack get phantom-input ] keep
-    shuffle* phantom-datastack get phantom-append ;
+    shuffle phantom-datastack get phantom-append ;
 
 : phantom->r ( n -- )
     phantom-datastack get phantom-input

basis/compiler/tree/normalization/normalization.factor

@@ -151,7 +151,7 @@ M: #branch normalize*
 : eliminate-phi-introductions ( introductions seq terminated -- seq' )
     [
         [ nip ] [
-            dup [ +bottom+ eq? ] left-trim
+            dup [ +bottom+ eq? ] trim-left
             [ [ length ] bi@ - tail* ] keep append
         ] if
     ] 3map ;

basis/cpu/ppc/assembler/backend/backend.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: compiler.generator.fixup kernel namespaces sequences
-words math math.bitfields io.binary parser lexer ;
+words math math.bitwise io.binary parser lexer ;
 IN: cpu.ppc.assembler.backend
 
 : insn ( operand opcode -- ) { 26 0 } bitfield , ;

basis/db/db.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes continuations destructors kernel math
-namespaces sequences sequences.lib classes.tuple words strings
+namespaces sequences classes.tuple words strings
-tools.walker accessors combinators.lib combinators ;
+tools.walker accessors combinators ;
 IN: db
 
 TUPLE: db

basis/db/postgresql/postgresql.factor

@@ -4,8 +4,8 @@ USING: arrays assocs alien alien.syntax continuations io
 kernel math math.parser namespaces prettyprint quotations
 sequences debugger db db.postgresql.lib db.postgresql.ffi
 db.tuples db.types tools.annotations math.ranges
-combinators sequences.lib classes locals words tools.walker
+combinators classes locals words tools.walker
-namespaces.lib accessors random db.queries destructors ;
+nmake accessors random db.queries destructors ;
 USE: tools.walker
 IN: db.postgresql
 

basis/db/queries/queries.factor

@@ -1,9 +1,8 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math namespaces sequences random
+USING: accessors kernel math namespaces sequences random strings
-strings math.parser math.intervals combinators
+math.parser math.intervals combinators math.bitwise nmake db
-math.bitfields.lib namespaces.lib db db.tuples db.types
+db.tuples db.types db.sql classes words shuffle arrays ;
-sequences.lib db.sql classes words shuffle arrays ;
 IN: db.queries
 
 GENERIC: where ( specs obj -- )
@@ -142,8 +141,8 @@ M: db <select-by-slots-statement> ( tuple class -- statement )
 : make-query ( tuple query -- tuple' )
     dupd
     {
-        [ group>> [ do-group ] [ drop ] if-seq ]
+        [ group>> [ drop ] [ do-group ] if-empty ]
-        [ order>> [ do-order ] [ drop ] if-seq ]
+        [ order>> [ drop ] [ do-order ] if-empty ]
         [ limit>> [ do-limit ] [ drop ] if* ]
         [ offset>> [ do-offset ] [ drop ] if* ]
     } 2cleave ;

basis/db/sql/sql.factor

@@ -1,6 +1,6 @@
 USING: kernel parser quotations classes.tuple words math.order
-namespaces.lib namespaces sequences arrays combinators
+nmake namespaces sequences arrays combinators
-prettyprint strings math.parser sequences.lib math symbols ;
+prettyprint strings math.parser math symbols ;
 IN: db.sql
 
 SYMBOLS: insert update delete select distinct columns from as

basis/db/sqlite/sqlite.factor

@@ -1,13 +1,11 @@
 ! Copyright (C) 2005, 2008 Chris Double, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays assocs classes compiler db
+USING: alien arrays assocs classes compiler db hashtables
-hashtables io.files kernel math math.parser namespaces
+io.files kernel math math.parser namespaces prettyprint
-prettyprint sequences strings classes.tuple alien.c-types
+sequences strings classes.tuple alien.c-types continuations
-continuations db.sqlite.lib db.sqlite.ffi db.tuples
+db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
-words combinators.lib db.types combinators math.intervals
+math.intervals io nmake accessors vectors math.ranges random
-io namespaces.lib accessors vectors math.ranges random
+math.bitwise db.queries destructors ;
-math.bitfields.lib db.queries destructors ;
-USE: tools.walker
 IN: db.sqlite
 
 TUPLE: sqlite-db < db path ;

basis/db/tuples/tuples-tests.factor

@@ -3,8 +3,8 @@
 USING: io.files kernel tools.test db db.tuples classes
 db.types continuations namespaces math math.ranges
 prettyprint calendar sequences db.sqlite math.intervals
-db.postgresql accessors random math.bitfields.lib
+db.postgresql accessors random math.bitwise
-math.ranges strings sequences.lib urls fry ;
+math.ranges strings urls fry ;
 IN: db.tuples.tests
 
 TUPLE: person the-id the-name the-number the-real

basis/db/tuples/tuples.factor

@@ -3,7 +3,7 @@
 USING: arrays assocs classes db kernel namespaces
 classes.tuple words sequences slots math accessors
 math.parser io prettyprint db.types continuations
-destructors mirrors sequences.lib combinators.lib ;
+destructors mirrors ;
 IN: db.tuples
 
 : define-persistent ( class table columns -- )
@@ -71,13 +71,14 @@ SINGLETON: retryable
     ] 2map >>bind-params ;
 
 M: retryable execute-statement* ( statement type -- )
-    drop [
+    drop [ retries>> ] [
         [
+            nip
             [ query-results dispose t ]
             [ ]
             [ regenerate-params bind-statement* f ] cleanup
         ] curry
-    ] [ retries>> ] bi retry drop ;
+    ] bi attempt-all drop ;
 
 : resulting-tuple ( class row out-params -- tuple )
     rot class new [
@@ -159,7 +160,8 @@ M: retryable execute-statement* ( statement type -- )
     dup dup class <select-by-slots-statement> do-select ;
 
 : select-tuple ( tuple -- tuple/f )
-    dup dup class \ query new 1 >>limit <query> do-select ?first ;
+    dup dup class \ query new 1 >>limit <query> do-select
+    [ f ] [ first ] if-empty ;
 
 : do-count ( exemplar-tuple statement -- tuples )
     [

basis/db/types/types.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs db kernel math math.parser
-sequences continuations sequences.deep sequences.lib
+sequences continuations sequences.deep
 words namespaces slots slots.private classes mirrors
 classes.tuple combinators calendar.format symbols
 classes.singleton accessors quotations random ;

basis/float-arrays/float-arrays.factor

@@ -61,8 +61,8 @@ INSTANCE: float-array sequence
 : F{ \ } [ >float-array ] parse-literal ; parsing
 
 M: float-array pprint-delims drop \ F{ \ } ;
-
 M: float-array >pprint-sequence ;
+M: float-array pprint* pprint-object ;
 
 USING: hints math.vectors arrays ;
 

basis/float-vectors/float-vectors.factor

@@ -34,5 +34,5 @@ INSTANCE: float-vector growable
 : FV{ \ } [ >float-vector ] parse-literal ; parsing
 
 M: float-vector >pprint-sequence ;
-
 M: float-vector pprint-delims drop \ FV{ \ } ;
+M: float-vector pprint* pprint-object ;

basis/help/help-docs.factor

@@ -14,6 +14,7 @@ ARTICLE: "span-elements" "Span elements"
 { $subsection $link }
 { $subsection $vocab-link }
 { $subsection $snippet }
+{ $subsection $slot }
 { $subsection $url } ;
 
 ARTICLE: "block-elements" "Block elements"
@@ -212,6 +213,18 @@ HELP: $code
     { $markup-example { $code "2 2 + ." } }
 } ;
 
+HELP: $nl
+{ $values { "children" "unused parameter" } }
+{ $description "Prints a paragraph break. The parameter is unused." } ;
+
+HELP: $snippet
+{ $values { "children" "markup elements" } }
+{ $description "Prints a key word or otherwise notable snippet of text, such as a type or a word input parameter. To document slot names, use " { $link $slot } "." } ;
+
+HELP: $slot
+{ $values { "children" "markup elements" } }
+{ $description "Prints a tuple slot name in the same way as a snippet. The help tool can check that there exists an accessor with this name." } ;
+
 HELP: $vocabulary
 { $values { "element" "a markup element of the form " { $snippet "{ word }" } } }
 { $description "Prints a word's vocabulary. This markup element is automatically output by the help system, so help descriptions of parsing words should not call it." } ;

basis/help/markup/markup.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays definitions generic io kernel assocs
 hashtables namespaces parser prettyprint sequences strings
 io.styles vectors words math sorting splitting classes slots
-vocabs help.stylesheet help.topics vocabs.loader ;
+vocabs help.stylesheet help.topics vocabs.loader alias ;
 IN: help.markup
 
 ! Simple markup language.
@@ -61,6 +61,9 @@ M: f print-element drop ;
 : $snippet ( children -- )
     [ snippet-style get print-element* ] ($span) ;
 
+! for help-lint
+ALIAS: $slot $snippet
+
 : $emphasis ( children -- )
     [ emphasis-style get print-element* ] ($span) ;
 

basis/html/forms/forms.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors strings namespaces assocs hashtables
-mirrors math fry sequences sequences.lib words continuations ;
+mirrors math fry sequences words continuations ;
 IN: html.forms
 
 TUPLE: form errors values validation-failed ;

basis/html/templates/chloe/chloe.factor

@@ -3,7 +3,7 @@
 USING: accessors kernel sequences combinators kernel namespaces
 classes.tuple assocs splitting words arrays memoize
 io io.files io.encodings.utf8 io.streams.string
-unicode.case tuple-syntax mirrors fry math urls present
+unicode.case mirrors fry math urls present
 multiline xml xml.data xml.writer xml.utilities
 html.forms
 html.elements

basis/html/templates/chloe/syntax/syntax.factor

@@ -4,7 +4,7 @@ IN: html.templates.chloe.syntax
 USING: accessors kernel sequences combinators kernel namespaces
 classes.tuple assocs splitting words arrays memoize parser lexer
 io io.files io.encodings.utf8 io.streams.string
-unicode.case tuple-syntax mirrors fry math urls
+unicode.case mirrors fry math urls
 multiline xml xml.data xml.writer xml.utilities
 html.elements
 html.components

basis/http/client/client-tests.factor

@@ -1,5 +1,5 @@
 USING: http.client http.client.private http tools.test
-tuple-syntax namespaces urls ;
+namespaces urls ;
 [ "localhost" f ] [ "localhost" parse-host ] unit-test
 [ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
 
@@ -9,12 +9,12 @@ tuple-syntax namespaces urls ;
 [ "www.arc.com" ] [ "http://www.arc.com////" download-name ] unit-test
 
 [
-    TUPLE{ request
+    T{ request
-        url: TUPLE{ url protocol: "http" host: "www.apple.com" port: 80 path: "/index.html" }
+        { url T{ url { protocol "http" } { host "www.apple.com" } { port 80 } { path "/index.html" } } }
-        method: "GET"
+        { method "GET" }
-        version: "1.1"
+        { version "1.1" }
-        cookies: V{ }
+        { cookies V{ } }
-        header: H{ { "connection" "close" } { "user-agent" "Factor http.client" } }
+        { header H{ { "connection" "close" } { "user-agent" "Factor http.client" } } }
     }
 ] [
     "http://www.apple.com/index.html"
@@ -22,12 +22,12 @@ tuple-syntax namespaces urls ;
 ] unit-test
 
 [
-    TUPLE{ request
+    T{ request
-        url: TUPLE{ url protocol: "https" host: "www.amazon.com" port: 443 path: "/index.html" }
+        { url T{ url { protocol "https" } { host "www.amazon.com" } { port 443 } { path "/index.html" } } }
-        method: "GET"
+        { method "GET" }
-        version: "1.1"
+        { version "1.1" }
-        cookies: V{ }
+        { cookies V{ } }
-        header: H{ { "connection" "close" } { "user-agent" "Factor http.client" } }
+        { header H{ { "connection" "close" } { "user-agent" "Factor http.client" } } }
     }
 ] [
     "https://www.amazon.com/index.html"

basis/http/client/client.factor

@@ -113,7 +113,7 @@ SYMBOL: redirects
 PRIVATE>
 
 : read-chunk-size ( -- n )
-    read-crlf ";" split1 drop [ blank? ] right-trim
+    read-crlf ";" split1 drop [ blank? ] trim-right
     hex> [ "Bad chunk size" throw ] unless* ;
 
 : read-chunks ( -- )

basis/http/http-tests.factor

@@ -1,8 +1,8 @@
 USING: http http.server http.client tools.test multiline
-tuple-syntax io.streams.string io.encodings.utf8
+io.streams.string io.encodings.utf8 io.encodings.8-bit
-io.encodings.8-bit io.encodings.binary io.encodings.string
+io.encodings.binary io.encodings.string kernel arrays splitting
-kernel arrays splitting sequences assocs io.sockets db db.sqlite
+sequences assocs io.sockets db db.sqlite continuations urls
-continuations urls hashtables accessors ;
+hashtables accessors ;
 IN: http.tests
 
 [ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
@@ -24,13 +24,13 @@ blah
 ;
 
 [
-    TUPLE{ request
+    T{ request
-        url: TUPLE{ url path: "/bar" }
+        { url T{ url { path "/bar" } } }
-        method: "POST"
+        { method "POST" }
-        version: "1.1"
+        { version "1.1" }
-        header: H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } }
+        { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
-        post-data: TUPLE{ post-data content: "blah" raw: "blah" content-type: "application/octet-stream" }
+        { post-data T{ post-data { content "blah" } { raw "blah" } { content-type "application/octet-stream" } } }
-        cookies: V{ }
+        { cookies V{ } }
     }
 ] [
     read-request-test-1 lf>crlf [
@@ -62,12 +62,12 @@ Host: www.sex.com
 ;
 
 [
-    TUPLE{ request
+    T{ request
-        url: TUPLE{ url host: "www.sex.com" path: "/bar" }
+        { url T{ url { host "www.sex.com" } { path "/bar" } } }
-        method: "HEAD"
+        { method "HEAD" }
-        version: "1.1"
+        { version "1.1" }
-        header: H{ { "host" "www.sex.com" } }
+        { header H{ { "host" "www.sex.com" } } }
-        cookies: V{ }
+        { cookies V{ } }
     }
 ] [
     read-request-test-2 lf>crlf [
@@ -103,14 +103,14 @@ blah
 ;
 
 [
-    TUPLE{ response
+    T{ response
-        version: "1.1"
+        { version "1.1" }
-        code: 404
+        { code 404 }
-        message: "not found"
+        { message "not found" }
-        header: H{ { "content-type" "text/html; charset=UTF-8" } }
+        { header H{ { "content-type" "text/html; charset=UTF-8" } } }
-        cookies: { }
+        { cookies { } }
-        content-type: "text/html"
+        { content-type "text/html" }
-        content-charset: utf8
+        { content-charset utf8 }
     }
 ] [
     read-response-test-1 lf>crlf

basis/http/http.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel combinators math namespaces
-assocs assocs.lib sequences splitting sorting sets debugger
+assocs sequences splitting sorting sets debugger
 strings vectors hashtables quotations arrays byte-arrays
 math.parser calendar calendar.format present
 
@@ -27,9 +27,12 @@ IN: http
 : (read-header) ( -- alist )
     [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
 
+: collect-headers ( assoc -- assoc' )
+    H{ } clone [ '[ , push-at ] assoc-each ] keep ;
+
 : process-header ( alist -- assoc )
     f swap [ [ swap or dup ] dip swap ] assoc-map nip
-    [ ?push ] histogram [ "; " join ] assoc-map
+    collect-headers [ "; " join ] assoc-map
     >hashtable ;
 
 : read-header ( -- assoc )

basis/http/server/static/static.factor

@@ -45,9 +45,9 @@ TUPLE: file-responder root hook special allow-listings ;
     [ file-responder get hook>> call ] [ 2drop <304> ] if ;
 
 : serving-path ( filename -- filename )
-    file-responder get root>> right-trim-separators
+    file-responder get root>> trim-right-separators
     "/"
-    rot "" or left-trim-separators 3append ;
+    rot "" or trim-left-separators 3append ;
 
 : serve-file ( filename -- response )
     dup mime-type

basis/io/monitors/monitors-tests.factor

@@ -54,7 +54,7 @@ os { winnt linux macosx } member? [
                     "m" get next-change drop
                     dup print flush
                     dup parent-directory
-                    [ right-trim-separators "xyz" tail? ] either? not
+                    [ trim-right-separators "xyz" tail? ] either? not
                 ] loop
 
                 "c1" get count-down
@@ -63,7 +63,7 @@ os { winnt linux macosx } member? [
                     "m" get next-change drop
                     dup print flush
                     dup parent-directory
-                    [ right-trim-separators "yxy" tail? ] either? not
+                    [ trim-right-separators "yxy" tail? ] either? not
                 ] loop
 
                 "c2" get count-down

basis/io/sockets/sockets.factor

@@ -77,17 +77,9 @@ M: inet4 make-sockaddr ( inet -- sockaddr )
     "0.0.0.0" or
     rot inet-pton *uint over set-sockaddr-in-addr ;
 
-<PRIVATE
-
-SYMBOL: port-override
-
-: (port) ( port -- port' ) port-override get swap or ;
-
-PRIVATE>
-
 M: inet4 parse-sockaddr
     >r dup sockaddr-in-addr <uint> r> inet-ntop
-    swap sockaddr-in-port ntohs (port) <inet4> ;
+    swap sockaddr-in-port ntohs <inet4> ;
 
 TUPLE: inet6 host port ;
 
@@ -140,7 +132,7 @@ M: inet6 make-sockaddr ( inet -- sockaddr )
 
 M: inet6 parse-sockaddr
     >r dup sockaddr-in6-addr r> inet-ntop
-    swap sockaddr-in6-port ntohs (port) <inet6> ;
+    swap sockaddr-in6-port ntohs <inet6> ;
 
 : addrspec-of-family ( af -- addrspec )
     {
@@ -259,17 +251,6 @@ HOOK: (send) io-backend ( packet addrspec datagram -- )
     [ addrinfo>addrspec ] map
     sift ;
 
-: prepare-resolve-host ( addrspec -- host' serv' flags )
-    #! If the port is a number, we resolve for 'http' then
-    #! change it later. This is a workaround for a FreeBSD
-    #! getaddrinfo() limitation -- on Windows, Linux and Mac,
-    #! we can convert a number to a string and pass that as the
-    #! service name, but on FreeBSD this gives us an unknown
-    #! service error.
-    [ host>> ]
-    [ port>> dup integer? [ port-override set "http" ] when ] bi
-    over 0 AI_PASSIVE ? ;
-
 HOOK: addrinfo-error io-backend ( n -- )
 
 GENERIC: resolve-host ( addrspec -- seq )
@@ -278,17 +259,24 @@ TUPLE: inet host port ;
 
 C: <inet> inet
 
+: resolve-passive-host ( -- addrspecs )
+    { T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
+
+: prepare-addrinfo ( -- addrinfo )
+    "addrinfo" <c-object>
+    PF_UNSPEC over set-addrinfo-family
+    IPPROTO_TCP over set-addrinfo-protocol ;
+
+: fill-in-ports ( addrspecs port -- addrspecs )
+    [ >>port ] curry map ;
+
 M: inet resolve-host
-    [
+    [ port>> ] [ host>> ] bi [
-        prepare-resolve-host
+        f prepare-addrinfo f <void*>
-        "addrinfo" <c-object>
+        [ getaddrinfo addrinfo-error ] keep *void*
-        [ set-addrinfo-flags ] keep
+        [ parse-addrinfo-list ] keep freeaddrinfo
-        PF_UNSPEC over set-addrinfo-family
+    ] [ resolve-passive-host ] if*
-        IPPROTO_TCP over set-addrinfo-protocol
+    swap fill-in-ports ;
-        f <void*> [ getaddrinfo addrinfo-error ] keep *void*
-        [ parse-addrinfo-list ] keep
-        freeaddrinfo
-    ] with-scope ;
 
 M: f resolve-host drop { } ;
 

basis/io/unix/files/files.factor

@@ -2,7 +2,7 @@
 ! 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.bitfields byte-arrays alien combinators calendar
+math.bitwise byte-arrays alien combinators calendar
 io.encodings.binary accessors sequences strings system
 io.files.private destructors ;
 

basis/io/unix/files/unique/unique.factor

@@ -1,4 +1,4 @@
-USING: kernel io.ports io.unix.backend math.bitfields
+USING: kernel io.ports io.unix.backend math.bitwise
 unix io.files.unique.backend system ;
 IN: io.unix.files.unique
 

basis/io/unix/kqueue/kqueue.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel math math.bitfields namespaces
+USING: alien.c-types kernel math math.bitwise namespaces
 locals accessors combinators threads vectors hashtables
 sequences assocs continuations sets
 unix unix.time unix.kqueue unix.process

basis/io/unix/linux/monitors/monitors.factor

@@ -4,7 +4,7 @@ USING: kernel io.backend io.monitors io.monitors.recursive
 io.files io.buffers io.monitors io.ports io.timeouts
 io.unix.backend io.unix.select io.encodings.utf8
 unix.linux.inotify assocs namespaces threads continuations init
-math math.bitfields sets alien alien.strings alien.c-types
+math math.bitwise sets alien alien.strings alien.c-types
 vocabs.loader accessors system hashtables destructors unix ;
 IN: io.unix.linux.monitors
 

basis/io/unix/mmap/mmap.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien io io.files kernel math math.bitfields system unix
+USING: alien io io.files kernel math math.bitwise system unix
 io.unix.backend io.ports io.mmap destructors locals accessors ;
 IN: io.unix.mmap
 

basis/io/windows/files/files.factor

@@ -4,8 +4,7 @@ USING: alien.c-types io.binary io.backend io.files io.buffers
 io.windows kernel math splitting
 windows windows.kernel32 windows.time calendar combinators
 math.functions sequences namespaces words symbols system
-io.ports destructors accessors
+io.ports destructors accessors math.bitwise ;
-math.bitfields math.bitfields.lib ;
 IN: io.windows.files
 
 : open-file ( path access-mode create-mode flags -- handle )

basis/io/windows/mmap/mmap.factor

@@ -1,6 +1,6 @@
 USING: alien alien.c-types arrays destructors generic io.mmap
 io.ports io.windows io.windows.files io.windows.privileges
-kernel libc math math.bitfields namespaces quotations sequences
+kernel libc math math.bitwise namespaces quotations sequences
 windows windows.advapi32 windows.kernel32 io.backend system
 accessors locals ;
 IN: io.windows.mmap

basis/io/windows/nt/files/files-tests.factor

@@ -21,8 +21,8 @@ IN: io.windows.nt.files.tests
 [ t ] [ "\\\\" root-directory? ] unit-test
 [ t ] [ "/" root-directory? ] unit-test
 [ t ] [ "//" root-directory? ] unit-test
-[ t ] [ "c:\\" right-trim-separators root-directory? ] unit-test
+[ t ] [ "c:\\" trim-right-separators root-directory? ] unit-test
-[ t ] [ "Z:\\" right-trim-separators root-directory? ] unit-test
+[ t ] [ "Z:\\" trim-right-separators root-directory? ] unit-test
 [ f ] [ "c:\\foo" root-directory? ] unit-test
 [ f ] [ "." root-directory? ] unit-test
 [ f ] [ ".." root-directory? ] unit-test

basis/io/windows/nt/files/files.factor

@@ -22,7 +22,7 @@ M: winnt root-directory? ( path -- ? )
     {
         { [ dup empty? ] [ f ] }
         { [ dup [ path-separator? ] all? ] [ t ] }
-        { [ dup right-trim-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] }
+        { [ dup trim-right-separators { [ length 2 = ] [ second CHAR: : = ] } 1&& ] [ t ] }
         [ f ]
     } cond nip ;
 

basis/io/windows/nt/monitors/monitors.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types libc destructors locals
 kernel math assocs namespaces continuations sequences hashtables
-sorting arrays combinators math.bitfields strings system
+sorting arrays combinators math.bitwise strings system
 accessors threads splitting
 io.backend io.windows io.windows.nt.backend io.windows.nt.files
 io.monitors io.ports io.buffers io.files io.timeouts io

basis/io/windows/nt/pipes/pipes.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays destructors io io.windows libc
-windows.types math.bitfields windows.kernel32 windows namespaces
+windows.types math.bitwise windows.kernel32 windows namespaces
 kernel sequences windows.errors assocs math.parser system random
 combinators accessors io.pipes io.ports ;
 IN: io.windows.nt.pipes

basis/io/windows/nt/privileges/privileges.factor

@@ -1,6 +1,6 @@
 USING: alien alien.c-types alien.syntax arrays continuations
 destructors generic io.mmap io.ports io.windows io.windows.files
-kernel libc math math.bitfields namespaces quotations sequences windows
+kernel libc math math.bitwise namespaces quotations sequences windows
 windows.advapi32 windows.kernel32 io.backend system accessors
 io.windows.privileges ;
 IN: io.windows.nt.privileges

basis/io/windows/windows.factor

@@ -5,7 +5,7 @@ io.buffers io.files io.ports io.sockets io.binary
 io.sockets io.timeouts windows.errors strings
 kernel math namespaces sequences windows windows.kernel32
 windows.shell32 windows.types windows.winsock splitting
-continuations math.bitfields system accessors ;
+continuations math.bitwise system accessors ;
 IN: io.windows
 
 : set-inherit ( handle ? -- )

basis/lcs/lcs.factor

@@ -1,6 +1,5 @@
 USING: sequences kernel math locals math.order math.ranges
-accessors combinators.lib arrays namespaces combinators
+accessors arrays namespaces combinators combinators.short-circuit ;
-combinators.short-circuit ;
 IN: lcs
 
 <PRIVATE

basis/logging/logging.factor

@@ -46,7 +46,7 @@ SYMBOL: log-service
     dup array? [ dup length 1 = [ first ] when ] when
     dup string? [
         [
-            string-limit off
+            string-limit? off
             1 line-limit set
             3 nesting-limit set
             0 margin set

basis/logging/parser/parser.factor

@@ -2,8 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors peg peg.parsers memoize kernel sequences
 logging arrays words strings vectors io io.files io.encodings.utf8
-namespaces combinators combinators.lib logging.server
+namespaces combinators logging.server calendar calendar.format ;
-calendar calendar.format ;
 IN: logging.parser
 
 TUPLE: log-entry date level word-name message ;

basis/math/bitfields/bitfields-tests.factor

@@ -1,27 +0,0 @@
-USING: accessors math math.bitfields tools.test kernel words ;
-IN: math.bitfields.tests
-
-[ 0 ] [ { } bitfield ] unit-test
-[ 256 ] [ 1 { 8 } bitfield ] unit-test
-[ 268 ] [ 3 1 { 8 2 } bitfield ] unit-test
-[ 268 ] [ 1 { 8 { 3 2 } } bitfield ] unit-test
-[ 512 ] [ 1 { { 1+ 8 } } bitfield ] unit-test
-
-: a 1 ; inline
-: b 2 ; inline
-
-: foo ( -- flags ) { a b } flags ;
-
-[ 3 ] [ foo ] unit-test
-[ 3 ] [ { a b } flags ] unit-test
-\ foo must-infer
-
-[ 0 ] [ { } bitfield-quot call ] unit-test
-
-[ 256 ] [ 1 { 8 } bitfield-quot call ] unit-test
-
-[ 268 ] [ 3 1 { 8 2 } bitfield-quot call ] unit-test
-
-[ 268 ] [ 1 { 8 { 3 2 } } bitfield-quot call ] unit-test
-
-[ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test

basis/math/bitfields/bitfields.factor

@@ -1,37 +0,0 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math sequences words
-namespaces stack-checker.transforms ;
-IN: math.bitfields
-
-GENERIC: (bitfield) ( value accum shift -- newaccum )
-
-M: integer (bitfield) ( value accum shift -- newaccum )
-    swapd shift bitor ;
-
-M: pair (bitfield) ( value accum pair -- newaccum )
-    first2 >r dup word? [ swapd execute ] when r> shift bitor ;
-
-: bitfield ( values... bitspec -- n )
-    0 [ (bitfield) ] reduce ;
-
-: flags ( values -- n )
-    0 [ dup word? [ execute ] when bitor ] reduce ;
-
-GENERIC: (bitfield-quot) ( spec -- quot )
-
-M: integer (bitfield-quot) ( spec -- quot )
-    [ swapd shift bitor ] curry ;
-
-M: pair (bitfield-quot) ( spec -- quot )
-    first2 over word? [ >r swapd execute r> ] [ ] ?
-    [ shift bitor ] append 2curry ;
-
-: bitfield-quot ( spec -- quot )
-    [ (bitfield-quot) ] map [ 0 ] prefix concat ;
-
-\ bitfield [ bitfield-quot ] 1 define-transform
-
-\ flags [
-    [ 0 , [ , \ bitor , ] each ] [ ] make
-] 1 define-transform

basis/math/bitfields/summary.txt

@@ -1 +0,0 @@
-Domain-specific language for constructing integers

basis/math/bitwise/authors.txt

@@ -1 +1,2 @@
 Slava Pestov
+Doug Coleman

basis/math/bitwise/bitwise-docs.factor

@@ -1,5 +1,5 @@
 USING: help.markup help.syntax math ;
-IN: math.bitfields
+IN: math.bitwise
 
 ARTICLE: "math-bitfields" "Constructing bit fields"
 "Some applications, such as binary communication protocols and assemblers, need to construct integers from elaborate bit field specifications. Hand-coding this using " { $link shift } " and " { $link bitor } " results in repetitive code. A higher-level facility exists to factor out this repetition:"
@@ -35,3 +35,16 @@ HELP: bitfield
         "    } ;"
     }
 } ;
+
+HELP: bits 
+{ $values { "m" integer } { "n" integer } { "m'" integer } }
+{ $description "Keep only n bits from the integer m." }
+{ $example "USING: math.bitwise prettyprint ;" "HEX: 123abcdef 16 bits .h" "cdef" } ;
+
+HELP: bitroll
+{ $values { "x" "an integer (input)" } { "s" "an integer (shift)" } { "w" "an integer (wrap)" } { "y" integer } }
+{ $description "Roll n by s bits to the left, wrapping around after w bits." }
+{ $examples
+    { $example "USING: math.bitwise prettyprint ;" "1 -1 32 bitroll .b" "10000000000000000000000000000000" }
+    { $example "USING: math.bitwise prettyprint ;" "HEX: ffff0000 8 32 bitroll .h" "ff0000ff" }
+} ;

basis/math/bitwise/bitwise-tests.factor

@@ -0,0 +1,29 @@
+USING: accessors math math.bitwise tools.test kernel words ;
+IN: math.bitwise.tests
+
+[ 0 ] [ 1 0 0 bitroll ] unit-test
+[ 1 ] [ 1 0 1 bitroll ] unit-test
+[ 1 ] [ 1 1 1 bitroll ] unit-test
+[ 1 ] [ 1 0 2 bitroll ] unit-test
+[ 1 ] [ 1 0 1 bitroll ] unit-test
+[ 1 ] [ 1 20 2 bitroll ] unit-test
+[ 1 ] [ 1 8 8 bitroll ] unit-test
+[ 1 ] [ 1 -8 8 bitroll ] unit-test
+[ 1 ] [ 1 -32 8 bitroll ] unit-test
+[ 128 ] [ 1 -1 8 bitroll ] unit-test
+[ 8 ] [ 1 3 32 bitroll ] unit-test
+
+[ 0 ] [ { } bitfield ] unit-test
+[ 256 ] [ 1 { 8 } bitfield ] unit-test
+[ 268 ] [ 3 1 { 8 2 } bitfield ] unit-test
+[ 268 ] [ 1 { 8 { 3 2 } } bitfield ] unit-test
+[ 512 ] [ 1 { { 1+ 8 } } bitfield ] unit-test
+
+: a 1 ; inline
+: b 2 ; inline
+
+: foo ( -- flags ) { a b } flags ;
+
+[ 3 ] [ foo ] unit-test
+[ 3 ] [ { a b } flags ] unit-test
+\ foo must-infer

basis/math/bitwise/bitwise.factor

@@ -0,0 +1,94 @@
+! Copyright (C) 2007, 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math math.functions sequences
+sequences.private words namespaces macros hints
+combinators fry ;
+IN: math.bitwise
+
+! utilities
+: clear-bit ( x n -- y ) 2^ bitnot bitand ; inline
+: set-bit ( x n -- y ) 2^ bitor ; inline
+: bit-clear? ( x n -- ? ) 2^ bitand zero? ; inline
+: unmask ( x n -- ? ) bitnot bitand ; inline
+: unmask? ( x n -- ? ) unmask 0 > ; inline
+: mask ( x n -- ? ) bitand ; inline
+: mask? ( x n -- ? ) mask 0 > ; inline
+: wrap ( m n -- m' ) 1- bitand ; inline
+: bits ( m n -- m' ) 2^ wrap ; inline
+: mask-bit ( m n -- m' ) 1- 2^ mask ; inline
+
+: shift-mod ( n s w -- n )
+    >r shift r> 2^ wrap ; inline
+
+: bitroll ( x s w -- y )
+     [ wrap ] keep
+     [ shift-mod ]
+     [ [ - ] keep shift-mod ] 3bi bitor ; inline
+
+: bitroll-32 ( n s -- n' ) 32 bitroll ;
+
+HINTS: bitroll-32 bignum fixnum ;
+
+: bitroll-64 ( n s -- n' ) 64 bitroll ;
+
+HINTS: bitroll-64 bignum fixnum ;
+
+! 32-bit arithmetic
+: w+ ( int int -- int ) + 32 bits ; inline
+: w- ( int int -- int ) - 32 bits ; inline
+: w* ( int int -- int ) * 32 bits ; inline
+
+! flags
+MACRO: flags ( values -- )
+    [ 0 ] [ [ execute bitor ] curry compose ] reduce ;
+
+! bitfield
+<PRIVATE
+
+GENERIC: (bitfield-quot) ( spec -- quot )
+
+M: integer (bitfield-quot) ( spec -- quot )
+    [ swapd shift bitor ] curry ;
+
+M: pair (bitfield-quot) ( spec -- quot )
+    first2 over word? [ >r swapd execute r> ] [ ] ?
+    [ shift bitor ] append 2curry ;
+
+PRIVATE>
+
+MACRO: bitfield ( bitspec -- )
+    [ 0 ] [ (bitfield-quot) compose ] reduce ;
+
+! bit-count
+<PRIVATE
+
+DEFER: byte-bit-count
+
+<<
+
+\ byte-bit-count
+256 [
+    0 swap [ [ 1+ ] when ] each-bit
+] B{ } map-as '[ HEX: ff bitand , nth-unsafe ] define-inline
+
+>>
+
+GENERIC: (bit-count) ( x -- n )
+
+M: fixnum (bit-count)
+    {
+        [           byte-bit-count ]
+        [ -8  shift byte-bit-count ]
+        [ -16 shift byte-bit-count ]
+        [ -24 shift byte-bit-count ]
+    } cleave + + + ;
+
+M: bignum (bit-count)
+    dup 0 = [ drop 0 ] [
+        [ byte-bit-count ] [ -8 shift (bit-count) ] bi +
+    ] if ;
+
+PRIVATE>
+
+: bit-count ( x -- n )
+    dup 0 >= [ (bit-count) ] [ bitnot (bit-count) ] if ; inline

basis/math/bitwise/summary.txt

@@ -0,0 +1 @@
+Bitwise arithmetic utilities

basis/math/complex/complex.factor

@@ -49,5 +49,5 @@ IN: syntax
 : C{ \ } [ first2 rect> ] parse-literal ; parsing
 
 M: complex pprint-delims drop \ C{ \ } ;
-
 M: complex >pprint-sequence >rect 2array ;
+M: complex pprint* pprint-object ;

basis/multiline/multiline-docs.factor

@@ -9,14 +9,30 @@ HELP: <"
 { $syntax "<\" text \">" }
 { $description "This forms a multiline string literal ending in \">. Unlike the " { $link POSTPONE: STRING: } " form, you can end it in the middle of a line. This construct is non-nesting. In the example above, the string would be parsed as \"text\"." } ;
 
-{ POSTPONE: <" POSTPONE: STRING: } related-words
+HELP: /*
+{ $syntax "/* comment */" }
+{ $description "Provides C-like comments that can span multiple lines. One caveat is that " { $snippet "/*" } " and " { $snippet "*/" } " are still tokens and must not abut the comment text itself." }
+{ $example "USING: multiline ;"
+           "/* I think that I shall never see"
+           "   A poem lovely as a tree. */"
+           ""
+} ;
 
-HELP: parse-here
+{ POSTPONE: <" POSTPONE: STRING: } related-words
-{ $values { "str" "a string" } }
-{ $description "Parses a multiline string literal, as used by " { $link POSTPONE: STRING: } "." } ;
 
 HELP: parse-multiline-string
 { $values { "end-text" "a string delineating the end" } { "str" "the parsed string" } }
-{ $description "Parses a multiline string literal, as used by " { $link POSTPONE: <" } ". The end-text is the delimiter for the end." } ;
+{ $description "Parses the input stream until the " { $snippet "end-text" } " is reached and returns the parsed text as a string." }
+{ $notes "Used to implement " { $link POSTPONE: /* } " and " { $link POSTPONE: <" } "." } ;
 
-{ parse-here parse-multiline-string } related-words
+ARTICLE: "multiline" "Multiline"
+"Multiline strings:"
+{ $subsection POSTPONE: STRING: }
+{ $subsection POSTPONE: <" }
+"Multiline comments:"
+{ $subsection POSTPONE: /* }
+"Writing new multiline parsing words:"
+{ $subsection parse-multiline-string }
+;
+
+ABOUT: "multiline"

basis/multiline/multiline.factor

@@ -4,6 +4,7 @@ USING: namespaces parser lexer kernel sequences words quotations math
 accessors ;
 IN: multiline
 
+<PRIVATE
 : next-line-text ( -- str )
     lexer get dup next-line line-text>> ;
 
@@ -13,6 +14,7 @@ IN: multiline
         [ drop lexer get next-line ]
         [ % "\n" % (parse-here) ] if
     ] [ ";" unexpected-eof ] if* ;
+PRIVATE>
 
 : parse-here ( -- str )
     [ (parse-here) ] "" make but-last
@@ -22,6 +24,7 @@ IN: multiline
     CREATE-WORD
     parse-here 1quotation define-inline ; parsing
 
+<PRIVATE
 : (parse-multiline-string) ( start-index end-text -- end-index )
     lexer get line-text>> [
         2dup start
@@ -30,6 +33,7 @@ IN: multiline
             lexer get next-line swap (parse-multiline-string)
         ] if*
     ] [ nip unexpected-eof ] if* ;
+PRIVATE>
 
 : parse-multiline-string ( end-text -- str )
     [

basis/nmake/nmake-tests.factor

@@ -0,0 +1,8 @@
+IN: nmake.tests
+USING: nmake kernel tools.test ;
+
+[ ] [ [ ] { } nmake ] unit-test
+
+[ { 1 } { 2 } ] [ [ 1 0, 2 1, ] { { } { } } nmake ] unit-test
+
+[ [ ] [ call ] curry { { } } nmake ] must-infer

basis/nmake/nmake.factor

@@ -0,0 +1,44 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: namespaces sequences math.parser kernel macros
+generalizations locals ;
+IN: nmake
+
+SYMBOL: building-seq 
+: get-building-seq ( n -- seq )
+    building-seq get nth ;
+
+: n, ( obj n -- ) get-building-seq push ;
+: n% ( seq n -- ) get-building-seq push-all ;
+: n# ( num n -- ) >r number>string r> n% ;
+
+: 0, ( obj -- ) 0 n, ;
+: 0% ( seq -- ) 0 n% ;
+: 0# ( num -- ) 0 n# ;
+: 1, ( obj -- ) 1 n, ;
+: 1% ( seq -- ) 1 n% ;
+: 1# ( num -- ) 1 n# ;
+: 2, ( obj -- ) 2 n, ;
+: 2% ( seq -- ) 2 n% ;
+: 2# ( num -- ) 2 n# ;
+: 3, ( obj -- ) 3 n, ;
+: 3% ( seq -- ) 3 n% ;
+: 3# ( num -- ) 3 n# ;
+: 4, ( obj -- ) 4 n, ;
+: 4% ( seq -- ) 4 n% ;
+: 4# ( num -- ) 4 n# ;
+
+MACRO: finish-nmake ( exemplars -- )
+    length [ firstn ] curry ;
+
+:: nmake ( quot exemplars -- )
+    [
+        exemplars
+        [ 0 swap new-resizable ] map
+        building-seq set
+
+        quot call
+
+        building-seq get
+        exemplars [ [ like ] 2map ] [ finish-nmake ] bi
+    ] with-scope ; inline

basis/openssl/libssl/libssl.factor

@@ -2,7 +2,7 @@
 ! Portions copyright (C) 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax combinators kernel system namespaces
-assocs parser lexer sequences words quotations math.bitfields ;
+assocs parser lexer sequences words quotations math.bitwise ;
 
 IN: openssl.libssl
 

basis/peg/ebnf/ebnf.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel compiler.units words arrays strings math.parser sequences 
        quotations vectors namespaces math assocs continuations peg
-       peg.parsers unicode.categories multiline combinators.lib 
+       peg.parsers unicode.categories multiline 
        splitting accessors effects sequences.deep peg.search
        combinators.short-circuit lexer io.streams.string
        stack-checker io prettyprint combinators parser ;

basis/peg/peg.factor

@@ -513,18 +513,11 @@ TUPLE: action-parser p1 quot ;
 M: action-parser (compile) ( peg -- quot )
   [ p1>> compile-parser 1quotation ] [ quot>> ] bi '[ @ , check-action ] ;
 
-: left-trim-slice ( string -- string )
-  #! Return a new string without any leading whitespace
-  #! from the original string.
-  dup empty? [
-    dup first blank? [ rest-slice left-trim-slice ] when
-  ] unless ;
-
 TUPLE: sp-parser p1 ;
 
 M: sp-parser (compile) ( peg -- quot )
   p1>> compile-parser 1quotation '[ 
-    input-slice left-trim-slice input-from pos set @ 
+    input-slice [ blank? ] trim-left-slice input-from pos set @ 
   ] ;
 
 TUPLE: delay-parser quot ;

basis/persistent/hashtables/hashtables.factor

@@ -51,5 +51,5 @@ M: persistent-hash clone ;
 : PH{ \ } [ >persistent-hash ] parse-literal ; parsing
 
 M: persistent-hash pprint-delims drop \ PH{ \ } ;
-
 M: persistent-hash >pprint-sequence >alist ;
+M: persistent-hash pprint* pprint-object ;

basis/persistent/hashtables/nodes/bitmap/bitmap.factor

@@ -1,7 +1,7 @@
 ! Based on Clojure's PersistentHashMap by Rich Hickey.
 
-USING: math math.bit-count arrays kernel accessors locals sequences
+USING: math math.bitwise arrays kernel accessors locals sequences
-sequences.private sequences.lib
+sequences.private
 persistent.sequences
 persistent.hashtables.config
 persistent.hashtables.nodes ;

basis/persistent/hashtables/nodes/collision/collision.factor

@@ -1,6 +1,6 @@
 ! Based on Clojure's PersistentHashMap by Rich Hickey.
 
-USING: kernel accessors math arrays fry sequences sequences.lib
+USING: kernel accessors math arrays fry sequences
 locals persistent.sequences
 persistent.hashtables.config
 persistent.hashtables.nodes

basis/persistent/hashtables/nodes/full/full.factor

@@ -1,7 +1,7 @@
 ! Based on Clojure's PersistentHashMap by Rich Hickey.
 
 USING: math accessors kernel arrays sequences sequences.private
-locals sequences.lib
+locals
 persistent.sequences
 persistent.hashtables.config
 persistent.hashtables.nodes ;

basis/persistent/hashtables/nodes/nodes.factor

@@ -1,6 +1,6 @@
 ! Based on Clojure's PersistentHashMap by Rich Hickey.
 
-USING: math arrays kernel sequences sequences.lib
+USING: math arrays kernel sequences
 accessors locals persistent.hashtables.config ;
 IN: persistent.hashtables.nodes
 

basis/persistent/vectors/vectors.factor

@@ -182,7 +182,7 @@ M: persistent-vector equal?
 : PV{ \ } [ >persistent-vector ] parse-literal ; parsing
 
 M: persistent-vector pprint-delims drop \ PV{ \ } ;
-
 M: persistent-vector >pprint-sequence ;
+M: persistent-vector pprint* pprint-object ;
 
 INSTANCE: persistent-vector immutable-sequence

basis/prettyprint/backend/backend-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io kernel prettyprint
+USING: help.markup help.syntax io kernel
 prettyprint.config prettyprint.sections words strings ;
 IN: prettyprint.backend
 
@@ -24,7 +24,7 @@ HELP: unparse-ch
 
 HELP: do-string-limit
 { $values { "str" string } { "trimmed" "a possibly trimmed string" } }
-{ $description "If " { $link string-limit } " is on, trims the string such that it does not exceed the margin, appending \"...\" if trimming took place." } ;
+{ $description "If " { $link string-limit? } " is on, trims the string such that it does not exceed the margin, appending \"...\" if trimming took place." } ;
 
 HELP: pprint-string
 { $values { "obj" object } { "str" string } { "prefix" string } { "suffix" string } }

basis/prettyprint/backend/backend.factor

@@ -80,7 +80,7 @@ M: f pprint* drop \ f pprint-word ;
     dup ch>ascii-escape [ "\\" % ] [ ] ?if , ;
 
 : do-string-limit ( str -- trimmed )
-    string-limit get [
+    string-limit? get [
         dup length margin get > [
             margin get 3 - head "..." append
         ] when
@@ -129,6 +129,30 @@ M: pathname pprint*
         ] if
     ] if ; inline
 
+: tuple>assoc ( tuple -- assoc )
+    [ class all-slots ] [ tuple-slots ] bi zip
+    [ [ initial>> ] dip = not ] assoc-filter
+    [ [ name>> ] dip ] assoc-map ;
+
+: pprint-slot-value ( name value -- )
+    <flow \ { pprint-word
+    [ text ] [ f <inset pprint* block> ] bi*
+    \ } pprint-word block> ;
+
+M: tuple pprint*
+    boa-tuples? get [ call-next-method ] [
+        [
+            <flow
+            \ T{ pprint-word
+            dup class pprint-word
+            t <inset
+            tuple>assoc [ pprint-slot-value ] assoc-each
+            block>
+            \ } pprint-word
+            block>
+        ] check-recursion
+    ] if ;
+
 : do-length-limit ( seq -- trimmed n/f )
     length-limit get dup [
         over length over [-]
@@ -188,6 +212,8 @@ M: tuple pprint-narrow? drop t ;
     ] check-recursion ;
 
 M: object pprint* pprint-object ;
+M: vector pprint* pprint-object ;
+M: hashtable pprint* pprint-object ;
 
 M: curry pprint*
     dup quot>> callable? [ pprint-object ] [

basis/prettyprint/config/config-docs.factor

@@ -1,4 +1,4 @@
-USING: help.markup help.syntax io kernel prettyprint
+USING: help.markup help.syntax io kernel
 prettyprint.sections words ;
 IN: prettyprint.config
 
@@ -19,5 +19,9 @@ HELP: length-limit
 HELP: line-limit
 { $var-description "The maximum number of lines output by the prettyprinter before output is truncated with \"...\". The default is " { $link f } ", denoting unlimited line count." } ;
 
-HELP: string-limit
+HELP: string-limit?
 { $var-description "Toggles whether printed strings are truncated to the margin." } ;
+
+HELP: boa-tuples?
+{ $var-description "Toggles whether tuples print in BOA-form or assoc-form." }
+{ $notes "See " { $link POSTPONE: T{ } " for a description of both literal tuple forms." } ;

basis/prettyprint/config/config.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-IN: prettyprint.config
 USING: arrays generic assocs io kernel math
 namespaces sequences strings io.styles vectors words
 continuations ;
+IN: prettyprint.config
 
 ! Configuration
 SYMBOL: tab-size
@@ -11,10 +11,8 @@ SYMBOL: margin
 SYMBOL: nesting-limit
 SYMBOL: length-limit
 SYMBOL: line-limit
-SYMBOL: string-limit
+SYMBOL: string-limit?
+SYMBOL: boa-tuples?
 
-global [
+4 tab-size set-global
-    4 tab-size set
+64 margin set-global
-    64 margin set
-    string-limit off
-] bind

basis/prettyprint/prettyprint-docs.factor

@@ -26,7 +26,8 @@ ARTICLE: "prettyprint-variables" "Prettyprint control variables"
 { $subsection nesting-limit }
 { $subsection length-limit }
 { $subsection line-limit }
-{ $subsection string-limit }
+{ $subsection string-limit? }
+{ $subsection boa-tuples? }
 "Note that the " { $link short. } " and " { $link pprint-short } " variables override some of these variables."
 {
     $warning "Treat the global variables as essentially being constants. Only ever rebind them in a nested scope."
@@ -86,7 +87,7 @@ $nl
 { $subsection "prettyprint-section-protocol" } ;
 
 ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol"
-"Unless a more specialized method exists for the input class, the " { $link pprint* } " word outputs an object in a standard format, ultimately calling two generic words:"
+"Most custom data types have a literal syntax which resembles a sequence. An easy way to define such a syntax is to add a method to the " { $link pprint* } " generic word which calls " { $link pprint-object } ", and then to provide methods on two other generic words:"
 { $subsection pprint-delims }
 { $subsection >pprint-sequence }
 "For example, consider the following data type, together with a parsing word for creating literals:"
@@ -104,10 +105,11 @@ ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol"
 { $code "RECT[ 100 * 200 ]" }
 "Without further effort, the literal does not print in the same way:"
 { $unchecked-example "RECT[ 100 * 200 ] ." "T{ rect f 100 200 }" }
-"However, we can define two methods easily enough:"
+"However, we can define three methods easily enough:"
 { $code
     "M: rect pprint-delims drop \\ RECT[ \\ ] ;"
     "M: rect >pprint-sequence dup rect-w \\ * rot rect-h 3array ;"
+    "M: rect pprint* pprint-object ;"
 }
 "Now, it will be printed in a custom way:"
 { $unchecked-example "RECT[ 100 * 200 ] ." "RECT[ 100 * 200 ]" } ;

basis/prettyprint/prettyprint.factor

@@ -71,7 +71,8 @@ IN: prettyprint
        { line-limit 1 }
        { length-limit 15 }
        { nesting-limit 2 }
-       { string-limit t }
+       { string-limit? t }
+       { boa-tuples? t }
     } clone [ pprint ] bind ;
 
 : unparse-short ( obj -- str )

basis/random/mersenne-twister/mersenne-twister.factor

@@ -3,7 +3,7 @@
 ! mersenne twister based on 
 ! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
 USING: arrays kernel math namespaces sequences system init
-accessors math.ranges random circular math.bitfields.lib
+accessors math.ranges random circular math.bitwise
 combinators ;
 IN: random.mersenne-twister
 

basis/random/random-tests.factor

@@ -1,4 +1,4 @@
-USING: random sequences tools.test ;
+USING: random sequences tools.test kernel ;
 IN: random.tests
 
 [ 4 ] [ 4 random-bytes length ] unit-test
@@ -6,3 +6,6 @@ IN: random.tests
 
 [ 4 ] [ [ 4 random-bytes length ] with-secure-random ] unit-test
 [ 7 ] [ [ 7 random-bytes length ] with-secure-random ] unit-test
+
+[ 2 ] [ V{ 10 20 30 } [ delete-random drop ] keep length ] unit-test
+[ V{ } [ delete-random drop ] keep length ] must-fail

basis/random/random.factor

@@ -43,6 +43,9 @@ M: f random-32* ( obj -- * ) no-random-number-generator ;
         ] keep nth
     ] if ;
 
+: delete-random ( seq -- elt )
+    [ length random ] keep [ nth ] 2keep delete-nth ;
+
 : random-bits ( n -- r ) 2^ random ;
 
 : with-random ( tuple quot -- )

basis/smtp/smtp.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007, 2008 Elie CHAFTARI, Dirk Vleugels,
 ! Slava Pestov, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays namespaces io io.timeouts kernel logging io.sockets
+USING: arrays namespaces io io.timeouts kernel logging
-sequences combinators sequences.lib splitting assocs strings
+io.sockets sequences combinators splitting assocs strings
 math.parser random system calendar io.encodings.ascii summary
 calendar.format accessors sets hashtables ;
 IN: smtp
@@ -112,7 +112,7 @@ ERROR: smtp-transaction-failed < smtp-error ;
     } cond ;
 
 : multiline? ( response -- boolean )
-    ?fourth CHAR: - = ;
+    3 swap ?nth CHAR: - = ;
 
 : process-multiline ( multiline -- response )
     >r readln r> 2dup " " append head? [
@@ -184,21 +184,3 @@ PRIVATE>
 
 : send-email ( email -- )
     [ email>headers ] keep (send-email) ;
-
-! Dirk's old AUTH CRAM-MD5 code. I don't know anything about
-! CRAM MD5, and the old code didn't work properly either, so here
-! it is in case anyone wants to fix it later.
-!
-! check-response used to have this clause:
-! { [ dup "334" head? ] [ " " split 1 swap nth base64> challenge set ] }
-!
-! and the rest of the code was as follows:
-! : (cram-md5-auth) ( -- response )
-!     swap challenge get 
-!     string>md5-hmac hex-string 
-!     " " prepend append 
-!     >base64 ;
-! 
-! : cram-md5-auth ( key login  -- )
-!     "AUTH CRAM-MD5\r\n" get-ok 
-!     (cram-md5-auth) "\r\n" append get-ok ;

basis/stack-checker/known-words/known-words.factor

@@ -47,7 +47,7 @@ IN: stack-checker.known-words
 
 : infer-shuffle ( shuffle -- )
     [ in>> length consume-d ] keep ! inputs shuffle
-    [ drop ] [ shuffle* dup copy-values dup output-d ] 2bi ! inputs outputs copies
+    [ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
     [ nip ] [ swap zip ] 2bi ! inputs copies mapping
     #shuffle, ;