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

Makefile

@@ -3,6 +3,7 @@ AR = ar
 LD = ld
 
 EXECUTABLE = factor
+CONSOLE_EXECUTABLE = factor-console
 VERSION = 0.92
 
 IMAGE = factor.image
@@ -138,9 +139,11 @@ zlib1.dll:
 
 winnt-x86-32: freetype6.dll zlib1.dll
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
+	$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32
 
 winnt-x86-64:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
+	$(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
 
 wince-arm:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm
@@ -161,6 +164,11 @@ factor: $(DLL_OBJS) $(EXE_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
 		$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
 
+factor-console: $(DLL_OBJS) $(EXE_OBJS)
+	$(LINKER) $(ENGINE) $(DLL_OBJS)
+	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
+		$(CFLAGS) $(CFLAGS_CONSOLE) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
+
 clean:
 	rm -f vm/*.o
 	rm -f factor*.dll libfactor.{a,so,dylib}

basis/base64/base64.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: combinators io io.binary io.encodings.binary
 io.streams.byte-array io.streams.string kernel math namespaces
-sequences strings ;
+sequences strings io.crlf ;
 IN: base64
 
 <PRIVATE
@@ -32,7 +32,7 @@ SYMBOL: column
 : write1-lines ( ch -- )
     write1
     column get [
-        1+ [ 76 = [ "\r\n" write ] when ]
+        1+ [ 76 = [ crlf ] when ]
         [ 76 mod column set ] bi
     ] when* ;
 
@@ -45,8 +45,8 @@ SYMBOL: column
     ] with each ; inline
 
 : encode-pad ( seq n -- )
-    [ 3 0 pad-right binary [ encode3 ] with-byte-writer ]
+    [ 3 0 pad-tail binary [ encode3 ] with-byte-writer ]
-    [ 1+ ] bi* head-slice 4 CHAR: = pad-right write-lines ; inline
+    [ 1+ ] bi* head-slice 4 CHAR: = pad-tail write-lines ; inline
 
 ERROR: malformed-base64 ;
 

basis/base64/tags.txt

@@ -0,0 +1,2 @@
+parsing
+web

basis/bootstrap/image/image.factor

@@ -351,7 +351,7 @@ M: wrapper '
     bootstrap-cell <groups> native> emit-seq ;
 
 : pad-bytes ( seq -- newseq )
-    dup length bootstrap-cell align 0 pad-right ;
+    dup length bootstrap-cell align 0 pad-tail ;
 
 : extended-part ( str -- str' )
     dup [ 128 < ] all? [ drop f ] [

basis/bootstrap/stage2.factor

@@ -13,7 +13,7 @@ SYMBOL: core-bootstrap-time
 SYMBOL: bootstrap-time
 
 : default-image-name ( -- string )
-    vm file-name os windows? [ "." split1 drop ] when
+    vm file-name os windows? [ "." split1-last drop ] when
     ".image" append resource-path ;
 
 : do-crossref ( -- )

basis/calendar/format/format.factor

@@ -5,11 +5,11 @@ sequences io accessors arrays io.streams.string splitting
 combinators accessors calendar calendar.format.macros present ;
 IN: calendar.format
 
-: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-left ;
+: pad-00 ( n -- str ) number>string 2 CHAR: 0 pad-head ;
 
-: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-left ;
+: pad-0000 ( n -- str ) number>string 4 CHAR: 0 pad-head ;
 
-: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-left ;
+: pad-00000 ( n -- str ) number>string 5 CHAR: 0 pad-head ;
 
 : write-00 ( n -- ) pad-00 write ;
 

basis/checksums/sha1/sha1.factor

@@ -128,7 +128,7 @@ M: sha1 checksum-stream ( stream -- sha1 )
     [ zip concat ] keep like ;
 
 : sha1-interleave ( string -- seq )
-    [ zero? ] trim-left
+    [ zero? ] trim-head
     dup length odd? [ rest ] when
     seq>2seq [ sha1 checksum-bytes ] bi@
     2seq>seq ;

basis/checksums/sha2/sha2.factor

@@ -62,7 +62,7 @@ SYMBOLS: vars M K H S0 S1 process-M word-size block-size ;
     [ + + w+ ] 2dip swap set-nth ; inline
 
 : prepare-message-schedule ( seq -- w-seq )
-    word-size get group [ be> ] map block-size get 0 pad-right
+    word-size get group [ be> ] map block-size get 0 pad-tail
     dup 16 64 dup <slice> [
         process-M-256
     ] with each ;

basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor

@@ -13,7 +13,7 @@ IN: compiler.cfg.alias-analysis.tests
 
 [ ] [
     {
-        T{ ##load-indirect f V int-regs 1 "hello" }
+        T{ ##load-reference f V int-regs 1 "hello" }
         T{ ##slot-imm f V int-regs 0 V int-regs 1 0 3 }
     } alias-analysis drop
 ] unit-test

basis/compiler/cfg/alias-analysis/alias-analysis.factor

@@ -224,7 +224,7 @@ GENERIC: analyze-aliases* ( insn -- insn' )
 M: ##load-immediate analyze-aliases*
     dup [ val>> ] [ dst>> ] bi constants get set-at ;
 
-M: ##load-indirect analyze-aliases*
+M: ##load-reference analyze-aliases*
     dup dst>> set-heap-ac ;
 
 M: ##alien-global analyze-aliases*

basis/compiler/cfg/instructions/instructions.factor

@@ -36,13 +36,13 @@ TUPLE: ##alien-setter < ##effect { value vreg } ;
 
 ! Stack operations
 INSN: ##load-immediate < ##pure { val integer } ;
-INSN: ##load-indirect < ##pure obj ;
+INSN: ##load-reference < ##pure obj ;
 
 GENERIC: ##load-literal ( dst value -- )
 
 M: fixnum ##load-literal tag-fixnum ##load-immediate ;
 M: f ##load-literal drop \ f tag-number ##load-immediate ;
-M: object ##load-literal ##load-indirect ;
+M: object ##load-literal ##load-reference ;
 
 INSN: ##peek < ##read { loc loc } ;
 INSN: ##replace < ##write { loc loc } ;

basis/compiler/cfg/linearization/linearization.factor

@@ -63,7 +63,7 @@ M: ##compare-float-branch linearize-insn
             ##box-float
             ##box-alien
         } memq?
-    ] contains? ;
+    ] any? ;
 
 : linearize-basic-block ( bb -- )
     [ number>> _label ]

basis/compiler/cfg/value-numbering/expressions/expressions.factor

@@ -39,8 +39,6 @@ GENERIC: >expr ( insn -- expr )
 
 M: ##load-immediate >expr val>> <constant> ;
 
-M: ##load-indirect >expr obj>> <constant> ;
-
 M: ##unary >expr
     [ class ] [ src>> vreg>vn ] bi unary-expr boa ;
 

basis/compiler/cfg/value-numbering/value-numbering-tests.factor

@@ -81,7 +81,7 @@ sequences ;
 
 [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
         T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> }
@@ -89,7 +89,7 @@ sequences ;
     }
 ] [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> }
         T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc/= }
@@ -99,7 +99,7 @@ sequences ;
 
 [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
         T{ ##compare f V int-regs 6 V int-regs 2 V int-regs 1 cc> }
@@ -107,7 +107,7 @@ sequences ;
     }
 ] [
     {
-        T{ ##load-indirect f V int-regs 1 + }
+        T{ ##load-reference f V int-regs 1 + }
         T{ ##peek f V int-regs 2 D 0 }
         T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= }
         T{ ##compare-imm f V int-regs 6 V int-regs 4 7 cc= }

basis/compiler/codegen/codegen.factor

@@ -70,8 +70,8 @@ SYMBOL: labels
 M: ##load-immediate generate-insn
     [ dst>> register ] [ val>> ] bi %load-immediate ;
 
-M: ##load-indirect generate-insn
+M: ##load-reference generate-insn
-    [ dst>> register ] [ obj>> ] bi %load-indirect ;
+    [ dst>> register ] [ obj>> ] bi %load-reference ;
 
 M: ##peek generate-insn
     [ dst>> register ] [ loc>> ] bi %peek ;
@@ -400,7 +400,7 @@ M: no-such-symbol compiler-error-type
 
 : check-dlsym ( symbols dll -- )
     dup dll-valid? [
-        dupd '[ _ dlsym ] contains?
+        dupd '[ _ dlsym ] any?
         [ drop ] [ no-such-symbol ] if
     ] [
         dll-path no-such-library drop

basis/compiler/tests/codegen.factor

@@ -276,3 +276,9 @@ TUPLE: id obj ;
 
 [ 4 ] [ 2 [ dup fixnum* ] compile-call ] unit-test
 [ 7 ] [ 2 [ dup fixnum* 3 fixnum+fast ] compile-call ] unit-test
+
+TUPLE: cucumber ;
+
+M: cucumber equal? "The cucumber has no equal" throw ;
+
+[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test

basis/compiler/tests/stack-trace.factor

@@ -19,14 +19,14 @@ words splitting grouping sorting accessors ;
 
 : bleh ( seq -- seq' ) [ 3 + ] map [ 0 > ] filter ;
 
-: stack-trace-contains? ( word -- ? ) symbolic-stack-trace memq? ;
+: stack-trace-any? ( word -- ? ) symbolic-stack-trace memq? ;
 
 [ t ] [
-    [ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-contains?
+    [ { 1 "hi" } bleh ] ignore-errors \ + stack-trace-any?
 ] unit-test
     
 [ t f ] [
     [ { "hi" } bleh ] ignore-errors
-    \ + stack-trace-contains?
+    \ + stack-trace-any?
-    \ > stack-trace-contains?
+    \ > stack-trace-any?
 ] unit-test

basis/compiler/tree/builder/builder-tests.factor

@@ -8,4 +8,4 @@ compiler.tree ;
 
 : inline-recursive ( -- ) inline-recursive ; inline recursive
 
-[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] contains? nip ] unit-test
+[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test

basis/compiler/tree/checker/checker.factor

@@ -175,7 +175,7 @@ M: #branch check-stack-flow*
     branch-out get [ ] find nip swap head* >vector datastack set ;
 
 M: #phi check-stack-flow*
-    branch-out get [ ] contains? [
+    branch-out get [ ] any? [
         [ check-phi-in ] [ set-phi-datastack ] [ check-out-d ] tri
     ] [ drop terminated? on ] if ;
 

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -498,7 +498,7 @@ cell-bits 32 = [
 
 [ t ] [
     [ { array-capacity } declare 1 fixnum+ ] cleaned-up-tree
-    [ { [ #call? ] [ node-input-infos second literal>> 1 = ] } 1&& ] contains?
+    [ { [ #call? ] [ node-input-infos second literal>> 1 = ] } 1&& ] any?
 ] unit-test
 
 [ ] [

basis/compiler/tree/combinators/combinators.factor

@@ -34,14 +34,14 @@ IN: compiler.tree.combinators
     dup dup '[
         _ keep swap [ drop t ] [
             dup #branch? [
-                children>> [ _ contains-node? ] contains?
+                children>> [ _ contains-node? ] any?
             ] [
                 dup #recursive? [
                     child>> _ contains-node?
                 ] [ drop f ] if
             ] if
         ] if
-    ] contains? ; inline recursive
+    ] any? ; inline recursive
 
 : select-children ( seq flags -- seq' )
     [ [ drop f ] unless ] 2map ;

basis/compiler/tree/dead-code/simple/simple.factor

@@ -79,7 +79,7 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
     dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ;
 
 : some-outputs-dead? ( #call -- ? )
-    out-d>> [ live-value? not ] contains? ;
+    out-d>> [ live-value? not ] any? ;
 
 : maybe-drop-dead-outputs ( node -- nodes )
     dup some-outputs-dead? [

basis/compiler/tree/normalization/normalization.factor

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

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -124,7 +124,7 @@ DEFER: (flat-length)
         [ class-types length 1 = ]
         [ union-class? not ]
         bi and
-    ] contains? ;
+    ] any? ;
 
 : node-count-bias ( -- n )
     45 node-count get [-] 8 /i ;

basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor

@@ -118,7 +118,7 @@ M: #return-recursive unbox-tuples*
 ! These nodes never participate in unboxing
 : assert-not-unboxed ( values -- )
     dup array?
-    [ [ unboxed-allocation ] contains? ] [ unboxed-allocation ] if
+    [ [ unboxed-allocation ] any? ] [ unboxed-allocation ] if
     [ "Unboxing wrong value" throw ] when ;
 
 M: #branch unbox-tuples* dup in-d>> assert-not-unboxed ;

basis/concurrency/mailboxes/mailboxes.factor

@@ -25,7 +25,7 @@ M: mailbox dispose* threads>> notify-all ;
 
 :: block-unless-pred ( mailbox timeout pred: ( message -- ? ) -- )
     mailbox check-disposed
-    mailbox data>> pred dlist-contains? [
+    mailbox data>> pred dlist-any? [
         mailbox timeout wait-for-mailbox
         mailbox timeout pred block-unless-pred
     ] unless ; inline recursive

basis/cpu/architecture/architecture.factor

@@ -38,7 +38,7 @@ M: object param-reg param-regs nth ;
 HOOK: two-operand? cpu ( -- ? )
 
 HOOK: %load-immediate cpu ( reg obj -- )
-HOOK: %load-indirect cpu ( reg obj -- )
+HOOK: %load-reference cpu ( reg obj -- )
 
 HOOK: %peek cpu ( vreg loc -- )
 HOOK: %replace cpu ( vreg loc -- )

basis/cpu/ppc/ppc.factor

@@ -34,7 +34,7 @@ M: ppc two-operand? f ;
 
 M: ppc %load-immediate ( reg n -- ) swap LOAD ;
 
-M: ppc %load-indirect ( reg obj -- )
+M: ppc %load-reference ( reg obj -- )
     [ 0 swap LOAD32 ] [ rc-absolute-ppc-2/2 rel-immediate ] bi* ;
 
 M: ppc %alien-global ( register symbol dll -- )
@@ -261,7 +261,7 @@ M:: ppc %fixnum-mul-tail ( src1 src2 temp1 temp2 -- )
 M:: ppc %integer>bignum ( dst src temp -- )
     [
         "end" define-label
-        dst 0 >bignum %load-indirect
+        dst 0 >bignum %load-reference
         ! Is it zero? Then just go to the end and return this zero
         0 src 0 CMPI
         "end" get BEQ
@@ -321,7 +321,7 @@ M:: ppc %integer>float ( dst src -- )
     scratch-reg dup HEX: 8000 XORIS
     scratch-reg 1 4 scratch@ STW
     dst 1 0 scratch@ LFD
-    scratch-reg 4503601774854144.0 %load-indirect
+    scratch-reg 4503601774854144.0 %load-reference
     fp-scratch-reg scratch-reg float-offset LFD
     dst dst fp-scratch-reg FSUB ;
 
@@ -488,7 +488,7 @@ M: ppc %epilogue ( n -- )
     "end" define-label
     dst \ f tag-number %load-immediate
     "end" get word execute
-    dst \ t %load-indirect
+    dst \ t %load-reference
     "end" get resolve-label ; inline
 
 : %boolean ( dst temp cc -- )
@@ -637,7 +637,7 @@ M: ppc %alien-invoke ( symbol dll -- )
     [ 11 ] 2dip %alien-global 11 MTLR BLRL ;
 
 M: ppc %alien-callback ( quot -- )
-    3 swap %load-indirect "c_to_factor" f %alien-invoke ;
+    3 swap %load-reference "c_to_factor" f %alien-invoke ;
 
 M: ppc %prepare-alien-indirect ( -- )
     "unbox_alien" f %alien-invoke

basis/cpu/x86/32/32.factor

@@ -237,7 +237,7 @@ M: x86.32 %alien-indirect ( -- )
 
 M: x86.32 %alien-callback ( quot -- )
     4 [
-        EAX swap %load-indirect
+        EAX swap %load-reference
         EAX PUSH
         "c_to_factor" f %alien-invoke
     ] with-aligned-stack ;

basis/cpu/x86/64/64.factor

@@ -176,7 +176,7 @@ M: x86.64 %alien-indirect ( -- )
     RBP CALL ;
 
 M: x86.64 %alien-callback ( quot -- )
-    param-reg-1 swap %load-indirect
+    param-reg-1 swap %load-reference
     "c_to_factor" f %alien-invoke ;
 
 M: x86.64 %callback-value ( ctype -- )

basis/cpu/x86/x86.factor

@@ -21,7 +21,7 @@ HOOK: param-reg-2 cpu ( -- reg )
 
 M: x86 %load-immediate MOV ;
 
-M: x86 %load-indirect swap 0 MOV rc-absolute-cell rel-immediate ;
+M: x86 %load-reference swap 0 MOV rc-absolute-cell rel-immediate ;
 
 HOOK: ds-reg cpu ( -- reg )
 HOOK: rs-reg cpu ( -- reg )
@@ -188,7 +188,7 @@ M:: x86 %integer>bignum ( dst src temp -- )
     [
         "end" define-label
         ! Load cached zero value
-        dst 0 >bignum %load-indirect
+        dst 0 >bignum %load-reference
         src 0 CMP
         ! Is it zero? Then just go to the end and return this zero
         "end" get JE

basis/csv/csv.factor

@@ -71,7 +71,7 @@ DEFER: quoted-field ( -- endchar )
   delimiter swap with-variable ; inline
 
 : needs-escaping? ( cell -- ? )
-  [ [ "\n\"" member? ] [ delimiter get = ] bi or ] contains? ; inline ! "
+  [ [ "\n\"" member? ] [ delimiter get = ] bi or ] any? ; inline
 
 : escape-quotes ( cell -- cell' )
   [ [ dup , CHAR: " = [ CHAR: " , ] when ] each ] "" make ; inline

basis/db/db-docs.factor

@@ -244,7 +244,7 @@ ARTICLE: "db-protocol" "Low-level database protocol"
 ! { $subsection bind-tuple }
 
 ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
-"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "."
+"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." $nl
 "Executing a SQL command:"
 { $subsection sql-command }
 "Executing a query directly:"

basis/db/queries/queries.factor

@@ -19,7 +19,7 @@ SINGLETON: retryable
     ] if ;
 
 : maybe-make-retryable ( statement -- statement )
-    dup in-params>> [ generator-bind? ] contains?
+    dup in-params>> [ generator-bind? ] any?
     [ make-retryable ] when ;
 
 : regenerate-params ( statement -- statement )

basis/db/sqlite/sqlite.factor

@@ -294,7 +294,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
     ] with-string-writer ;
 
 : can-be-null? ( -- ? )
-    "sql-spec" get modifiers>> [ +not-null+ = ] contains? not ;
+    "sql-spec" get modifiers>> [ +not-null+ = ] any? not ;
 
 : delete-cascade? ( -- ? )
     "sql-spec" get modifiers>> { +on-delete+ +cascade+ } swap subseq? ;

basis/db/tuples/tuples-docs.factor

@@ -90,7 +90,7 @@ HELP: ensure-table
 
 HELP: ensure-tables
 { $values
-     { "classes" null } }
+     { "classes" "a sequence of classes" } }
 { $description "Creates a SQL table from a mapping defined by " { $link define-persistent } ". If a table already exists, the error is silently ignored." } ;
 
 HELP: recreate-table

basis/db/types/types-docs.factor

@@ -4,39 +4,24 @@ USING: classes hashtables help.markup help.syntax io.streams.string
 kernel sequences strings math ;
 IN: db.types
 
-HELP: +autoincrement+
-{ $description "" } ;
-
 HELP: +db-assigned-id+
 { $description "The database assigns a primary key to the object. The primary key is most likely a big integer, but is database-dependent." } ;
 
 HELP: +default+
-{ $description "" } ;
+{ $description "Allows a default value for a column to be provided." } ;
-
-HELP: +foreign-id+
-{ $description "" } ;
-
-HELP: +has-many+
-{ $description "" } ;
 
 HELP: +not-null+
-{ $description "" } ;
+{ $description "Ensures that a column is not null." } ;
 
 HELP: +null+
-{ $description "" } ;
+{ $description "Allows a column to be null." } ;
 
 HELP: +primary-key+
-{ $description "" } ;
+{ $description "Makes a column a primary key. Only one column may be a primary key." } ;
 
 HELP: +random-id+
 { $description "Factor chooses a random number and tries to insert the tuple into the database with this number as its primary key. The default number of retries to find a unique random number is 10, though in practice it will almost certainly succeed on the first try." } ;
 
-HELP: +serial+
-{ $description "" } ;
-
-HELP: +unique+
-{ $description "" } ;
-
 HELP: +user-assigned-id+
 { $description "The user is responsible for choosing a primary key for tuples inserted with this database type. Keys must be unique or else the database will throw an error. Usually it is better to use a " { $link +db-assigned-id+ } "." } ;
 
@@ -114,12 +99,12 @@ HELP: user-assigned-id-spec?
 
 HELP: bind#
 { $values
-     { "spec" null } { "obj" object } }
+     { "spec" "a sql spec" } { "obj" object } }
 { $description "" } ;
 
 HELP: bind%
 { $values
-     { "spec" null } }
+     { "spec" "a sql spec" } }
 { $description "" } ;
 
 HELP: compound
@@ -176,7 +161,7 @@ HELP: low-level-binding
 
 HELP: modifiers
 { $values
-     { "spec" null }
+     { "spec" "a sql spec" }
      { "string" string } }
 { $description "" } ;
 
@@ -187,7 +172,7 @@ HELP: no-sql-type
 
 HELP: normalize-spec
 { $values
-     { "spec" null } }
+     { "spec" "a sql spec" } }
 { $description "" } ;
 
 HELP: offset-of-slot
@@ -204,7 +189,7 @@ HELP: persistent-table
 
 HELP: primary-key?
 { $values
-     { "spec" null }
+     { "spec" "a sql spec" }
      { "?" "a boolean" } }
 { $description "" } ;
 
@@ -213,37 +198,31 @@ HELP: random-id-generator
 
 HELP: relation?
 { $values
-     { "spec" null }
+     { "spec" "a sql spec" }
      { "?" "a boolean" } }
 { $description "" } ;
 
 HELP: remove-db-assigned-id
 { $values
-     { "specs" null }
+     { "specs" "a sequence of sql specs" }
      { "obj" object } }
 { $description "" } ;
 
 HELP: remove-id
 { $values
-     { "specs" null }
+     { "specs" "a sequence of sql specs" }
      { "obj" object } }
 { $description "" } ;
 
-HELP: remove-relations
-{ $values
-     { "specs" null }
-     { "newcolumns" null } }
-{ $description "" } ;
-
 HELP: set-slot-named
 { $values
-     { "value" null } { "name" null } { "obj" object } }
+     { "value" object } { "name" string } { "obj" object } }
 { $description "" } ;
 
 HELP: spec>tuple
 { $values
-     { "class" class } { "spec" null }
+     { "class" class } { "spec" "a sql spec" }
-     { "tuple" null } }
+     { "tuple" tuple } }
 { $description "" } ;
 
 HELP: sql-spec

basis/db/types/types.factor

@@ -71,10 +71,10 @@ ERROR: not-persistent class ;
     primary-key>> +primary-key+? ;
 
 : db-assigned-id-spec? ( specs -- ? )
-    [ primary-key>> +db-assigned-id+? ] contains? ;
+    [ primary-key>> +db-assigned-id+? ] any? ;
 
 : user-assigned-id-spec? ( specs -- ? )
-    [ primary-key>> +user-assigned-id+? ] contains? ;
+    [ primary-key>> +user-assigned-id+? ] any? ;
 
 : normalize-spec ( spec -- )
     dup type>> dup +primary-key+? [
@@ -105,7 +105,7 @@ FACTOR-BLOB NULL URL ;
         dup normalize-spec ;
 
 : spec>tuple ( class spec -- tuple )
-    3 f pad-right [ first3 ] keep 3 tail <sql-spec> ;
+    3 f pad-tail [ first3 ] keep 3 tail <sql-spec> ;
 
 : number>string* ( n/string -- string )
     dup number? [ number>string ] when ;

basis/dlists/dlists-docs.factor

@@ -15,7 +15,7 @@ $nl
 "Iterating over elements:"
 { $subsection dlist-each }
 { $subsection dlist-find }
-{ $subsection dlist-contains? }
+{ $subsection dlist-any? }
 "Deleting a node matching a predicate:"
 { $subsection delete-node-if* }
 { $subsection delete-node-if }
@@ -40,7 +40,7 @@ HELP: dlist-find
     "This operation is O(n)."
 } ;
 
-HELP: dlist-contains?
+HELP: dlist-any?
 { $values { "dlist" { $link dlist } } { "quot" quotation } { "?" "a boolean" } }
 { $description "Just like " { $link dlist-find } " except it doesn't return the object." }
 { $notes "This operation is O(n)." } ;

basis/dlists/dlists-tests.factor

@@ -46,8 +46,8 @@ IN: dlists.tests
 [ f f ] [ <dlist> [ 1 = ] dlist-find ] unit-test
 [ 1 t ] [ <dlist> 1 over push-back [ 1 = ] dlist-find ] unit-test
 [ f f ] [ <dlist> 1 over push-back [ 2 = ] dlist-find ] unit-test
-[ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-contains? ] unit-test
+[ f ] [ <dlist> 1 over push-back [ 2 = ] dlist-any? ] unit-test
-[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-contains? ] unit-test
+[ t ] [ <dlist> 1 over push-back [ 1 = ] dlist-any? ] unit-test
 
 [ 1 ] [ <dlist> 1 over push-back [ 1 = ] delete-node-if ] unit-test
 [ t ] [ <dlist> 1 over push-back dup [ 1 = ] delete-node-if drop deque-empty? ] unit-test

basis/dlists/dlists.factor

@@ -117,11 +117,11 @@ M: dlist pop-back* ( dlist -- )
 : dlist-find ( dlist quot -- obj/f ? )
     '[ obj>> @ ] dlist-find-node [ obj>> t ] [ drop f f ] if ; inline
 
-: dlist-contains? ( dlist quot -- ? )
+: dlist-any? ( dlist quot -- ? )
     dlist-find nip ; inline
 
 M: dlist deque-member? ( value dlist -- ? )
-    [ = ] with dlist-contains? ;
+    [ = ] with dlist-any? ;
 
 M: dlist delete-node ( dlist-node dlist -- )
     {

basis/farkup/farkup-tests.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: farkup kernel peg peg.ebnf tools.test namespaces xml
-urls.encoding assocs xml.utilities ;
+urls.encoding assocs xml.utilities xml.data ;
 IN: farkup.tests
 
 relative-link-prefix off
@@ -161,7 +161,7 @@ link-no-follow? off
 
 : check-link-escaping ( string -- link )
     convert-farkup string>xml-chunk
-    "a" deep-tag-named "href" swap at url-decode ;
+    "a" deep-tag-named "href" attr url-decode ;
 
 [ "Trader Joe\"s" ] [ "[[Trader Joe\"s]]" check-link-escaping ] unit-test
 [ "<foo>" ] [ "[[<foo>]]" check-link-escaping ] unit-test

basis/farkup/farkup.factor

@@ -34,7 +34,7 @@ TUPLE: line ;
 TUPLE: line-break ;
 
 : absolute-url? ( string -- ? )
-    { "http://" "https://" "ftp://" } [ head? ] with contains? ;
+    { "http://" "https://" "ftp://" } [ head? ] with any? ;
 
 : simple-link-title ( string -- string' )
     dup absolute-url? [ "/" split1-last swap or ] unless ;
@@ -162,7 +162,7 @@ stand-alone
 : check-url ( href -- href' )
     {
         { [ dup empty? ] [ drop invalid-url ] }
-        { [ dup [ 127 > ] contains? ] [ drop invalid-url ] }
+        { [ dup [ 127 > ] any? ] [ drop invalid-url ] }
         { [ dup first "/\\" member? ] [ drop invalid-url ] }
         { [ CHAR: : over member? ] [ dup absolute-url? [ drop invalid-url ] unless ] }
         [ relative-link-prefix get prepend "" like ]
@@ -236,7 +236,7 @@ M: f (write-farkup) ;
     parse-farkup (write-farkup) ;
 
 : write-farkup ( string -- )
-    farkup>xml write-xml-chunk ;
+    farkup>xml write-xml ;
 
 : convert-farkup ( string -- string' )
     [ write-farkup ] with-string-writer ;

basis/formatting/formatting-docs.factor

@@ -43,7 +43,7 @@ HELP: printf
     "string. For example:\n"
     { $list 
         "\"%.3s\" formats a string to truncate at 3 characters (from the left)."
-        "\"%.10f\" formats a float to pad-right with zeros up to 10 digits beyond the decimal point."
+        "\"%.10f\" formats a float to pad-tail with zeros up to 10 digits beyond the decimal point."
         "\"%.5E\" formats a float into scientific notation with zeros up to 5 digits beyond the decimal point, but before the exponent."
     }
 }

basis/formatting/formatting.factor

@@ -29,7 +29,7 @@ IN: formatting
     [ 0 ] [ string>number ] if-empty ;
 
 : pad-digits ( string digits -- string' )
-    [ "." split1 ] dip [ CHAR: 0 pad-right ] [ head-slice ] bi "." glue ;
+    [ "." split1 ] dip [ CHAR: 0 pad-tail ] [ head-slice ] bi "." glue ;
 
 : max-digits ( n digits -- n' )
     10 swap ^ [ * round ] keep / ; inline
@@ -48,7 +48,7 @@ IN: formatting
     [ max-digits ] keep -rot
     [
         [ 0 < "-" "+" ? ]
-        [ abs number>string 2 CHAR: 0 pad-left ] bi 
+        [ abs number>string 2 CHAR: 0 pad-head ] bi 
         "e" -rot 3append
     ]
     [ number>string ] bi*
@@ -60,7 +60,7 @@ zero      = "0"                  => [[ CHAR: 0 ]]
 char      = "'" (.)              => [[ second ]]
 
 pad-char  = (zero|char)?         => [[ CHAR: \s or ]]
-pad-align = ("-")?               => [[ \ pad-right \ pad-left ? ]] 
+pad-align = ("-")?               => [[ \ pad-tail \ pad-head ? ]] 
 pad-width = ([0-9])*             => [[ >digits ]]
 pad       = pad-align pad-char pad-width => [[ reverse >quotation dup first 0 = [ drop [ ] ] when ]]
 
@@ -110,9 +110,9 @@ MACRO: printf ( format-string -- )
 
 <PRIVATE
 
-: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-left ; inline
+: pad-00 ( n -- string ) number>string 2 CHAR: 0 pad-head ; inline
 
-: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-left ; inline
+: pad-000 ( n -- string ) number>string 3 CHAR: 0 pad-head ; inline
 
 : >time ( timestamp -- string )
     [ hour>> ] [ minute>> ] [ second>> floor ] tri 3array

basis/ftp/client/listing-parser/listing-parser.factor

@@ -39,7 +39,7 @@ name target ;
 
 : parse-list-11 ( lines -- seq )
     [
-        11 f pad-right
+        11 f pad-tail
         <remote-file> swap {
             [ 0 swap nth parse-permissions ]
             [ 1 swap nth string>number >>links ]

basis/functors/functors-tests.factor

@@ -34,7 +34,7 @@ WW DEFINES ${W}${W}
 
 WHERE
 
-: WW W twice ; inline
+: WW ( a -- b ) \ W twice ; inline
 
 ;FUNCTOR
 
@@ -45,3 +45,21 @@ WHERE
 \ sqsq must-infer
 
 [ 16 ] [ 2 sqsq ] unit-test
+
+<<
+
+FUNCTOR: wrapper-test-2 ( W -- )
+
+W DEFINES ${W}
+
+WHERE
+
+: W ( a b -- c ) \ + execute ;
+
+;FUNCTOR
+
+"blah" wrapper-test-2
+
+>>
+
+[ 4 ] [ 1 3 blah ] unit-test

basis/functors/functors.factor

@@ -1,17 +1,43 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel quotations classes.tuple make combinators generic
 words interpolate namespaces sequences io.streams.string fry
 classes.mixin effects lexer parser classes.tuple.parser
 effects.parser locals.types locals.parser
-locals.rewrite.closures vocabs.parser ;
+locals.rewrite.closures vocabs.parser arrays accessors ;
 IN: functors
 
-: scan-param ( -- obj )
+! This is a hack
-    scan-object dup special? [ literalize ] unless ;
+
+<PRIVATE
+
+: scan-param ( -- obj ) scan-object literalize ;
 
 : define* ( word def effect -- ) pick set-word define-declared ;
 
+TUPLE: fake-quotation seq ;
+
+GENERIC: >fake-quotations ( quot -- fake )
+
+M: callable >fake-quotations
+    >array >fake-quotations fake-quotation boa ;
+
+M: array >fake-quotations [ >fake-quotations ] { } map-as ;
+
+M: object >fake-quotations ;
+
+GENERIC: fake-quotations> ( fake -- quot )
+
+M: fake-quotation fake-quotations>
+    seq>> [ fake-quotations> ] map >quotation ;
+
+M: array fake-quotations> [ fake-quotations> ] map ;
+
+M: object fake-quotations> ;
+
+: parse-definition* ( -- )
+    parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
+
 : DEFINE* ( accum -- accum ) effect get parsed \ define* parsed ;
 
 : `TUPLE:
@@ -32,7 +58,7 @@ IN: functors
     scan-param parsed
     scan-param parsed
     \ create-method parsed
-    parse-definition parsed
+    parse-definition*
     DEFINE* ; parsing
 
 : `C:
@@ -45,7 +71,7 @@ IN: functors
 : `:
     effect off
     scan-param parsed
-    parse-definition parsed
+    parse-definition*
     DEFINE* ; parsing
 
 : `INSTANCE:
@@ -64,12 +90,16 @@ IN: functors
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
 
+PRIVATE>
+
 : IS [ dup search [ ] [ no-word ] ?if ] (INTERPOLATE) ; parsing
 
 : DEFINES [ create-in ] (INTERPOLATE) ; parsing
 
 DEFER: ;FUNCTOR delimiter
 
+<PRIVATE
+
 : functor-words ( -- assoc )
     H{
         { "TUPLE:" POSTPONE: `TUPLE: }
@@ -104,4 +134,6 @@ DEFER: ;FUNCTOR delimiter
     parse-functor-body swap pop-locals <lambda>
     rewrite-closures first ;
 
+PRIVATE>
+
 : FUNCTOR: (FUNCTOR:) define ; parsing

basis/furnace/auth/features/edit-profile/edit-profile.factor

@@ -31,7 +31,7 @@ IN: furnace.auth.features.edit-profile
             } validate-params
 
             { "password" "new-password" "verify-password" }
-            [ value empty? not ] contains? [
+            [ value empty? not ] any? [
                 "password" value username check-login
                 [ "incorrect password" validation-error ] unless
 

basis/furnace/auth/login/login.factor

@@ -16,7 +16,7 @@ IN: furnace.auth.login
 SYMBOL: permit-id
 
 : permit-id-key ( realm -- string )
-    [ >hex 2 CHAR: 0 pad-left ] { } map-as concat
+    [ >hex 2 CHAR: 0 pad-head ] { } map-as concat
     "__p_" prepend ;
 
 : client-permit-id ( realm -- id/f )

basis/furnace/utilities/utilities.factor

@@ -29,7 +29,7 @@ ERROR: no-such-word name vocab ;
 
 : base-path ( string -- pair )
     dup responder-nesting get
-    [ second class superclasses [ name>> = ] with contains? ] with find nip
+    [ second class superclasses [ name>> = ] with any? ] with find nip
     [ first ] [ "No such responder: " swap append throw ] ?if ;
 
 : resolve-base-path ( string -- string' )

basis/help/lint/lint.factor

@@ -43,7 +43,7 @@ SYMBOL: vocabs-quot
         $predicate
         $class-description
         $error-description
-    } swap '[ _ elements empty? not ] contains? ;
+    } swap '[ _ elements empty? not ] any? ;
 
 : don't-check-word? ( word -- ? )
     {
@@ -103,7 +103,7 @@ SYMBOL: vocabs-quot
     [ "Missing whitespace between strings" throw ] unless ;
 
 : check-bogus-nl ( element -- )
-    { { $nl } { { $nl } } } [ head? ] with contains?
+    { { $nl } { { $nl } } } [ head? ] with any?
     [ "Simple element should not begin with a paragraph break" throw ] when ;
 
 : check-elements ( element -- )
@@ -114,12 +114,22 @@ SYMBOL: vocabs-quot
         [ 2 <clumps> [ [ string? ] all? ] filter [ first2 check-whitespace ] each ]
     } cleave ;
 
+: check-descriptions ( element -- )
+    { $description $class-description $var-description }
+    swap '[
+        _ elements [
+            rest { { } { "" } } member?
+            [ "Empty description" throw ] when
+        ] each
+    ] each ;
+
 : check-markup ( element -- )
     {
         [ check-elements ]
         [ check-rendering ]
         [ check-examples ]
         [ check-modules ]
+        [ check-descriptions ]
     } cleave ;
 
 : all-word-help ( words -- seq )

basis/html/components/components.factor

@@ -19,7 +19,7 @@ GENERIC: render* ( value name renderer -- xml )
         [ f swap ]
         if
     ] 2dip
-    render* write-xml-chunk
+    render* write-xml
     [ render-error ] when* ;
 
 <PRIVATE
@@ -176,4 +176,4 @@ M: comparison render*
 ! HTML component
 SINGLETON: html
 
-M: html render* 2drop string>xml-chunk ;
+M: html render* 2drop <unescaped> ;

basis/html/elements/elements.factor

@@ -1,11 +1,9 @@
-! cont-html v0.6
+! Copyright (C) 2004, 2009 Chris Double, Daniel Ehrenberg.
-!
-! Copyright (C) 2004 Chris Double.
 ! See http://factorcode.org/license.txt for BSD license.
-
 USING: io io.styles kernel namespaces prettyprint quotations
 sequences strings words xml.entities compiler.units effects
-urls math math.parser combinators present fry ;
+xml.data xml.interpolate urls math math.parser combinators
+present fry io.streams.string xml.writer ;
 
 IN: html.elements
 
@@ -135,17 +133,18 @@ SYMBOL: html
     "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\">" write-html ;
 
 : simple-page ( title head-quot body-quot -- )
-    #! Call the quotation, with all output going to the
+    [ with-string-writer <unescaped> ] bi@
-    #! body of an html page with the given title.
+    <XML
-    spin
+        <?xml version="1.0"?>
-    xhtml-preamble
+        <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
-    <html "http://www.w3.org/1999/xhtml" =xmlns "en" =xml:lang "en" =lang html>
+        <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
             <head>
-            <title> write </title>
+                <title><-></title>
-            call
+                <->
             </head>
-        <body> call </body>
+            <body><-></body>
-    </html> ; inline
+        </html>
+    XML> write-xml ; inline
 
 : render-error ( message -- )
-    <span "error" =class span> escape-string write </span> ;
+    [XML <span class="error"><-></span> XML] write-xml ;

basis/html/streams/streams.factor

@@ -55,7 +55,7 @@ TUPLE: html-sub-stream < html-stream style parent ;
 
 : hex-color, ( color -- )
     [ red>> ] [ green>> ] [ blue>> ] tri
-    [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] tri@ ;
+    [ 255 * >fixnum >hex 2 CHAR: 0 pad-head % ] tri@ ;
 
 : fg-css, ( color -- )
     "color: #" % hex-color, "; " % ;

basis/html/templates/chloe/compiler/compiler.factor

@@ -7,16 +7,16 @@ html.templates html.templates.chloe.syntax continuations ;
 IN: html.templates.chloe.compiler
 
 : chloe-attrs-only ( assoc -- assoc' )
-    [ drop url>> chloe-ns = ] assoc-filter ;
+    [ drop chloe-name? ] assoc-filter ;
 
 : non-chloe-attrs-only ( assoc -- assoc' )
-    [ drop url>> chloe-ns = not ] assoc-filter ;
+    [ drop chloe-name? not ] assoc-filter ;
 
 : chloe-tag? ( tag -- ? )
     dup xml? [ body>> ] when
     {
         { [ dup tag? not ] [ f ] }
-        { [ dup url>> chloe-ns = not ] [ f ] }
+        { [ dup chloe-name? not ] [ f ] }
         [ t ]
     } cond nip ;
 
@@ -59,7 +59,7 @@ DEFER: compile-element
 
 : compile-start-tag ( tag -- )
     "<" [write]
-    [ name>string [write] ] [ compile-attrs ] bi
+    [ name>string [write] ] [ attrs>> compile-attrs ] bi
     ">" [write] ;
 
 : compile-end-tag ( tag -- )
@@ -90,7 +90,7 @@ ERROR: unknown-chloe-tag tag ;
         { [ dup [ tag? ] [ xml? ] bi or ] [ compile-tag ] }
         { [ dup string? ] [ escape-string [write] ] }
         { [ dup comment? ] [ drop ] }
-        [ [ write-xml-chunk ] [code-with] ]
+        [ [ write-xml ] [code-with] ]
     } cond ;
 
 : with-compiler ( quot -- quot' )
@@ -126,7 +126,7 @@ ERROR: unknown-chloe-tag tag ;
 
 : compile-prologue ( xml -- )
     [
-        [ prolog>> [ write-prolog ] [code-with] ]
+        [ prolog>> [ write-xml ] [code-with] ]
         [ before>> compile-chunk ]
         bi
     ] compile-quot

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

@@ -21,14 +21,14 @@ tags global [ H{ } clone or ] change-at
 
 : chloe-ns "http://factorcode.org/chloe/1.0" ; inline
 
-: chloe-name ( string -- name )
+: chloe-name? ( name -- ? )
-    name new
+    url>> chloe-ns = ;
-        swap >>main
+
-        chloe-ns >>url ;
+XML-NS: chloe-name http://factorcode.org/chloe/1.0
 
 : required-attr ( tag name -- value )
-    dup chloe-name rot at*
+    tuck chloe-name attr
-    [ nip ] [ drop " attribute is required" append throw ] if ;
+    [ nip ] [ " attribute is required" append throw ] if* ;
 
 : optional-attr ( tag name -- value )
-    chloe-name swap at ;
+    chloe-name attr ;

basis/http/client/client.factor

@@ -5,7 +5,7 @@ sequences strings splitting calendar continuations accessors vectors
 math.order hashtables byte-arrays destructors
 io io.sockets io.streams.string io.files io.timeouts
 io.pathnames io.encodings io.encodings.string io.encodings.ascii
-io.encodings.utf8 io.encodings.8-bit io.encodings.binary
+io.encodings.utf8 io.encodings.8-bit io.encodings.binary io.crlf
 io.streams.duplex fry ascii urls urls.encoding present
 http http.parsers http.client.post-data ;
 IN: http.client
@@ -86,7 +86,7 @@ SYMBOL: redirects
     ] [ too-many-redirects ] if ; inline recursive
 
 : read-chunk-size ( -- n )
-    read-crlf ";" split1 drop [ blank? ] trim-right
+    read-crlf ";" split1 drop [ blank? ] trim-tail
     hex> [ "Bad chunk size" throw ] unless* ;
 
 : read-chunked ( quot: ( chunk -- ) -- )

basis/http/http-tests.factor

@@ -2,7 +2,7 @@ USING: http http.server http.client http.client.private tools.test multiline
 io.streams.string io.encodings.utf8 io.encodings.8-bit
 io.encodings.binary io.encodings.string kernel arrays splitting
 sequences assocs io.sockets db db.sqlite continuations urls
-hashtables accessors namespaces ;
+hashtables accessors namespaces xml.data ;
 IN: http.tests
 
 [ "text/plain" latin1 ] [ "text/plain" parse-content-type ] unit-test
@@ -322,7 +322,7 @@ SYMBOL: a
 
 3 a set-global
 
-: test-a string>xml "input" tag-named "value" swap at ;
+: test-a string>xml "input" tag-named "value" attr ;
 
 [ "3" ] [
     "http://localhost/" add-port http-get

basis/http/http.factor

@@ -6,7 +6,7 @@ quotations arrays byte-arrays math.parser calendar
 calendar.format present urls
 
 io io.encodings io.encodings.iana io.encodings.binary
-io.encodings.8-bit
+io.encodings.8-bit io.crlf
 
 unicode.case unicode.categories
 
@@ -16,12 +16,6 @@ EXCLUDE: fry => , ;
 
 IN: http
 
-: crlf ( -- ) "\r\n" write ;
-
-: read-crlf ( -- bytes )
-    "\r" read-until
-    [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;
-
 : (read-header) ( -- alist )
     [ read-crlf dup f like ] [ parse-header-line ] [ drop ] produce ;
 

basis/http/server/server.factor

@@ -12,8 +12,10 @@ io.encodings.utf8
 io.encodings.ascii
 io.encodings.binary
 io.streams.limited
+io.streams.string
 io.servers.connection
 io.timeouts
+io.crlf
 fry logging logging.insomniac calendar urls urls.encoding
 mime.multipart
 unicode.categories

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>> trim-right-separators
+    file-responder get root>> trim-tail-separators
     "/"
-    rot "" or trim-left-separators 3append ;
+    rot "" or trim-head-separators 3append ;
 
 : serve-file ( filename -- response )
     dup mime-type

basis/io/backend/unix/unix.factor

@@ -164,10 +164,10 @@ M: stdin refill
         size-read-fd <fd> init-fd <input-port> >>size
         data-read-fd <fd> >>data ;
 
-M: unix (init-stdio) ( -- )
+M: unix (init-stdio)
     <stdin> <input-port>
     1 <fd> <output-port>
-    2 <fd> <output-port> ;
+    2 <fd> <output-port> t ;
 
 ! mx io-task for embedding an fd-based mx inside another mx
 TUPLE: mx-port < port mx ;

basis/io/backend/windows/nt/nt.factor

@@ -120,6 +120,9 @@ M: winnt (wait-to-read) ( port -- )
         tri
     ] with-destructors ;
 
-M: winnt (init-stdio) init-c-stdio ;
+: console-app? ( -- ? ) GetConsoleWindow >boolean ;
+
+M: winnt (init-stdio)
+    console-app? [ init-c-stdio t ] [ f f f f ] if ;
 
 winnt set-io-backend

basis/io/crlf/authors.txt

@@ -0,0 +1,2 @@
+Daniel Ehrenberg
+Slava Pestov

basis/io/crlf/crlf-docs.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2009 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup sequences ;
+IN: io.crlf
+
+HELP: crlf
+{ $values }
+{ $description "Prints a carriage return and line feed to the current output stream, used to indicate a newline for certain network protocols." } ;
+
+HELP: read-crlf
+{ $values { "seq" sequence } }
+{ $description "Reads until the next CRLF (carriage return followed by line feed) from the current input stream, throwing an error if there is not a CRLF remaining, or if CR is present without immediately being followed by LF." } ;

basis/io/crlf/crlf.factor

@@ -0,0 +1,11 @@
+! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov
+! See http://factorcode.org/license.txt for BSD license.
+USING: io kernel ;
+IN: io.crlf
+
+: crlf ( -- )
+    "\r\n" write ;
+
+: read-crlf ( -- seq )
+    "\r" read-until
+    [ CHAR: \r assert= read1 CHAR: \n assert= ] when* ;

basis/io/crlf/summary.txt

@@ -0,0 +1 @@
+Writing and reading until \r\n

basis/io/directories/directories.factor

@@ -15,7 +15,7 @@ IN: io.directories
 HOOK: make-directory io-backend ( path -- )
 
 : make-directories ( path -- )
-    normalize-path trim-right-separators {
+    normalize-path trim-tail-separators {
         { [ dup "." = ] [ ] }
         { [ dup root-directory? ] [ ] }
         { [ dup empty? ] [ ] }

basis/io/directories/search/search-docs.factor

@@ -52,7 +52,7 @@ HELP: find-all-in-directories
 
 { find-file find-all-files find-in-directories find-all-in-directories } related-words
 
-ARTICLE: "io.directories.search" "io.directories.search"
+ARTICLE: "io.directories.search" "Searching directories"
 "The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
 "Traversing directories:"
 { $subsection recursive-directory }

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

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

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

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

basis/io/mmap/functor/functor.factor

@@ -20,9 +20,9 @@ with-mapped-A-file DEFINES with-mapped-${T}-file
 WHERE
 
 : <mapped-A> ( mapped-file -- direct-array )
-    T mapped-file>direct <A> execute ; inline
+    T mapped-file>direct <A> ; inline
 
 : with-mapped-A-file ( path length quot -- )
-    '[ <mapped-A> execute @ ] with-mapped-file ; inline
+    '[ <mapped-A> @ ] with-mapped-file ; inline
 
 ;FUNCTOR

basis/io/mmap/mmap-docs.factor

@@ -19,6 +19,7 @@ HELP: <mapped-file>
 HELP: with-mapped-file
 { $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
 { $contract "Opens a file and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
+{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
 { $errors "Throws an error if a memory mapping could not be established." } ;
 
 HELP: close-mapped-file

basis/io/monitors/linux/linux-tests.factor

@@ -2,7 +2,7 @@ IN: io.monitors.linux.tests
 USING: io.monitors tools.test io.files io.files.temp
 io.directories system sequences continuations namespaces
 concurrency.count-downs kernel io threads calendar prettyprint
-destructors io.timeouts ;
+destructors io.timeouts accessors ;
 
 ! On Linux, a notification on the directory itself would report an invalid
 ! path name

basis/io/monitors/monitors-tests.factor

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

basis/io/styles/styles.factor

@@ -118,7 +118,7 @@ M: plain-writer make-block-stream
 : format-column ( seq ? -- seq )
     [
         [ 0 [ length max ] reduce ] keep
-        swap [ CHAR: \s pad-right ] curry map
+        swap [ CHAR: \s pad-tail ] curry map
     ] unless ;
 
 : map-last ( seq quot -- seq )

basis/io/timeouts/timeouts.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov, Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel calendar alarms io io.encodings accessors
-namespaces fry ;
+namespaces fry io.streams.null ;
 IN: io.timeouts
 
 GENERIC: timeout ( obj -- dt/f )
@@ -27,3 +27,5 @@ GENERIC: cancel-operation ( obj -- )
 : timeouts ( dt -- )
     [ input-stream get set-timeout ]
     [ output-stream get set-timeout ] bi ;
+
+M: null-stream set-timeout 2drop ;

basis/lcs/diff2html/diff2html-tests.factor

@@ -3,4 +3,4 @@
 USING: lcs.diff2html lcs kernel tools.test strings sequences xml.writer ;
 IN: lcs.diff2html.tests
 
-[ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml-chunk>string drop ] unit-test
+[ ] [ "hello" "heyo" [ 1string ] { } map-as diff htmlize-diff xml>string drop ] unit-test

basis/locals/locals-docs.factor

@@ -113,7 +113,7 @@ HELP: MEMO::
 
 { POSTPONE: MEMO: POSTPONE: MEMO:: } related-words
 
-ARTICLE: "locals-literals" "Locals in array and hashtable literals"
+ARTICLE: "locals-literals" "Locals in literals"
 "Certain data type literals are permitted to contain free variables. Any such literals are written into code which constructs an instance of the type with the free variable values spliced in. Conceptually, this is similar to the transformation applied to quotations containing free variables."
 $nl
 "The data types which receive this special handling are the following:"
@@ -122,7 +122,9 @@ $nl
     { $link "hashtables" }
     { $link "vectors" }
     { $link "tuples" }
+    { $link "wrappers" }
 }
+{ $heading "Object identity" }
 "This feature changes the semantics of literal object identity. An ordinary word containing a literal pushes the same literal on the stack every time it is invoked:"
 { $example
     "IN: scratchpad"
@@ -143,7 +145,7 @@ $nl
     "f"
 }
 "One exception to the above rule is that array instances containing no free variables do retain identity. This allows macros such as " { $link cond } " to recognize that the array is constant and expand at compile-time."
-$nl
+{ $heading "Example" }
 "For example, here is an implementation of the " { $link 3array } " word which uses this feature:"
 { $code ":: 3array ( x y z -- array ) { x y z } ;" } ;
 

basis/locals/locals-tests.factor

@@ -495,3 +495,9 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 ! Discovered by littledan
 [ "bar" ] [ [let | a [ [let | foo [ "bar" ] | foo ] ] | a ] ] unit-test
 [ 10 ] [ [let | a [ 10 ] | [let | b [ a ] | b ] ] ] unit-test
+
+[ { \ + } ] [ [let | x [ \ + ] | { \ x } ] ] unit-test
+
+[ { \ + 3 } ] [ [let | a [ 3 ] | { \ + a } ] ] unit-test
+
+[ 3 ] [ [let | a [ \ + ] | 1 2 [ \ a execute ] ] call ] unit-test

basis/locals/rewrite/point-free/point-free.factor

@@ -40,7 +40,7 @@ M: object localize 1quotation ;
 ! We special-case all the :> at the start of a quotation
 : load-locals-quot ( args -- quot )
     [ [ ] ] [
-        dup [ local-reader? ] contains? [
+        dup [ local-reader? ] any? [
             dup [ local-reader? [ 1array ] [ ] ? ] map
             spread>quot
         ] [ [ ] ] if swap length [ load-locals ] curry append

basis/locals/rewrite/sugar/sugar.factor

@@ -33,11 +33,11 @@ GENERIC: rewrite-literal? ( obj -- ? )
 
 M: special rewrite-literal? drop t ;
 
-M: array rewrite-literal? [ rewrite-literal? ] contains? ;
+M: array rewrite-literal? [ rewrite-literal? ] any? ;
 
-M: quotation rewrite-literal? [ rewrite-literal? ] contains? ;
+M: quotation rewrite-literal? [ rewrite-literal? ] any? ;
 
-M: wrapper rewrite-literal? drop t ;
+M: wrapper rewrite-literal? wrapped>> rewrite-literal? ;
 
 M: hashtable rewrite-literal? drop t ;
 
@@ -53,7 +53,7 @@ GENERIC: rewrite-element ( obj -- )
     [ rewrite-element ] each ;
 
 : rewrite-sequence ( seq -- )
-    [ rewrite-elements ] [ length , ] [ 0 head , ] tri \ nsequence , ;
+    [ rewrite-elements ] [ length ] [ 0 head ] tri '[ _ _ nsequence ] % ;
 
 M: array rewrite-element
     dup rewrite-literal? [ rewrite-sequence ] [ , ] if ;
@@ -63,7 +63,7 @@ M: vector rewrite-element rewrite-sequence ;
 M: hashtable rewrite-element >alist rewrite-sequence \ >hashtable , ;
 
 M: tuple rewrite-element
-    [ tuple-slots rewrite-elements ] [ class literalize , ] bi \ boa , ;
+    [ tuple-slots rewrite-elements ] [ class ] bi '[ _ boa ] % ;
 
 M: quotation rewrite-element rewrite-sugar* ;
 
@@ -81,10 +81,14 @@ M: local-writer rewrite-element
 M: local-word rewrite-element
     local-word-in-literal-error ;
 
-M: word rewrite-element literalize , ;
+M: word rewrite-element <wrapper> , ;
+
+: rewrite-wrapper ( wrapper -- )
+    dup rewrite-literal?
+    [ wrapped>> rewrite-element ] [ , ] if ;
 
 M: wrapper rewrite-element
-    dup rewrite-literal? [ wrapped>> rewrite-element ] [ , ] if ;
+    rewrite-wrapper \ <wrapper> , ;
 
 M: object rewrite-element , ;
 
@@ -98,7 +102,8 @@ M: def rewrite-sugar* , ;
 
 M: hashtable rewrite-sugar* rewrite-element ;
 
-M: wrapper rewrite-sugar* rewrite-element ;
+M: wrapper rewrite-sugar*
+    rewrite-wrapper ;
 
 M: word rewrite-sugar*
     dup { load-locals get-local drop-locals } memq?

basis/locals/types/types.factor

@@ -1,6 +1,7 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Eduardo Cavazos.
+! Copyright (C) 2007, 2009 Slava Pestov, Eduardo Cavazos.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel sequences words ;
+USING: accessors combinators kernel sequences words
+quotations ;
 IN: locals.types
 
 TUPLE: lambda vars body ;
@@ -38,6 +39,8 @@ PREDICATE: local < word "local?" word-prop ;
     f <word>
     dup t "local?" set-word-prop ;
 
+M: local literalize ;
+
 PREDICATE: local-word < word "local-word?" word-prop ;
 
 : <local-word> ( name -- word )
@@ -49,6 +52,8 @@ PREDICATE: local-reader < word "local-reader?" word-prop ;
     f <word>
     dup t "local-reader?" set-word-prop ;
 
+M: local-reader literalize ;
+
 PREDICATE: local-writer < word "local-writer?" word-prop ;
 
 : <local-writer> ( reader -- word )

basis/math/blas/cblas/tags.txt

@@ -1,3 +1,2 @@
 math
 bindings
-unportable

basis/math/blas/matrices/matrices.factor

@@ -268,28 +268,28 @@ TUPLE: MATRIX < blas-matrix-base ;
 M: MATRIX element-type
     drop TYPE ;
 M: MATRIX (blas-matrix-like)
-    drop <MATRIX> execute ;
+    drop <MATRIX> ;
 M: VECTOR (blas-matrix-like)
-    drop <MATRIX> execute ;
+    drop <MATRIX> ;
 M: MATRIX (blas-vector-like)
-    drop <VECTOR> execute ;
+    drop <VECTOR> ;
 
 : >MATRIX ( arrays -- matrix )
-    [ >ARRAY execute underlying>> ] (>matrix)
+    [ >ARRAY underlying>> ] (>matrix)
-    <MATRIX> execute ;
+    <MATRIX> ;
 
 M: VECTOR n*M.V+n*V!
-    [ TYPE>ARG execute ] (prepare-gemv)
+    [ TYPE>ARG ] (prepare-gemv)
-    [ XGEMV execute ] dip ;
+    [ XGEMV ] dip ;
 M: MATRIX n*M.M+n*M!
-    [ TYPE>ARG execute ] (prepare-gemm)
+    [ TYPE>ARG ] (prepare-gemm)
-    [ XGEMM execute ] dip ;
+    [ XGEMM ] dip ;
 M: MATRIX n*V(*)V+M!
-    [ TYPE>ARG execute ] (prepare-ger)
+    [ TYPE>ARG ] (prepare-ger)
-    [ XGERU execute ] dip ;
+    [ XGERU ] dip ;
 M: MATRIX n*V(*)Vconj+M!
-    [ TYPE>ARG execute ] (prepare-ger)
+    [ TYPE>ARG ] (prepare-ger)
-    [ XGERC execute ] dip ;
+    [ XGERC ] dip ;
 
 ;FUNCTOR
 

basis/math/blas/matrices/tags.txt

@@ -1,3 +1,2 @@
 math
 bindings
-unportable

basis/math/blas/syntax/syntax.factor

@@ -1,5 +1,5 @@
 USING: kernel math.blas.vectors math.blas.matrices parser
-arrays prettyprint.backend sequences ;
+arrays prettyprint.backend prettyprint.custom sequences ;
 IN: math.blas.syntax
 
 : svector{

basis/math/blas/syntax/tags.txt

@@ -1,2 +1 @@
 math
-unportable

basis/math/blas/vectors/tags.txt

@@ -1,2 +1 @@
 math
-unportable

basis/math/blas/vectors/vectors.factor

@@ -144,26 +144,26 @@ TUPLE: VECTOR < blas-vector-base ;
 : <VECTOR> ( underlying length inc -- vector ) VECTOR boa ; inline
 
 : >VECTOR ( seq -- v )
-    [ >ARRAY execute underlying>> ] [ length ] bi 1 <VECTOR> execute ;
+    [ >ARRAY underlying>> ] [ length ] bi 1 <VECTOR> ;
 
 M: VECTOR clone
     TYPE heap-size (prepare-copy)
-    [ XCOPY execute ] 3dip <VECTOR> execute ;
+    [ XCOPY ] 3dip <VECTOR> ;
 
 M: VECTOR element-type
     drop TYPE ;
 M: VECTOR Vswap
-    (prepare-swap) [ XSWAP execute ] 2dip ;
+    (prepare-swap) [ XSWAP ] 2dip ;
 M: VECTOR Viamax
-    (prepare-nrm2) IXAMAX execute ;
+    (prepare-nrm2) IXAMAX ;
 
 M: VECTOR (blas-vector-like)
-    drop <VECTOR> execute ;
+    drop <VECTOR> ;
 
 M: VECTOR (blas-direct-array)
     [ underlying>> ]
     [ [ length>> ] [ inc>> ] bi * ] bi
-    <DIRECT-ARRAY> execute ;
+    <DIRECT-ARRAY> ;
 
 ;FUNCTOR
 
@@ -180,17 +180,17 @@ XSCAL          IS cblas_${T}scal
 WHERE
 
 M: VECTOR V.
-    (prepare-dot) XDOT execute ;
+    (prepare-dot) XDOT ;
 M: VECTOR V.conj
-    (prepare-dot) XDOT execute ;
+    (prepare-dot) XDOT ;
 M: VECTOR Vnorm
-    (prepare-nrm2) XNRM2 execute ;
+    (prepare-nrm2) XNRM2 ;
 M: VECTOR Vasum
-    (prepare-nrm2) XASUM execute ;
+    (prepare-nrm2) XASUM ;
 M: VECTOR n*V+V!
-    (prepare-axpy) [ XAXPY execute ] dip ;
+    (prepare-axpy) [ XAXPY ] dip ;
 M: VECTOR n*V!
-    (prepare-scal) [ XSCAL execute ] dip ;
+    (prepare-scal) [ XSCAL ] dip ;
 
 ;FUNCTOR
 
@@ -207,13 +207,13 @@ COMPLEX>ARG            DEFINES ${TYPE}-complex>arg
 WHERE
 
 : <DIRECT-COMPLEX-ARRAY> ( alien len -- sequence )
-    1 shift <DIRECT-ARRAY> execute <complex-sequence> ;
+    1 shift <DIRECT-ARRAY> <complex-sequence> ;
 : >COMPLEX-ARRAY ( sequence -- sequence )
-    <complex-components> >ARRAY execute ;
+    <complex-components> >ARRAY ;
 : COMPLEX>ARG ( complex -- alien )
-    >rect 2array >ARRAY execute underlying>> ;
+    >rect 2array >ARRAY underlying>> ;
 : ARG>COMPLEX ( alien -- complex )
-    2 <DIRECT-ARRAY> execute first2 rect> ;
+    2 <DIRECT-ARRAY> first2 rect> ;
 
 ;FUNCTOR
 
@@ -234,22 +234,22 @@ WHERE
 
 M: VECTOR V.
     (prepare-dot) TYPE <c-object>
-    [ XDOTU_SUB execute ] keep
+    [ XDOTU_SUB ] keep
-    ARG>TYPE execute ;
+    ARG>TYPE ;
 M: VECTOR V.conj
     (prepare-dot) TYPE <c-object>
-    [ XDOTC_SUB execute ] keep
+    [ XDOTC_SUB ] keep
-    ARG>TYPE execute ;
+    ARG>TYPE ;
 M: VECTOR Vnorm
-    (prepare-nrm2) XXNRM2 execute ;
+    (prepare-nrm2) XXNRM2 ;
 M: VECTOR Vasum
-    (prepare-nrm2) XXASUM execute ;
+    (prepare-nrm2) XXASUM ;
 M: VECTOR n*V+V!
-    [ TYPE>ARG execute ] 2dip
+    [ TYPE>ARG ] 2dip
-    (prepare-axpy) [ XAXPY execute ] dip ;
+    (prepare-axpy) [ XAXPY ] dip ;
 M: VECTOR n*V!
-    [ TYPE>ARG execute ] dip
+    [ TYPE>ARG ] dip
-    (prepare-scal) [ XSCAL execute ] dip ;
+    (prepare-scal) [ XSCAL ] dip ;
 
 ;FUNCTOR
 

basis/math/combinatorics/combinatorics.factor

@@ -25,7 +25,7 @@ IN: math.combinatorics
     reverse 1 cut [ (>permutation) ] each ;
 
 : permutation-indices ( n seq -- permutation )
-    length [ factoradic ] dip 0 pad-left >permutation ;
+    length [ factoradic ] dip 0 pad-head >permutation ;
 
 PRIVATE>
 

basis/math/intervals/intervals.factor

@@ -77,7 +77,7 @@ TUPLE: interval { from read-only } { to read-only } ;
     [ from>> ] [ to>> ] bi ;
 
 : points>interval ( seq -- interval )
-    dup [ first fp-nan? ] contains?
+    dup [ first fp-nan? ] any?
     [ drop [-inf,inf] ] [
         dup first
         [ [ endpoint-min ] reduce ]

basis/math/polynomials/polynomials.factor

@@ -6,10 +6,10 @@ IN: math.polynomials
 
 <PRIVATE
 
-: 2pad-left ( p q n -- p q ) [ 0 pad-left ] curry bi@ ;
+: 2pad-head ( p q n -- p q ) [ 0 pad-head ] curry bi@ ;
-: 2pad-right ( p q n -- p q ) [ 0 pad-right ] curry bi@ ;
+: 2pad-tail ( p q n -- p q ) [ 0 pad-tail ] curry bi@ ;
-: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-right ;
+: pextend ( p q -- p q ) 2dup [ length ] bi@ max 2pad-tail ;
-: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-left ;
+: pextend-left ( p q -- p q ) 2dup [ length ] bi@ max 2pad-head ;
 : unempty ( seq -- seq ) [ { 0 } ] when-empty ;
 : 2unempty ( seq seq -- seq seq ) [ unempty ] bi@ ;
 
@@ -21,7 +21,7 @@ PRIVATE>
 : p= ( p q -- ? ) pextend = ;
 
 : ptrim ( p -- p )
-    dup length 1 = [ [ zero? ] trim-right ] unless ;
+    dup length 1 = [ [ zero? ] trim-tail ] unless ;
 
 : 2ptrim ( p q -- p q ) [ ptrim ] bi@ ;
 : p+ ( p q -- r ) pextend v+ ;
@@ -29,7 +29,7 @@ PRIVATE>
 : n*p ( n p -- n*p ) n*v ;
 
 : pextend-conv ( p q -- p q )
-    2dup [ length ] bi@ + 1- 2pad-right [ >vector ] bi@ ;
+    2dup [ length ] bi@ + 1- 2pad-tail [ >vector ] bi@ ;
 
 : p* ( p q -- r )
     2unempty pextend-conv <reversed> dup length
@@ -44,7 +44,7 @@ PRIVATE>
     2ptrim
     2dup [ length ] bi@ -
     dup 1 < [ drop 1 ] when
-    [ over length + 0 pad-left pextend ] keep 1+ ;
+    [ over length + 0 pad-head pextend ] keep 1+ ;
 
 : /-last ( seq seq -- a )
     #! divide the last two numbers in the sequences

basis/math/ranges/ranges-tests.factor

@@ -1,4 +1,4 @@
-USING: math.ranges sequences tools.test arrays ;
+USING: math math.ranges sequences sets tools.test arrays ;
 IN: math.ranges.tests
 
 [ { } ] [ 1 1 (a,b) >array ] unit-test
@@ -32,3 +32,7 @@ IN: math.ranges.tests
 [ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test
 [ 5 ] [ 6 5 [0,b] clamp-to-range ] unit-test
 [ { 0 1 2 3 4 } ] [ 5 sequence-index-range >array ] unit-test
+
+[ 100 ] [
+    1 100 [a,b] [ 2^ [1,b] ] map prune length
+] unit-test

basis/math/ranges/ranges.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel layouts math math.order namespaces sequences
-sequences.private accessors ;
+sequences.private accessors classes.tuple arrays ;
 IN: math.ranges
 
 TUPLE: range
@@ -18,6 +18,12 @@ M: range length ( seq -- n )
 M: range nth-unsafe ( n range -- obj )
     [ step>> * ] keep from>> + ;
 
+! For ranges with many elements, the default element-wise methods
+! sequences define are unsuitable because they're O(n)
+M: range equal? over range? [ tuple= ] [ 2drop f ] if ;
+
+M: range hashcode* tuple-hashcode ;
+
 INSTANCE: range immutable-sequence
 
 : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline

basis/opengl/gl/gl.factor

@@ -356,6 +356,10 @@ CONSTANT: GL_DITHER                         HEX: 0BD0
 CONSTANT: GL_RGB                            HEX: 1907
 CONSTANT: GL_RGBA                           HEX: 1908
 
+! GL_BGRA_ext: http://www.opengl.org/registry/specs/EXT/bgra.txt
+CONSTANT: GL_BGR_EXT                        HEX: 80E0
+CONSTANT: GL_BGRA_EXT                       HEX: 80E1
+
 ! Implementation limits
 CONSTANT: GL_MAX_LIST_NESTING               HEX: 0B31
 CONSTANT: GL_MAX_ATTRIB_STACK_DEPTH         HEX: 0D35

basis/peg/peg.factor

@@ -509,7 +509,7 @@ TUPLE: sp-parser p1 ;
 
 M: sp-parser (compile) ( peg -- quot )
   p1>> compile-parser 1quotation '[ 
-    input-slice [ blank? ] trim-left-slice input-from pos set @ 
+    input-slice [ blank? ] trim-head-slice input-from pos set @ 
   ] ;
 
 TUPLE: delay-parser quot ;

basis/quoted-printable/authors.txt

@@ -0,0 +1 @@
+Daniel Ehrenberg