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

2009-01-30 18:36:29 -06:00 · 2009-01-30 18:36:29 -06:00 · c9f0dc072a
parent e7979a1ac5 f1182ef800
commit c9f0dc072a
2228 changed files with 37268 additions and 26883 deletions
--- a/.gitignore
+++ b/.gitignore
@ -21,3 +21,5 @@ logs
 work
 build-support/wordsize
 *.bak
+.#*
+*.swo
--- a/Factor.app/Contents/Info.plist
+++ b/Factor.app/Contents/Info.plist
@ -32,7 +32,7 @@
 	<key>CFBundlePackageType</key>
 	<string>APPL</string>
 	<key>NSHumanReadableCopyright</key>
-	<string>Copyright © 2003-2008, Slava Pestov and friends</string>
+	<string>Copyright © 2003-2009, Slava Pestov and friends</string>
 	<key>NSServices</key>
 	<array>
 		<dict>
--- a/26
+++ b/26
@ -3,6 +3,7 @@ AR = ar
 LD = ld

 EXECUTABLE = factor
+CONSOLE_EXECUTABLE = factor-console
 VERSION = 0.92

 IMAGE = factor.image
@ -25,23 +26,25 @@ ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
 DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm/alien.o \
 	vm/bignum.o \
+	vm/callstack.o \
+	vm/code_block.o \
+	vm/code_gc.o \
 	vm/code_heap.o \
+	vm/data_gc.o \
+	vm/data_heap.o \
 	vm/debug.o \
+	vm/errors.o \
 	vm/factor.o \
 	vm/ffi_test.o \
 	vm/image.o \
 	vm/io.o \
 	vm/math.o \
-	vm/data_gc.o \
-	vm/code_gc.o \
 	vm/primitives.o \
-	vm/run.o \
-	vm/callstack.o \
-	vm/types.o \
+	vm/profiler.o \
 	vm/quotations.o \
-	vm/utilities.o \
-	vm/errors.o \
-	vm/profiler.o
+	vm/run.o \
+	vm/types.o \
+	vm/utilities.o

 EXE_OBJS = $(PLAF_EXE_OBJS)

@ -136,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
@ -159,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}
--- a/basis/alias/alias-docs.factor
+++ b/basis/alias/alias-docs.factor
@ -1,26 +0,0 @@
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel words help.markup help.syntax ;
-IN: alias
-
-HELP: ALIAS:
-{ $syntax "ALIAS: new-word existing-word" }
-{ $values { "new-word" word } { "existing-word" word } }
-{ $description "Creates a " { $snippet "new" } " inlined word that calls the " { $snippet "existing" } " word." }
-{ $examples
-    { $example "USING: alias prettyprint sequences ;"
-               "IN: alias.test"
-               "ALIAS: sequence-nth nth"
-               "0 { 10 20 30 } sequence-nth ."
-               "10"
-    }
-} ;
-
-ARTICLE: "alias" "Word aliasing"
-"The " { $vocab-link "alias" } " vocabulary implements a way to make many different names for the same word. Although creating new names for words is generally frowned upon, aliases are useful for the Win32 API and other cases where words need to be renamed for symmetry." $nl 
-"Make a new word that aliases another word:"
-{ $subsection define-alias }
-"Make an alias at parse-time:"
-{ $subsection POSTPONE: ALIAS: } ;
-
-ABOUT: "alias"
--- a/basis/alien/c-types/c-types-tests.factor
+++ b/basis/alien/c-types/c-types-tests.factor
@ -8,10 +8,6 @@ sequences system libc alien.strings io.encodings.utf8 ;

 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test

-: foo ( -- n ) &: fdafd [ 123 ] unless* ;
-
-[ 123 ] [ foo ] unit-test
-
 [ -1 ] [ -1 <char> *char ] unit-test
 [ -1 ] [ -1 <short> *short ] unit-test
 [ -1 ] [ -1 <int> *int ] unit-test
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@ -234,17 +234,16 @@ M: long-long-type box-return ( type -- )
    f swap box-parameter ;

 : define-deref ( name -- )
-    [ CHAR: * prefix "alien.c-types" create ]
-    [ c-getter 0 prefix ] bi
-    define-inline ;
+    [ CHAR: * prefix "alien.c-types" create ] [ c-getter 0 prefix ] bi
+    (( c-ptr -- value )) define-inline ;

 : define-out ( name -- )
    [ "alien.c-types" constructor-word ]
-    [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ]
-    bi define-inline ;
+    [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
+    (( value -- c-ptr )) define-inline ;

 : c-bool> ( int -- ? )
-    zero? not ;
+    0 = not ; inline

 : define-primitive-type ( type name -- )
    [ typedef ]
--- a/basis/alien/remote-control/remote-control-tests.factor
+++ b/basis/alien/remote-control/remote-control-tests.factor
@ -0,0 +1,44 @@
+USING: interpolate multiline
+io io.directories io.encodings.ascii io.files
+io.files.temp io.launcher io.streams.string kernel locals system
+tools.test sequences ;
+IN: alien.remote-control.tests
+
+: compile-file ( contents -- )
+    "test.c" ascii set-file-contents
+    { "gcc" "-I../" "-L.." "-lfactor" "test.c" }
+    os macosx? cpu x86.64? and [ "-m64" suffix ] when
+    try-process ;
+
+: run-test ( -- line )
+    os windows? "temp/a.exe" "temp/a.out" ?
+    ascii [ readln ] with-process-reader ;
+
+:: test-embedding ( code -- line )
+    image :> image
+
+    [
+        I[
+#include <vm/master.h>
+#include <stdio.h>
+#include <stdbool.h>
+
+int main(int argc, char **argv)
+{
+    F_PARAMETERS p;
+    default_parameters(&p);
+    p.image_path = STRING_LITERAL("${image}");
+    init_factor(&p);
+    start_embedded_factor(&p);
+    ${code}
+    printf("Done.\n");
+    return 0;
+}
+        ]I
+    ] with-string-writer
+    "resource:temp" [ compile-file ] with-directory
+    "resource:" [ run-test ] with-directory ;
+
+! [ "Done." ] [ "" test-embedding ] unit-test
+
+! [ "Done." ] [ "factor_yield();" test-embedding ] unit-test
--- a/basis/alien/remote-control/remote-control.factor
+++ b/basis/alien/remote-control/remote-control.factor
@ -15,7 +15,7 @@ IN: alien.remote-control
    "void" { "long" } "cdecl" [ sleep ] alien-callback ;

 : ?callback ( word -- alien )
-    dup compiled>> [ execute ] [ drop f ] if ; inline
+    dup optimized>> [ execute ] [ drop f ] if ; inline

 : init-remote-control ( -- )
    \ eval-callback ?callback 16 setenv
--- a/basis/alien/strings/windows/tags.txt
+++ b/basis/alien/strings/windows/tags.txt
--- a/basis/alien/structs/fields/fields.factor
+++ b/basis/alien/structs/fields/fields.factor
@ -52,8 +52,8 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
        [ (>>offset) ] [ type>> heap-size + ] 2bi
    ] reduce ;

-: define-struct-slot-word ( word quot spec -- )
-    offset>> prefix define-inline ;
+: define-struct-slot-word ( word quot spec effect -- )
+    [ offset>> prefix ] dip define-inline ;

 : define-getter ( type spec -- )
    [ set-reader-props ] keep
@ -62,11 +62,13 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
        type>>
        [ c-getter ] [ c-type-boxer-quot ] bi append
    ]
-    [ ] tri define-struct-slot-word ;
+    [ ] tri
+    (( c-ptr -- value )) define-struct-slot-word ;

 : define-setter ( type spec -- )
    [ set-writer-props ] keep
-    [ writer>> ] [ type>> c-setter ] [ ] tri define-struct-slot-word ;
+    [ writer>> ] [ type>> c-setter ] [ ] tri
+    (( value c-ptr -- )) define-struct-slot-word ;

 : define-field ( type spec -- )
    [ define-getter ] [ define-setter ] 2bi ;
--- a/basis/alien/syntax/syntax.factor
+++ b/basis/alien/syntax/syntax.factor
@ -4,7 +4,7 @@ USING: accessors arrays alien alien.c-types alien.structs
 alien.arrays alien.strings kernel math namespaces parser
 sequences words quotations math.parser splitting grouping
 effects assocs combinators lexer strings.parser alien.parser 
-fry ;
+fry vocabs.parser words.constant ;
 IN: alien.syntax

 : DLL" lexer get skip-blank parse-string dlopen parsed ; parsing
@ -31,10 +31,11 @@ IN: alien.syntax

 : C-ENUM:
    ";" parse-tokens
-    dup length
-    [ [ create-in ] dip 1quotation define ] 2each ;
+    [ [ create-in ] dip define-constant ] each-index ;
    parsing

+: address-of ( name library -- value )
+    load-library dlsym [ "No such symbol" throw ] unless* ;
+
 : &:
-    scan "c-library" get
-    '[ _ _ load-library dlsym ] over push-all ; parsing
+    scan "c-library" get '[ _ _ address-of ] over push-all ; parsing
--- a/basis/ascii/ascii-docs.factor
+++ b/basis/ascii/ascii-docs.factor
@ -37,8 +37,30 @@ HELP: quotable?
 { $values { "ch" "a character" } { "?" "a boolean" } }
 { $description "Tests for characters which may appear in a Factor string literal without escaping." } ;

-ARTICLE: "ascii" "ASCII character classes"
-"The " { $vocab-link "ascii" } " vocabulary implements traditional ASCII character classes:"
+HELP: ascii?
+{ $values { "ch" "a character" } { "?" "a boolean" } }
+{ $description "Tests for whether a number is an ASCII character." } ;
+
+HELP: ch>lower
+{ $values { "ch" "a character" } { "lower" "a character" } }
+{ $description "Converts an ASCII character to lower case." } ;
+
+HELP: ch>upper
+{ $values { "ch" "a character" } { "upper" "a character" } }
+{ $description "Converts an ASCII character to upper case." } ;
+
+HELP: >lower
+{ $values { "str" "a string" } { "lower" "a string" } }
+{ $description "Converts an ASCII string to lower case." } ;
+
+HELP: >upper
+{ $values { "str" "a string" } { "upper" "a string" } }
+{ $description "Converts an ASCII string to upper case." } ;
+
+ARTICLE: "ascii" "ASCII"
+"The " { $vocab-link "ascii" } " vocabulary implements support for the legacy ASCII character set. Most applications should use " { $link "unicode" } " instead."
+$nl
+"ASCII character classes:"
 { $subsection blank? }
 { $subsection letter? }
 { $subsection LETTER? }
@ -46,6 +68,11 @@ ARTICLE: "ascii" "ASCII character classes"
 { $subsection printable? }
 { $subsection control? }
 { $subsection quotable? }
-"Modern applications should use Unicode 5.0 instead (" { $vocab-link "unicode.categories" } ")." ;
+{ $subsection ascii? }
+"ASCII case conversion:"
+{ $subsection ch>lower }
+{ $subsection ch>upper }
+{ $subsection >lower }
+{ $subsection >upper } ;

 ABOUT: "ascii"
--- a/basis/ascii/ascii-tests.factor
+++ b/basis/ascii/ascii-tests.factor
@ -12,3 +12,8 @@ IN: ascii.tests
    0 "There are Four Upper Case characters"
    [ LETTER? [ 1+ ] when ] each
 ] unit-test
+
+[ t f ] [ CHAR: \s ascii? 400 ascii? ] unit-test
+
+[ "HELLO HOW ARE YOU?" ] [ "hellO hOw arE YOU?" >upper ] unit-test
+[ "i'm good thx bai" ] [ "I'm Good THX bai" >lower ] unit-test
--- a/basis/ascii/ascii.factor
+++ b/basis/ascii/ascii.factor
@ -1,27 +1,23 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math math.order sequences
-combinators.short-circuit ;
+USING: kernel math math.order sequences strings
+combinators.short-circuit hints ;
 IN: ascii

+: ascii? ( ch -- ? ) 0 127 between? ; inline
 : blank? ( ch -- ? ) " \t\n\r" member? ; inline
-
 : letter? ( ch -- ? ) CHAR: a CHAR: z between? ; inline
-
 : LETTER? ( ch -- ? ) CHAR: A CHAR: Z between? ; inline
-
 : digit? ( ch -- ? ) CHAR: 0 CHAR: 9 between? ; inline
-
 : printable? ( ch -- ? ) CHAR: \s CHAR: ~ between? ; inline
+: control? ( ch -- ? ) "\0\e\r\n\t\u000008\u00007f" member? ; inline
+: quotable? ( ch -- ? ) { [ printable? ] [ "\"\\" member? not ] } 1&& ; inline
+: Letter? ( ch -- ? ) { [ letter? ] [ LETTER? ] } 1|| ; inline
+: alpha? ( ch -- ? ) { [ Letter? ] [ digit? ] } 1|| ; inline
+: ch>lower ( ch -- lower ) dup LETTER? [ HEX: 20 + ] when ; inline
+: >lower ( str -- lower ) [ ch>lower ] map ;
+: ch>upper ( ch -- upper ) dup letter? [ HEX: 20 - ] when ; inline
+: >upper ( str -- upper ) [ ch>upper ] map ;

-: control? ( ch -- ? )
-    "\0\e\r\n\t\u000008\u00007f" member? ; inline
-
-: quotable? ( ch -- ? )
-    dup printable? [ "\"\\" member? not ] [ drop f ] if ; inline
-
-: Letter? ( ch -- ? )
-    [ [ letter? ] [ LETTER? ] ] 1|| ;
-
-: alpha? ( ch -- ? )
-    [ [ Letter? ] [ digit? ] ] 1|| ;
+HINTS: >lower string ;
+HINTS: >upper string ;
--- a/basis/assoc-heaps/assoc-heaps-docs.factor
+++ b/basis/assoc-heaps/assoc-heaps-docs.factor
@ -1,20 +1,19 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax io.streams.string ;
+USING: help.markup help.syntax io.streams.string assocs
+heaps.private ;
 IN: assoc-heaps

 HELP: <assoc-heap>
+{ $values { "assoc" assoc } { "heap" heap } { "assoc-heap" assoc-heap } }
 { $description "Constructs a new " { $link assoc-heap } " from two existing data structures." } ;

 HELP: <unique-max-heap>
-{ $values
-    
-     { "unique-heap" assoc-heap } }
+{ $values { "unique-heap" assoc-heap } }
 { $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a max-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;

 HELP: <unique-min-heap>
-{ $values
-     { "unique-heap" assoc-heap } }
+{ $values { "unique-heap" assoc-heap } }
 { $description "Creates a new " { $link assoc-heap } " where the assoc is a hashtable and the heap is a min-heap. Popping an element from the heap leaves this element in the hashtable to ensure that the element will not be processed again." } ;

 { <unique-max-heap> <unique-min-heap> } related-words
--- a/basis/assoc-heaps/assoc-heaps-tests.factor
+++ b/basis/assoc-heaps/assoc-heaps-tests.factor
--- a/basis/assoc-heaps/assoc-heaps.factor
+++ b/basis/assoc-heaps/assoc-heaps.factor
--- a/basis/assoc-heaps/authors.txt
+++ b/basis/assoc-heaps/authors.txt
--- a/basis/base64/base64-docs.factor
+++ b/basis/base64/base64-docs.factor
@ -7,7 +7,13 @@ HELP: >base64
 { $examples
    { $example "USING: prettyprint base64 strings ;" "\"The monorail is a free service.\" >base64 >string ." "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\"" }
 }
-{ $see-also base64> } ;
+{ $see-also base64> >base64-lines } ;
+
+HELP: >base64-lines
+{ $values { "seq" sequence } { "base64" "a string of base64 characters" } }
+{ $description "Converts a sequence to its base64 representation by taking six bits at a time as an index into a lookup table containing alphanumerics, '+', and '/'.  The result is padded with '=' if the input was not a multiple of six bits. A crlf is inserted for every 76 characters of output." }
+{ $see-also base64> >base64-lines } ;
+

 HELP: base64>
 { $values { "base64" "a string of base64 characters" } { "seq" sequence } }
@ -16,13 +22,26 @@ HELP: base64>
    { $example "USING: prettyprint base64 strings ;" "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\" base64> >string ." "\"The monorail is a free service.\"" }
 }
 { $notes "This word will throw if the input string contains characters other than those allowed in base64 encodings." }
-{ $see-also >base64 } ;
+{ $see-also >base64 >base64-lines } ;
+
+HELP: encode-base64
+{ $description "Reads the standard input and writes it to standard output encoded in base64." } ;
+
+HELP: decode-base64
+{ $description "Reads the standard input and decodes it, writing to standard output." } ;
+
+HELP: encode-base64-lines
+{ $description "Reads the standard input and writes it to standard output encoded in base64 with a crlf every 76 characters." } ;

 ARTICLE: "base64" "Base 64 conversions"
 "The " { $vocab-link "base64" } " vocabulary implements conversions of sequences to printable characters in base 64. These plain-text representations of binary data may be passed around and converted back to binary data later." $nl
-"Converting to base 64:"
+"Converting to and from base64 as strings:"
 { $subsection >base64 }
-"Converting back to binary:"
-{ $subsection base64> } ;
+{ $subsection >base64-lines }
+{ $subsection base64> }
+"Using base64 from streams:"
+{ $subsection encode-base64 }
+{ $subsection encode-base64-lines }
+{ $subsection decode-base64 } ;

 ABOUT: "base64"
--- a/basis/base64/base64-tests.factor
+++ b/basis/base64/base64-tests.factor
@ -1,4 +1,4 @@
-USING: kernel tools.test base64 strings ;
+USING: kernel tools.test base64 strings sequences  ;
 IN: base64.tests

 [ "abcdefghijklmnopqrstuvwxyz" ] [ "abcdefghijklmnopqrstuvwxyz" >base64 base64> >string
@ -7,6 +7,7 @@ IN: base64.tests
 [ "a" ] [ "a" >base64 base64> >string ] unit-test
 [ "ab" ] [ "ab" >base64 base64> >string ] unit-test
 [ "abc" ] [ "abc" >base64 base64> >string ] unit-test
+[ "abcde" ] [ "abcde" >base64 3 cut "\r\n" swap 3append base64> >string ] unit-test

 ! From http://en.wikipedia.org/wiki/Base64
 [ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlzIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2YgdGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGludWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRoZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ]
@ -15,5 +16,11 @@ IN: base64.tests
    >base64 >string
 ] unit-test

+[ "TWFuIGlzIGRpc3Rpbmd1aXNoZWQsIG5vdCBvbmx5IGJ5IGhpcyByZWFzb24sIGJ1dCBieSB0aGlz\r\nIHNpbmd1bGFyIHBhc3Npb24gZnJvbSBvdGhlciBhbmltYWxzLCB3aGljaCBpcyBhIGx1c3Qgb2Yg\r\ndGhlIG1pbmQsIHRoYXQgYnkgYSBwZXJzZXZlcmFuY2Ugb2YgZGVsaWdodCBpbiB0aGUgY29udGlu\r\ndWVkIGFuZCBpbmRlZmF0aWdhYmxlIGdlbmVyYXRpb24gb2Yga25vd2xlZGdlLCBleGNlZWRzIHRo\r\nZSBzaG9ydCB2ZWhlbWVuY2Ugb2YgYW55IGNhcm5hbCBwbGVhc3VyZS4=" ]
+[
+    "Man is distinguished, not only by his reason, but by this singular passion from other animals, which is a lust of the mind, that by a perseverance of delight in the continued and indefatigable generation of knowledge, exceeds the short vehemence of any carnal pleasure."
+    >base64-lines >string
+] unit-test
+
 \ >base64 must-infer
 \ base64> must-infer
--- a/basis/base64/base64.factor
+++ b/basis/base64/base64.factor
@ -1,16 +1,22 @@
-! Copyright (C) 2008 Doug Coleman.
+! Copyright (C) 2008 Doug Coleman, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math sequences io.binary splitting grouping
-accessors ;
+USING: combinators io io.binary io.encodings.binary
+io.streams.byte-array io.streams.string kernel math namespaces
+sequences strings io.crlf ;
 IN: base64

 <PRIVATE

-: count-end ( seq quot -- n )
-    trim-right-slice [ seq>> length ] [ to>> ] bi - ; inline
+: read1-ignoring ( ignoring -- ch )
+    read1 2dup swap member? [ drop read1-ignoring ] [ nip ] if ;
+
+: read-ignoring ( ignoring n -- str )
+    [ drop read1-ignoring ] with map harvest
+    [ f ] [ >string ] if-empty ;

 : ch>base64 ( ch -- ch )
-    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" nth ;
+    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+    nth ; inline

 : base64>ch ( ch -- ch )
    {
@ -19,32 +25,60 @@ IN: base64
        f 0 f f f 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
        22 23 24 25 f f f f f f 26 27 28 29 30 31 32 33 34 35 36 37 38 39
        40 41 42 43 44 45 46 47 48 49 50 51
-    } nth ;
+    } nth ; inline

-: encode3 ( seq -- seq )
+SYMBOL: column
+
+: write1-lines ( ch -- )
+    write1
+    column get [
+        1+ [ 76 = [ crlf ] when ]
+        [ 76 mod column set ] bi
+    ] when* ;
+
+: write-lines ( str -- )
+    [ write1-lines ] each ;
+
+: encode3 ( seq -- )
    be> 4 <reversed> [
-        -6 * shift HEX: 3f bitand ch>base64
-    ] with B{ } map-as ;
+        -6 * shift HEX: 3f bitand ch>base64 write1-lines
+    ] with each ; inline

-: decode4 ( str -- str )
-    0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ;
+: encode-pad ( seq n -- )
+    [ 3 0 pad-tail binary [ encode3 ] with-byte-writer ]
+    [ 1+ ] bi* head-slice 4 CHAR: = pad-tail write-lines ; inline

-: >base64-rem ( str -- str )
-    [ 3 0 pad-right encode3 ] [ length 1+ ] bi
-    head-slice 4 CHAR: = pad-right ;
+ERROR: malformed-base64 ;
+
+: decode4 ( seq -- )
+    [ 0 [ base64>ch swap 6 shift bitor ] reduce 3 >be ]
+    [ [ CHAR: = = ] count ] bi head-slice*
+    [ write1 ] each ; inline

 PRIVATE>

+: encode-base64 ( -- )
+    3 read dup length {
+        { 0 [ drop ] }
+        { 3 [ encode3 encode-base64 ] }
+        [ encode-pad encode-base64 ]
+    } case ;
+
+: encode-base64-lines ( -- )
+    0 column [ encode-base64 ] with-variable ;
+
+: decode-base64 ( -- )
+    "\n\r" 4 read-ignoring dup length {
+        { 0 [ drop ] }
+        { 4 [ decode4 decode-base64 ] }
+        [ malformed-base64 ]
+    } case ;
+
 : >base64 ( seq -- base64 )
-    #! cut string into two pieces, convert 3 bytes at a time
-    #! pad string with = when not enough bits
-    dup length dup 3 mod - cut
-    [ 3 <groups> [ encode3 ] map concat ]
-    [ [ "" ] [ >base64-rem ] if-empty ]
-    bi* append ;
+    binary [ [ encode-base64 ] with-string-reader ] with-byte-writer ;

 : base64> ( base64 -- seq )
-    #! input length must be a multiple of 4
-    [ 4 <groups> [ decode4 ] map concat ]
-    [ [ CHAR: = = ] count-end ]
-    bi head* ;
+    [ binary [ decode-base64 ] with-byte-reader ] with-string-writer ;
+
+: >base64-lines ( seq -- base64 )
+    binary [ [ encode-base64-lines ] with-string-reader ] with-byte-writer ;
--- a/basis/base64/tags.txt
+++ b/basis/base64/tags.txt
@ -0,0 +1,2 @@
+parsing
+web
--- a/basis/bit-arrays/bit-arrays-tests.factor
+++ b/basis/bit-arrays/bit-arrays-tests.factor
@ -76,3 +76,7 @@ IN: bit-arrays.tests
    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
    t t t t t t t t   t t t t t t t t   t t t t t t t t  t t t t t t t t
 } bit-array>integer ] unit-test
+
+[ 49 ] [ 49 <bit-array> dup set-bits [ ] count ] unit-test
+
+[ HEX: 100 ] [ ?{ f f f f f f f f t } bit-array>integer ] unit-test
--- a/basis/bit-arrays/bit-arrays.factor
+++ b/basis/bit-arrays/bit-arrays.factor
@ -11,7 +11,7 @@ TUPLE: bit-array

 <PRIVATE

-: n>byte -3 shift ; inline
+: n>byte ( m -- n ) -3 shift ; inline

 : byte/bit ( n alien -- byte bit )
    over n>byte alien-unsigned-1 swap 7 bitand ; inline
@ -19,13 +19,13 @@ TUPLE: bit-array
 : set-bit ( ? byte bit -- byte )
    2^ rot [ bitor ] [ bitnot bitand ] if ; inline

-: bits>cells 31 + -5 shift ; inline
+: bits>cells ( m -- n ) 31 + -5 shift ; inline

-: bits>bytes 7 + n>byte ; inline
+: bits>bytes ( m -- n ) 7 + n>byte ; inline

 : (set-bits) ( bit-array n -- )
    [ [ length bits>cells ] keep ] dip swap underlying>>
-    '[ [ _ _ ] dip set-alien-unsigned-4 ] each ; inline
+    '[ 2 shift [ _ _ ] dip set-alien-unsigned-4 ] each ; inline

 PRIVATE>

@ -83,7 +83,7 @@ M: bit-array byte-length length 7 + -3 shift ;
    ] if ;

 : bit-array>integer ( bit-array -- n )
-    0 swap underlying>> dup length [
+    0 swap underlying>> dup length <reversed> [
        alien-unsigned-1 swap 8 shift bitor
    ] with each ;

--- a/basis/bootstrap/compiler/compiler.factor
+++ b/basis/bootstrap/compiler/compiler.factor
@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors compiler cpu.architecture vocabs.loader system
 sequences namespaces parser kernel kernel.private classes
@ -25,8 +25,8 @@ IN: bootstrap.compiler

 enable-compiler

-: compile-uncompiled ( words -- )
-    [ compiled>> not ] filter compile ;
+: compile-unoptimized ( words -- )
+    [ optimized>> not ] filter compile ;

 nl
 "Compiling..." write flush
@ -48,70 +48,70 @@ nl
    wrap probe

    namestack*
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

 {
    bitand bitor bitxor bitnot
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

 {
    + 1+ 1- 2/ < <= > >= shift
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

 {
    new-sequence nth push pop peek flip
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

 {
    hashcode* = get set
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

 {
    memq? split harvest sift cut cut-slice start index clone
    set-at reverse push-all class number>string string>number
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

 {
    lines prefix suffix unclip new-assoc update
    word-prop set-word-prop 1array 2array 3array ?nth
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

 {
    malloc calloc free memcpy
-} compile-uncompiled
+} compile-unoptimized

 "." write flush

-{ build-tree } compile-uncompiled
+{ build-tree } compile-unoptimized

 "." write flush

-{ optimize-tree } compile-uncompiled
+{ optimize-tree } compile-unoptimized

 "." write flush

-{ optimize-cfg } compile-uncompiled
+{ optimize-cfg } compile-unoptimized

 "." write flush

-{ (compile) } compile-uncompiled
+{ (compile) } compile-unoptimized

 "." write flush

-vocabs [ words compile-uncompiled "." write flush ] each
+vocabs [ words compile-unoptimized "." write flush ] each

 " done" print flush
--- a/basis/bootstrap/finish-bootstrap.factor
+++ b/basis/bootstrap/finish-bootstrap.factor
@ -12,5 +12,6 @@ namespaces eval kernel vocabs.loader io ;
        ignore-cli-args? not script get and
        [ run-script ] [ "run" get run ] if*
        output-stream get [ stream-flush ] when*
+        0 exit
    ] [ print-error 1 exit ] recover
 ] set-boot-quot
--- a/basis/bootstrap/finish-staging.factor
+++ b/basis/bootstrap/finish-staging.factor
@ -7,4 +7,5 @@ io ;
    (command-line) parse-command-line
    "run" get run
    output-stream get [ stream-flush ] when*
+    0 exit
 ] set-boot-quot
--- a/basis/bootstrap/help/help.factor
+++ b/basis/bootstrap/help/help.factor
@ -4,6 +4,7 @@ parser vocabs.loader vocabs.loader.private accessors assocs ;
 IN: bootstrap.help

 : load-help ( -- )
+    "help.lint" require
    "alien.syntax" require
    "compiler" require

--- a/basis/bootstrap/image/image-docs.factor
+++ b/basis/bootstrap/image/image-docs.factor
@ -1,4 +1,4 @@
-USING: help.markup help.syntax io io.files ;
+USING: help.markup help.syntax io io.files io.pathnames ;
 IN: bootstrap.image

 ARTICLE: "bootstrap.image" "Bootstrapping new images"
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@ -1,15 +1,16 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien arrays byte-arrays generic assocs hashtables assocs
-hashtables.private io kernel kernel.private math namespaces make
-parser prettyprint sequences sequences.private strings sbufs
+hashtables.private io io.binary io.files io.encodings.binary
+io.pathnames kernel kernel.private math namespaces make parser
+prettyprint sequences sequences.private strings sbufs
 vectors words quotations assocs system layouts splitting
 grouping growable classes classes.builtin classes.tuple
-classes.tuple.private words.private io.binary io.files vocabs
+classes.tuple.private words.private vocabs
 vocabs.loader source-files definitions debugger
 quotations.private sequences.private combinators
-io.encodings.binary math.order math.private accessors
-slots.private compiler.units ;
+math.order math.private accessors
+slots.private compiler.units fry ;
 IN: bootstrap.image

 : arch ( os cpu -- arch )
@ -65,14 +66,14 @@ M: id equal?

 SYMBOL: objects

-: (objects) <id> objects get ; inline
+: (objects) ( obj -- id assoc ) <id> objects get ; inline

 : lookup-object ( obj -- n/f ) (objects) at ;

 : put-object ( n obj -- ) (objects) set-at ;

 : cache-object ( obj quot -- value )
-    [ (objects) ] dip [ obj>> ] prepose cache ; inline
+    [ (objects) ] dip '[ obj>> @ ] cache ; inline

 ! Constants

@ -94,7 +95,7 @@ SYMBOL: objects
 SYMBOL: sub-primitives

 : make-jit ( quot rc rt offset -- quad )
-    { [ { } make ] [ ] [ ] [ ] } spread 4array ; inline
+    [ { } make ] 3dip 4array ; inline

 : jit-define ( quot rc rt offset name -- )
    [ make-jit ] dip set ; inline
@ -343,25 +344,37 @@ M: wrapper '
    [ emit ] emit-object ;

 ! Strings
+: native> ( object -- object )
+    big-endian get [ [ be> ] map ] [ [ le> ] map ] if ;
+
 : emit-bytes ( seq -- )
-    bootstrap-cell <groups>
-    big-endian get [ [ be> ] map ] [ [ le> ] map ] if
-    emit-seq ;
+    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 ;

-: check-string ( string -- )
-    [ 127 > ] contains?
-    [ "Bootstrap cannot emit non-ASCII strings" throw ] when ;
+: extended-part ( str -- str' )
+    dup [ 128 < ] all? [ drop f ] [
+        [ -7 shift 1 bitxor ] { } map-as
+        big-endian get
+        [ [ 2 >be ] { } map-as ]
+        [ [ 2 >le ] { } map-as ] if
+        B{ } join
+    ] if ;
+
+: ascii-part ( str -- str' )
+    [
+        [ 128 mod ] [ 128 >= ] bi
+        [ 128 bitor ] when
+    ] B{ } map-as ;

 : emit-string ( string -- ptr )
-    dup check-string
+    [ length ] [ extended-part ' ] [ ] tri
    string type-number object tag-number [
-        dup length emit-fixnum
-        f ' emit
-        f ' emit
-        pad-bytes emit-bytes
+        [ emit-fixnum ]
+        [ emit ]
+        [ f ' emit ascii-part pad-bytes emit-bytes ]
+        tri*
    ] emit-object ;

 M: string '
@ -432,7 +445,7 @@ M: quotation '
        array>> '
        quotation type-number object tag-number [
            emit ! array
-            f ' emit ! compiled>>
+            f ' emit ! compiled
            0 emit ! xt
            0 emit ! code
        ] emit-object
@ -523,11 +536,9 @@ M: quotation '
 ! Image output

 : (write-image) ( image -- )
-    bootstrap-cell big-endian get [
-        [ >be write ] curry each
-    ] [
-        [ >le write ] curry each
-    ] if ;
+    bootstrap-cell big-endian get
+    [ '[ _ >be write ] each ]
+    [ '[ _ >le write ] each ] if ;

 : write-image ( image -- )
    "Writing image to " write
--- a/basis/bootstrap/image/upload/upload.factor
+++ b/basis/bootstrap/image/upload/upload.factor
@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: checksums checksums.openssl splitting assocs
 kernel io.files bootstrap.image sequences io namespaces make
-io.launcher math io.encodings.ascii ;
+io.launcher math io.encodings.ascii io.files.temp io.pathnames
+io.directories ;
 IN: bootstrap.image.upload

 SYMBOL: upload-images-destination
--- a/basis/bootstrap/io/io.factor
+++ b/basis/bootstrap/io/io.factor
@ -1,12 +1,11 @@
 USING: system vocabs vocabs.loader kernel combinators
-namespaces sequences io.backend ;
+namespaces sequences io.backend accessors ;
 IN: bootstrap.io

 "bootstrap.compiler" vocab [
-    "io." {
+    "io.backend." {
        { [ "io-backend" get ] [ "io-backend" get ] }
-        { [ os unix? ] [ "unix" ] }
+        { [ os unix? ] [ "unix." os name>> append ] }
        { [ os winnt? ] [ "windows.nt" ] }
-        { [ os wince? ] [ "windows.ce" ] }
    } cond append require
 ] when
--- a/basis/bootstrap/math/math.factor
+++ b/basis/bootstrap/math/math.factor
@ -2,6 +2,4 @@ USING: vocabs vocabs.loader kernel ;

 "math.ratios" require
 "math.floats" require
-"math.complex" require
-
-"prettyprint" vocab [ "math.complex.prettyprint" require ] when
+"math.complex" require
--- a/basis/bootstrap/stage2.factor
+++ b/basis/bootstrap/stage2.factor
@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors init namespaces words io
+USING: accessors init namespaces words words.symbol io
 kernel.private math memory continuations kernel io.files
-io.backend system parser vocabs sequences
+io.pathnames io.backend system parser vocabs sequences
 vocabs.loader combinators splitting source-files strings
-definitions assocs compiler.errors compiler.units
-math.parser generic sets command-line ;
+definitions assocs compiler.errors compiler.units math.parser
+generic sets command-line ;
 IN: bootstrap.stage2

 SYMBOL: core-bootstrap-time
@ -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 ( -- )
@ -42,7 +42,7 @@ SYMBOL: bootstrap-time
    "Core bootstrap completed in " write core-bootstrap-time get print-time
    "Bootstrap completed in "      write bootstrap-time      get print-time

-    [ compiled>> ] count-words " compiled words" print
+    [ optimized>> ] count-words " compiled words" print
    [ symbol? ] count-words " symbol words" print
    [ ] count-words " words total" print

@ -102,6 +102,8 @@ SYMBOL: bootstrap-time
    ] if
 ] [
    drop
-    load-help? off
-    "resource:basis/bootstrap/bootstrap-error.factor" run-file
+    [
+        load-help? off
+        "resource:basis/bootstrap/bootstrap-error.factor" run-file
+    ] with-scope
 ] recover
--- a/basis/bootstrap/threads/threads.factor
+++ b/basis/bootstrap/threads/threads.factor
@ -1,11 +1,11 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: vocabs vocabs.loader kernel ;
+USING: vocabs vocabs.loader kernel io.thread threads
+compiler.utilities namespaces ;
 IN: bootstrap.threads

-USE: io.thread
-USE: threads
-
 "debugger" vocab [
    "debugger.threads" require
 ] when
+
+[ yield ] yield-hook set-global
--- a/basis/bootstrap/unicode/unicode.factor
+++ b/basis/bootstrap/unicode/unicode.factor
@ -1,5 +1 @@
-USING: strings.parser kernel namespaces unicode.data ;
-IN: bootstrap.unicode
-
-[ name>char [ "Invalid character" throw ] unless* ]
-name>char-hook set-global
+USE: unicode
--- a/basis/cairo/authors.txt
+++ b/basis/cairo/authors.txt
--- a/basis/cairo/cairo.factor
+++ b/basis/cairo/cairo.factor
@ -17,20 +17,21 @@ M: cairo-surface-t dispose ( alien -- ) alien>> cairo_surface_destroy ;
    [ cairo_status_to_string "Cairo error: " prepend throw ] if ;

 SYMBOL: cairo
-: cr ( -- cairo ) cairo get ;
+: cr ( -- cairo ) cairo get ; inline

 : (with-cairo) ( cairo-t quot -- )
-    >r alien>> cairo r> [ cr cairo_status check-cairo ]
-    compose with-variable ; inline
+    [ alien>> cairo ] dip
+    '[ @ cr cairo_status check-cairo ]
+    with-variable ; inline
    
 : with-cairo ( cairo quot -- )
-    >r <cairo-t> r> [ (with-cairo) ] curry with-disposal ; inline
+    [ <cairo-t> ] dip '[ _ (with-cairo) ] with-disposal ; inline

 : (with-surface) ( cairo-surface-t quot -- )
-    >r alien>> r> [ cairo_surface_status check-cairo ] bi ; inline
+    [ alien>> ] dip [ cairo_surface_status check-cairo ] bi ; inline

 : with-surface ( cairo_surface quot -- )
-    >r <cairo-surface-t> r> [ (with-surface) ] curry with-disposal ; inline
+    [ <cairo-surface-t> ] dip '[ _ (with-surface) ] with-disposal ; inline

 : with-cairo-from-surface ( cairo_surface quot -- )
    '[ cairo_create _ with-cairo ] with-surface ; inline
--- a/basis/cairo/ffi/ffi.factor
+++ b/basis/cairo/ffi/ffi.factor
@ -37,7 +37,7 @@ TYPEDEF: void* cairo_pattern_t

 TYPEDEF: void* cairo_destroy_func_t
 : cairo-destroy-func ( quot -- callback )
-    >r "void" { "void*" } "cdecl" r> alien-callback ; inline
+    [ "void" { "void*" } "cdecl" ] dip alien-callback ; inline

 ! See cairo.h for details
 C-STRUCT: cairo_user_data_key_t
@ -78,13 +78,11 @@ TYPEDEF: int cairo_content_t

 TYPEDEF: void* cairo_write_func_t
 : cairo-write-func ( quot -- callback )
-    >r "cairo_status_t" { "void*" "uchar*" "int" }
-    "cdecl" r> alien-callback ; inline
+    [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
                          
 TYPEDEF: void* cairo_read_func_t
 : cairo-read-func ( quot -- callback )
-    >r "cairo_status_t" { "void*" "uchar*" "int" }
-    "cdecl" r> alien-callback ; inline
+    [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline

 ! Functions for manipulating state objects
 FUNCTION: cairo_t*
--- a/basis/cairo/gadgets/gadgets.factor
+++ b/basis/cairo/gadgets/gadgets.factor
@ -0,0 +1,43 @@
+! Copyright (C) 2008 Matthew Willis.
+! See http://factorcode.org/license.txt for BSD license.
+USING: sequences math kernel byte-arrays cairo.ffi cairo
+io.backend ui.gadgets accessors opengl.gl arrays fry
+classes ui.render namespaces destructors libc ;
+IN: cairo.gadgets
+
+<PRIVATE
+: width>stride ( width -- stride ) 4 * ;
+
+: image-dims ( gadget -- width height stride )
+    dim>> first2 over width>stride ; inline
+: image-buffer ( width height stride -- alien )
+    * nip malloc ; inline
+PRIVATE>
+    
+GENERIC: render-cairo* ( gadget -- )
+
+: render-cairo ( gadget -- alien )
+    [
+        image-dims
+        [ image-buffer dup CAIRO_FORMAT_ARGB32 ] 
+        [ cairo_image_surface_create_for_data ] 3bi
+    ] [ '[ _ render-cairo* ] with-cairo-from-surface ] bi ;
+
+TUPLE: cairo-gadget < gadget ;
+
+: <cairo-gadget> ( dim -- gadget )
+    cairo-gadget new-gadget
+        swap >>dim ;
+
+M: cairo-gadget draw-gadget*
+    [
+        [ dim>> ] [ render-cairo &free ] bi
+        origin get first2 glRasterPos2i
+        1.0 -1.0 glPixelZoom
+        [ first2 GL_BGRA GL_UNSIGNED_BYTE ] dip
+        glDrawPixels
+    ] with-destructors ;
+
+: copy-surface ( surface -- )
+    cr swap 0 0 cairo_set_source_surface
+    cr cairo_paint ;
--- a/basis/cairo/summary.txt
+++ b/basis/cairo/summary.txt
--- a/basis/cairo/tags.txt
+++ b/basis/cairo/tags.txt
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@ -211,7 +211,7 @@ M: real +minute ( timestamp n -- timestamp )
 M: number +second ( timestamp n -- timestamp )
    [ over second>> + seconds/minutes [ >>second ] dip +minute ] unless-zero ;

-: (time+)
+: (time+) ( timestamp duration -- timestamp' duration )
    [ second>> +second ] keep
    [ minute>> +minute ] keep
    [ hour>>   +hour   ] keep
@ -219,7 +219,8 @@ M: number +second ( timestamp n -- timestamp )
    [ month>>  +month  ] keep
    [ year>>   +year   ] keep ; inline

-: +slots [ bi@ + ] curry 2keep ; inline
+: +slots ( obj1 obj2 quot -- n obj1 obj2 )
+    [ bi@ + ] curry 2keep ; inline

 PRIVATE>

--- a/basis/calendar/format/format.factor
+++ b/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 ;

--- a/basis/channels/remote/remote-docs.factor
+++ b/basis/channels/remote/remote-docs.factor
@ -6,6 +6,7 @@ IN: channels.remote
 HELP: <remote-channel>
 { $values { "node" "a node object" }
          { "id" "the id of the published channel on the node" } 
+          { "remote-channel" remote-channel }
 }
 { $description "Create a remote channel that acts as a proxy for a "
 "channel on another node. The remote node's channel must have been "
--- a/basis/checksums/common/common.factor
+++ b/basis/checksums/common/common.factor
@ -1,21 +1,20 @@
 ! Copyright (C) 2006, 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.bitwise strings io.binary namespaces
-make grouping ;
+make grouping byte-arrays ;
 IN: checksums.common

 SYMBOL: bytes-read

-: calculate-pad-length ( length -- pad-length )
-    dup 56 < 55 119 ? swap - ;
+: calculate-pad-length ( length -- length' )
+    [ 56 < 55 119 ? ] keep - ;

 : 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 ;
+        [ % ] 2dip HEX: 80 ,
+        [ HEX: 3f bitand calculate-pad-length <byte-array> % ]
+        [ 3 shift 8 rot [ >be ] [ >le ] if % ] bi
+    ] B{ } make 64 group ;

 : update-old-new ( old new -- )
    [ [ get ] bi@ w+ dup ] 2keep [ set ] bi@ ; inline
--- a/basis/checksums/md5/md5.factor
+++ b/basis/checksums/md5/md5.factor
@ -2,9 +2,9 @@
 ! 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 byte-arrays locals sequences.private
-io.encodings.binary symbols math.bitwise checksums
-checksums.common checksums.stream ;
+sequences byte-arrays locals sequences.private macros fry
+io.encodings.binary math.bitwise checksums
+checksums.common checksums.stream combinators ;
 IN: checksums.md5

 ! See http://www.faqs.org/rfcs/rfc1321.html
@ -29,7 +29,7 @@ SYMBOLS: a b c d old-a old-b old-c old-d ;
    old-c c update-old-new
    old-d d update-old-new ;

-:: (ABCD) ( x s i k func a b c d -- )
+:: (ABCD) ( x a b c d k s i func -- )
    #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
    a [
        b get c get d get func call w+
@ -39,11 +39,6 @@ SYMBOLS: a b c d old-a old-b old-c old-d ;
        b get w+
    ] change ; inline

-: ABCD a b c d (ABCD) ; inline
-: BCDA b c d a (ABCD) ; inline
-: CDAB c d a b (ABCD) ; inline
-: DABC d a b c (ABCD) ; inline
-
 : F ( X Y Z -- FXYZ )
    #! F(X,Y,Z) = XY v not(X) Z
    pick bitnot bitand [ bitand ] [ bitor ] bi* ;
@ -60,104 +55,113 @@ SYMBOLS: a b c d old-a old-b old-c old-d ;
    #! I(X,Y,Z) = Y xor (X v not(Z))
    rot swap bitnot bitor bitxor ;

-: S11 7  ; inline
-: S12 12 ; inline
-: S13 17 ; inline
-: S14 22 ; inline
-: S21 5  ; inline
-: S22 9  ; inline
-: S23 14 ; inline
-: S24 20 ; inline
-: S31 4 ;  inline
-: S32 11 ; inline
-: S33 16 ; inline
-: S34 23 ; inline
-: S41 6  ; inline
-: S42 10 ; inline
-: S43 15 ; inline
-: S44 21 ; inline
+CONSTANT: S11 7
+CONSTANT: S12 12
+CONSTANT: S13 17
+CONSTANT: S14 22
+CONSTANT: S21 5
+CONSTANT: S22 9
+CONSTANT: S23 14
+CONSTANT: S24 20
+CONSTANT: S31 4
+CONSTANT: S32 11
+CONSTANT: S33 16
+CONSTANT: S34 23
+CONSTANT: S41 6
+CONSTANT: S42 10
+CONSTANT: S43 15
+CONSTANT: S44 21

-: (process-md5-block-F) ( block -- block )
-    dup S11 1  0  [ F ] ABCD
-    dup S12 2  1  [ F ] DABC
-    dup S13 3  2  [ F ] CDAB
-    dup S14 4  3  [ F ] BCDA
-    dup S11 5  4  [ F ] ABCD
-    dup S12 6  5  [ F ] DABC
-    dup S13 7  6  [ F ] CDAB
-    dup S14 8  7  [ F ] BCDA
-    dup S11 9  8  [ F ] ABCD
-    dup S12 10 9  [ F ] DABC
-    dup S13 11 10 [ F ] CDAB
-    dup S14 12 11 [ F ] BCDA
-    dup S11 13 12 [ F ] ABCD
-    dup S12 14 13 [ F ] DABC
-    dup S13 15 14 [ F ] CDAB
-    dup S14 16 15 [ F ] BCDA ;
+MACRO: with-md5-round ( ops func -- )
+    '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ;

-: (process-md5-block-G) ( block -- block )
-    dup S21 17 1  [ G ] ABCD
-    dup S22 18 6  [ G ] DABC
-    dup S23 19 11 [ G ] CDAB
-    dup S24 20 0  [ G ] BCDA
-    dup S21 21 5  [ G ] ABCD
-    dup S22 22 10 [ G ] DABC
-    dup S23 23 15 [ G ] CDAB
-    dup S24 24 4  [ G ] BCDA
-    dup S21 25 9  [ G ] ABCD
-    dup S22 26 14 [ G ] DABC
-    dup S23 27 3  [ G ] CDAB
-    dup S24 28 8  [ G ] BCDA
-    dup S21 29 13 [ G ] ABCD
-    dup S22 30 2  [ G ] DABC
-    dup S23 31 7  [ G ] CDAB
-    dup S24 32 12 [ G ] BCDA ;
+: (process-md5-block-F) ( block -- )
+    {
+        [ a b c d 0  S11 1  ]
+        [ d a b c 1  S12 2  ]
+        [ c d a b 2  S13 3  ]
+        [ b c d a 3  S14 4  ]
+        [ a b c d 4  S11 5  ]
+        [ d a b c 5  S12 6  ]
+        [ c d a b 6  S13 7  ]
+        [ b c d a 7  S14 8  ]
+        [ a b c d 8  S11 9  ]
+        [ d a b c 9  S12 10 ]
+        [ c d a b 10 S13 11 ]
+        [ b c d a 11 S14 12 ]
+        [ a b c d 12 S11 13 ]
+        [ d a b c 13 S12 14 ]
+        [ c d a b 14 S13 15 ]
+        [ b c d a 15 S14 16 ]
+    } [ F ] with-md5-round ;

-: (process-md5-block-H) ( block -- block )
-    dup S31 33 5  [ H ] ABCD
-    dup S32 34 8  [ H ] DABC
-    dup S33 35 11 [ H ] CDAB
-    dup S34 36 14 [ H ] BCDA
-    dup S31 37 1  [ H ] ABCD
-    dup S32 38 4  [ H ] DABC
-    dup S33 39 7  [ H ] CDAB
-    dup S34 40 10 [ H ] BCDA
-    dup S31 41 13 [ H ] ABCD
-    dup S32 42 0  [ H ] DABC
-    dup S33 43 3  [ H ] CDAB
-    dup S34 44 6  [ H ] BCDA
-    dup S31 45 9  [ H ] ABCD
-    dup S32 46 12 [ H ] DABC
-    dup S33 47 15 [ H ] CDAB
-    dup S34 48 2  [ H ] BCDA ;
+: (process-md5-block-G) ( block -- )
+    {
+        [ a b c d 1  S21 17 ]
+        [ d a b c 6  S22 18 ]
+        [ c d a b 11 S23 19 ]
+        [ b c d a 0  S24 20 ]
+        [ a b c d 5  S21 21 ]
+        [ d a b c 10 S22 22 ]
+        [ c d a b 15 S23 23 ]
+        [ b c d a 4  S24 24 ]
+        [ a b c d 9  S21 25 ]
+        [ d a b c 14 S22 26 ]
+        [ c d a b 3  S23 27 ]
+        [ b c d a 8  S24 28 ]
+        [ a b c d 13 S21 29 ]
+        [ d a b c 2  S22 30 ]
+        [ c d a b 7  S23 31 ]
+        [ b c d a 12 S24 32 ]
+    } [ G ] with-md5-round ;

-: (process-md5-block-I) ( block -- block )
-    dup S41 49 0  [ I ] ABCD
-    dup S42 50 7  [ I ] DABC
-    dup S43 51 14 [ I ] CDAB
-    dup S44 52 5  [ I ] BCDA
-    dup S41 53 12 [ I ] ABCD
-    dup S42 54 3  [ I ] DABC
-    dup S43 55 10 [ I ] CDAB
-    dup S44 56 1  [ I ] BCDA
-    dup S41 57 8  [ I ] ABCD
-    dup S42 58 15 [ I ] DABC
-    dup S43 59 6  [ I ] CDAB
-    dup S44 60 13 [ I ] BCDA
-    dup S41 61 4  [ I ] ABCD
-    dup S42 62 11 [ I ] DABC
-    dup S43 63 2  [ I ] CDAB
-    dup S44 64 9  [ I ] BCDA ;
+: (process-md5-block-H) ( block -- )
+    {
+        [ a b c d 5  S31 33 ]
+        [ d a b c 8  S32 34 ]
+        [ c d a b 11 S33 35 ]
+        [ b c d a 14 S34 36 ]
+        [ a b c d 1  S31 37 ]
+        [ d a b c 4  S32 38 ]
+        [ c d a b 7  S33 39 ]
+        [ b c d a 10 S34 40 ]
+        [ a b c d 13 S31 41 ]
+        [ d a b c 0  S32 42 ]
+        [ c d a b 3  S33 43 ]
+        [ b c d a 6  S34 44 ]
+        [ a b c d 9  S31 45 ]
+        [ d a b c 12 S32 46 ]
+        [ c d a b 15 S33 47 ]
+        [ b c d a 2  S34 48 ]
+    } [ H ] with-md5-round ;
+
+: (process-md5-block-I) ( block -- )
+    {
+        [ a b c d 0  S41 49 ]
+        [ d a b c 7  S42 50 ]
+        [ c d a b 14 S43 51 ]
+        [ b c d a 5  S44 52 ]
+        [ a b c d 12 S41 53 ]
+        [ d a b c 3  S42 54 ]
+        [ c d a b 10 S43 55 ]
+        [ b c d a 1  S44 56 ]
+        [ a b c d 8  S41 57 ]
+        [ d a b c 15 S42 58 ]
+        [ c d a b 6  S43 59 ]
+        [ b c d a 13 S44 60 ]
+        [ a b c d 4  S41 61 ]
+        [ d a b c 11 S42 62 ]
+        [ c d a b 2  S43 63 ]
+        [ b c d a 9  S44 64 ]
+    } [ I ] with-md5-round ;

 : (process-md5-block) ( block -- )
-    4 <groups> [ le> ] map
-
-    (process-md5-block-F)
-    (process-md5-block-G)
-    (process-md5-block-H)
-    (process-md5-block-I)
-
-    drop
+    4 <groups> [ le> ] map {
+        [ (process-md5-block-F) ]
+        [ (process-md5-block-G) ]
+        [ (process-md5-block-H) ]
+        [ (process-md5-block-I) ]
+    } cleave

    update-md ;

--- a/basis/checksums/openssl/openssl-docs.factor
+++ b/basis/checksums/openssl/openssl-docs.factor
@ -4,8 +4,8 @@ USING: help.syntax help.markup ;
 HELP: openssl-checksum
 { $class-description "The class of checksum algorithms implemented by OpenSSL. The exact set of algorithms supported depends on how the OpenSSL library was compiled; " { $snippet "md5" } " and " { $snippet "sha1" } " should be universally available." } ;

-HELP: <openssl-checksum> ( name -- checksum )
-{ $values { "name" "an EVP message digest name" } { "checksum" openssl-checksum } }
+HELP: <openssl-checksum>
+{ $values { "name" "an EVP message digest name" } { "openssl-checksum" openssl-checksum } }
 { $description "Creates a new OpenSSL checksum object." } ;

 HELP: openssl-md5
--- a/basis/checksums/sha1/sha1.factor
+++ b/basis/checksums/sha1/sha1.factor
@ -3,7 +3,7 @@
 USING: arrays combinators kernel io io.encodings.binary io.files
 io.streams.byte-array math.vectors strings sequences namespaces
 make math parser sequences assocs grouping vectors io.binary
-hashtables symbols math.bitwise checksums checksums.common
+hashtables math.bitwise checksums checksums.common
 checksums.stream ;
 IN: checksums.sha1

@ -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 ;
--- a/basis/checksums/sha2/sha2.factor
+++ b/basis/checksums/sha2/sha2.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel splitting grouping math sequences namespaces make
-io.binary symbols math.bitwise checksums checksums.common
+io.binary math.bitwise checksums checksums.common
 sbufs strings ;
 IN: checksums.sha2

@ -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 ;
--- a/basis/cocoa/application/application-docs.factor
+++ b/basis/cocoa/application/application-docs.factor
@ -30,10 +30,6 @@ HELP: cocoa-app
 { $values { "quot" quotation } }
 { $description "Initializes Cocoa, calls the quotation, and starts the Cocoa event loop." } ;

-HELP: do-event
-{ $values { "app" "an " { $snippet "NSApplication" } } { "?" "a boolean" } }
-{ $description "Processes a pending event in the queue, if any, returning a boolean indicating if there was one. Does not block." } ;
-
 HELP: add-observer
 { $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } }
 { $description "Registers an observer with the " { $snippet "NSNotificationCenter" } " singleton." } ;
@ -52,7 +48,6 @@ HELP: objc-error
 ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
 "Utilities:"
 { $subsection NSApp }
-{ $subsection do-event }
 { $subsection add-observer }
 { $subsection remove-observer }
 { $subsection install-delegate }
--- a/basis/cocoa/application/application.factor
+++ b/basis/cocoa/application/application.factor
@ -1,10 +1,10 @@
 ! Copyright (C) 2006, 2008 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.syntax io kernel namespaces core-foundation
-core-foundation.run-loop core-foundation.arrays
-core-foundation.data core-foundation.strings cocoa.messages
-cocoa cocoa.classes cocoa.runtime sequences threads init summary
-kernel.private assocs ;
+core-foundation.arrays core-foundation.data
+core-foundation.strings cocoa.messages cocoa cocoa.classes
+cocoa.runtime sequences threads init summary kernel.private
+assocs ;
 IN: cocoa.application

 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
@ -35,13 +35,6 @@ FUNCTION: void NSBeep ( ) ;
 : with-cocoa ( quot -- )
    [ NSApp drop call ] with-autorelease-pool ; inline

-: next-event ( app -- event )
-    NSAnyEventMask f CFRunLoopDefaultMode 1
-    -> nextEventMatchingMask:untilDate:inMode:dequeue: ;
-
-: do-event ( app -- ? )
-    dup next-event [ dupd -> sendEvent: -> updateWindows t ] [ drop f ] if* ;
-
 : add-observer ( observer selector name object -- )
    [
        [ NSNotificationCenter -> defaultCenter ] 2dip
--- a/basis/cocoa/views/views-docs.factor
+++ b/basis/cocoa/views/views-docs.factor
@ -2,7 +2,7 @@ USING: help.syntax help.markup ;
 IN: cocoa.views

 HELP: <PixelFormat>
-{ $values { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } }
+{ $values { "attributes" "a sequence of attributes" } { "pixelfmt" "an " { $snippet "NSOpenGLPixelFormat" } } }
 { $description "Creates an " { $snippet "NSOpenGLPixelFormat" } " with some reasonable defaults." } ;

 HELP: <GLView>
--- a/basis/cocoa/windows/windows.factor
+++ b/basis/cocoa/windows/windows.factor
@ -14,7 +14,7 @@ IN: cocoa.windows
 : NSBackingStoreNonretained 1 ; inline
 : NSBackingStoreBuffered    2 ; inline

-: standard-window-type
+: standard-window-type ( -- n )
    {
        NSTitledWindowMask
        NSClosableWindowMask
--- a/basis/columns/columns-docs.factor
+++ b/basis/columns/columns-docs.factor
@ -4,8 +4,8 @@ IN: columns
 HELP: column
 { $class-description "A virtual sequence which presents a fixed column of a matrix represented as a sequence of rows. New instances can be created by calling " { $link <column> } "." } ;

-HELP: <column> ( seq n -- column )
-{ $values { "seq" sequence } { "n" "a non-negative integer" } { "column" column } }
+HELP: <column>
+{ $values { "seq" sequence } { "col" "a non-negative integer" } { "column" column } }
 { $description "Outputs a new virtual sequence which presents a fixed column of a matrix represented as a sequence of rows." "The " { $snippet "i" } "th element of a column is the " { $snippet "n" } "th element of the " { $snippet "i" } "th element of " { $snippet "seq" } ". Every element of " { $snippet "seq" } " must be a sequence, and all sequences must have equal length." }
 { $examples
    { $example
--- a/basis/columns/columns.factor
+++ b/basis/columns/columns.factor
@ -9,7 +9,7 @@ TUPLE: column seq col ;
 C: <column> column

 M: column virtual-seq seq>> ;
-M: column virtual@ dup col>> -rot seq>> nth bounds-check ;
+M: column virtual@ [ col>> swap ] [ seq>> ] bi nth bounds-check ;
 M: column length seq>> length ;

 INSTANCE: column virtual-sequence
--- a/basis/combinators/smart/authors.txt
+++ b/basis/combinators/smart/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/basis/combinators/smart/smart-docs.factor
+++ b/basis/combinators/smart/smart-docs.factor
@ -0,0 +1,125 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations math sequences
+multiline ;
+IN: combinators.smart
+
+HELP: input<sequence
+{ $values
+     { "quot" quotation }
+     { "newquot" quotation }
+}
+{ $description "Infers the number of inputs, " { $snippet "n" } ", to " { $snippet "quot" } " and calls the " { $snippet "quot" } " with the first " { $snippet "n" } " values from a sequence." }
+{ $examples
+    { $example
+        "USING: combinators.smart math prettyprint ;"
+        "{ 1 2 3 } [ + + ] input<sequence ."
+        "6"
+    }
+} ;
+
+HELP: output>array
+{ $values
+     { "quot" quotation }
+     { "newquot" quotation }
+}
+{ $description "Infers the number or outputs from the quotation and constructs an array from those outputs." }
+{ $examples
+    { $example
+        <" USING: combinators combinators.smart math prettyprint ;
+9 [
+    { [ 1- ] [ 1+ ] [ sq ] } cleave
+] output>array .">
+    "{ 8 10 81 }"
+    }
+} ;
+
+HELP: output>sequence
+{ $values
+     { "quot" quotation } { "exemplar" "an exemplar" }
+     { "newquot" quotation }
+}
+{ $description "Infers the number of outputs from the quotation and constructs a new sequence from those objects of the same type as the exemplar." }
+{ $examples
+    { $example
+        "USING: combinators.smart kernel math prettyprint ;"
+        "4 [ [ 1 + ] [ 2 + ] [ 3 + ] tri ] V{ } output>sequence ."
+        "V{ 5 6 7 }"
+    }
+} ;
+
+HELP: reduce-outputs
+{ $values
+     { "quot" quotation } { "operation" quotation }
+     { "newquot" quotation }
+}
+{ $description "Infers the number of outputs from " { $snippet "quot" } " and reduces them using " { $snippet "operation" } ". The identity for the " { $link reduce } " operation is the first output." }
+{ $examples
+    { $example
+        "USING: combinators.smart kernel math prettyprint ;"
+        "3 [ [ 4 * ] [ 4 / ] [ 4 - ] tri ] [ * ] reduce-outputs ."
+        "-9"
+    }
+} ;
+
+HELP: sum-outputs
+{ $values
+     { "quot" quotation }
+     { "n" integer }
+}
+{ $description "Infers the number of outputs from " { $snippet "quot" } " and returns their sum." }
+{ $examples
+    { $example
+        "USING: combinators.smart kernel math prettyprint ;"
+        "10 [ [ 1- ] [ 1+ ] bi ] sum-outputs ."
+        "20"
+    }
+} ;
+
+HELP: append-outputs
+{ $values
+     { "quot" quotation }
+     { "seq" sequence }
+}
+{ $description "Infers the number of outputs from " { $snippet "quot" } " and returns a sequence of the outputs appended." }
+{ $examples
+    { $example
+        "USING: combinators.smart prettyprint ;"
+        "[ { 1 2 } { \"A\" \"b\" } ] append-outputs ."
+        "{ 1 2 \"A\" \"b\" }"
+    }
+} ;
+
+HELP: append-outputs-as
+{ $values
+     { "quot" quotation } { "exemplar" sequence }
+     { "seq" sequence }
+}
+{ $description "Infers the number of outputs from " { $snippet "quot" } " and returns a sequence of type " { $snippet "exemplar" } " of the outputs appended." }
+{ $examples
+    { $example
+        "USING: combinators.smart prettyprint ;"
+        "[ { 1 2 } { \"A\" \"b\" } ] V{ } append-outputs-as ."
+        "V{ 1 2 \"A\" \"b\" }"
+    }
+} ;
+
+{ append-outputs append-outputs-as } related-words
+
+
+ARTICLE: "combinators.smart" "Smart combinators"
+"The " { $vocab-link "combinators.smart" } " vocabulary implements " { $emphasis "smart combinators" } ". A smart combinator is one whose behavior depends on the static stack effect of an input quotation." $nl
+"Smart inputs from a sequence:"
+{ $subsection input<sequence }
+"Smart outputs to a sequence:"
+{ $subsection output>sequence }
+{ $subsection output>array }
+"Reducing the output of a quotation:"
+{ $subsection reduce-outputs }
+"Summing the output of a quotation:"
+{ $subsection sum-outputs }
+"Appending the results of a quotation:"
+{ $subsection append-outputs }
+{ $subsection append-outputs-as } ;
+
+ABOUT: "combinators.smart"
--- a/basis/combinators/smart/smart-tests.factor
+++ b/basis/combinators/smart/smart-tests.factor
@ -0,0 +1,39 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test combinators.smart math kernel ;
+IN: combinators.smart.tests
+
+: test-bi ( -- 9 11 )
+    10 [ 1- ] [ 1+ ] bi ;
+
+[ [ test-bi ] output>array ] must-infer
+[ { 9 11 } ] [ [ test-bi ] output>array ] unit-test
+
+[ { 9 11 } [ + ] input<sequence ] must-infer
+[ 20 ] [ { 9 11 } [ + ] input<sequence ] unit-test
+
+[ 6 ] [ [ 1 2 3 ] [ + ] reduce-outputs ] unit-test
+
+[ [ 1 2 3 ] [ + ] reduce-outputs ] must-infer
+
+[ 6 ] [ [ 1 2 3 ] sum-outputs ] unit-test
+
+[ "ab" ]
+[
+    [ "a" "b" ] "" append-outputs-as
+] unit-test
+
+[ "" ]
+[
+    [ ] "" append-outputs-as
+] unit-test
+
+[ { } ]
+[
+    [ ] append-outputs
+] unit-test
+
+[ B{ 1 2 3 } ]
+[
+    [ { 1 } { 2 } { 3 } ] B{ } append-outputs-as
+] unit-test
--- a/basis/combinators/smart/smart.factor
+++ b/basis/combinators/smart/smart.factor
@ -0,0 +1,28 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors fry generalizations kernel macros math.order
+stack-checker math ;
+IN: combinators.smart
+
+MACRO: output>sequence ( quot exemplar -- newquot )
+    [ dup infer out>> ] dip
+    '[ @ _ _ nsequence ] ;
+
+: output>array ( quot -- newquot )
+    { } output>sequence ; inline
+
+MACRO: input<sequence ( quot -- newquot )
+    [ infer in>> ] keep
+    '[ _ firstn @ ] ;
+
+MACRO: reduce-outputs ( quot operation -- newquot )
+    [ dup infer out>> 1 [-] ] dip n*quot compose ;
+
+: sum-outputs ( quot -- n )
+    [ + ] reduce-outputs ; inline
+
+MACRO: append-outputs-as ( quot exemplar -- newquot )
+    [ dup infer out>> ] dip '[ @ _ _ nappend-as ] ;
+
+: append-outputs ( quot -- seq )
+    { } append-outputs-as ; inline
--- a/basis/command-line/command-line.factor
+++ b/basis/command-line/command-line.factor
@ -1,8 +1,8 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: init continuations hashtables io io.encodings.utf8
-io.files kernel kernel.private namespaces parser sequences
-strings system splitting vocabs.loader ;
+io.files io.pathnames kernel kernel.private namespaces parser
+sequences strings system splitting vocabs.loader ;
 IN: command-line

 SYMBOL: script
--- a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
+++ b/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
--- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
@ -68,7 +68,8 @@ IN: compiler.cfg.alias-analysis
 ! Map vregs -> alias classes
 SYMBOL: vregs>acs

-: check [ "BUG: static type error detected" throw ] unless* ; inline
+: check ( obj -- obj )
+    [ "BUG: static type error detected" throw ] unless* ; inline
 
 : vreg>ac ( vreg -- ac )
    #! Only vregs produced by ##allot, ##peek and ##slot can
@ -223,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*
--- a/basis/compiler/cfg/builder/builder-tests.factor
+++ b/basis/compiler/cfg/builder/builder-tests.factor
@ -14,7 +14,7 @@ kernel.private math ;
    [ ]
    [ dup ]
    [ swap ]
-    [ >r r> ]
+    [ [ ] dip ]
    [ fixnum+ ]
    [ fixnum+fast ]
    [ 3 fixnum+fast ]
--- a/basis/compiler/cfg/hats/hats.factor
+++ b/basis/compiler/cfg/hats/hats.factor
@ -5,17 +5,17 @@ sequences classes.tuple cpu.architecture compiler.cfg.registers
 compiler.cfg.instructions ;
 IN: compiler.cfg.hats

-: i int-regs next-vreg ; inline
-: ^^i i dup ; inline
-: ^^i1 [ ^^i ] dip ; inline
-: ^^i2 [ ^^i ] 2dip ; inline
-: ^^i3 [ ^^i ] 3dip ; inline
+: i ( -- vreg ) int-regs next-vreg ; inline
+: ^^i ( -- vreg vreg ) i dup ; inline
+: ^^i1 ( obj -- vreg vreg obj ) [ ^^i ] dip ; inline
+: ^^i2 ( obj obj -- vreg vreg obj obj ) [ ^^i ] 2dip ; inline
+: ^^i3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^i ] 3dip ; inline

-: d double-float-regs next-vreg ; inline
-: ^^d d dup ; inline
-: ^^d1 [ ^^d ] dip ; inline
-: ^^d2 [ ^^d ] 2dip ; inline
-: ^^d3 [ ^^d ] 3dip ; inline
+: d ( -- vreg ) double-float-regs next-vreg ; inline
+: ^^d  ( -- vreg vreg ) d dup ; inline
+: ^^d1 ( obj -- vreg vreg obj ) [ ^^d ] dip ; inline
+: ^^d2 ( obj obj -- vreg vreg obj obj ) [ ^^d ] 2dip ; inline
+: ^^d3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^d ] 3dip ; inline

 : ^^load-literal ( obj -- dst ) ^^i1 ##load-literal ; inline
 : ^^peek ( loc -- dst ) ^^i1 ##peek ; inline
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/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 } ;
--- a/basis/compiler/cfg/instructions/syntax/syntax.factor
+++ b/basis/compiler/cfg/instructions/syntax/syntax.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes.tuple classes.tuple.parser kernel words
-make fry sequences parser ;
+make fry sequences parser accessors ;
 IN: compiler.cfg.instructions.syntax

 : insn-word ( -- word )
@ -10,10 +10,13 @@ IN: compiler.cfg.instructions.syntax
    #! this one.
    "insn" "compiler.cfg.instructions" lookup ;

+: insn-effect ( word -- effect )
+    boa-effect [ but-last ] change-in { } >>out ;
+
 : INSN:
    parse-tuple-definition "regs" suffix
    [ dup tuple eq? [ drop insn-word ] when ] dip
    [ define-tuple-class ]
    [ 2drop save-location ]
-    [ 2drop dup '[ f _ boa , ] define-inline ]
+    [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ]
    3tri ; parsing
--- a/basis/compiler/cfg/intrinsics/intrinsics.factor
+++ b/basis/compiler/cfg/intrinsics/intrinsics.factor
@ -1,7 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: qualified words sequences kernel combinators
-cpu.architecture
+USING: words sequences kernel combinators cpu.architecture
 compiler.cfg.hats
 compiler.cfg.instructions
 compiler.cfg.intrinsics.alien
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
@ -1,7 +1,7 @@
 IN: compiler.cfg.linear-scan.tests
 USING: tools.test random sorting sequences sets hashtables assocs
 kernel fry arrays splitting namespaces math accessors vectors
-math.order
+math.order grouping
 cpu.architecture
 compiler.cfg.instructions
 compiler.cfg.registers
@ -249,7 +249,7 @@ SYMBOL: max-uses
    ] with-scope ;

 : random-test ( num-intervals max-uses max-registers max-insns -- )
-    over >r random-live-intervals r> int-regs associate check-linear-scan ;
+    over [ random-live-intervals ] dip int-regs associate check-linear-scan ;

 [ ] [ 30 2 1 60 random-test ] unit-test
 [ ] [ 60 2 2 60 random-test ] unit-test
--- a/basis/compiler/cfg/linearization/linearization.factor
+++ b/basis/compiler/cfg/linearization/linearization.factor
@ -37,7 +37,7 @@ M: insn linearize-insn , drop ;
 M: ##branch linearize-insn
    drop dup successors>> first emit-branch ;

-: (binary-conditional)
+: (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc )
    [ dup successors>> first2 ]
    [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline

@ -63,7 +63,7 @@ M: ##compare-float-branch linearize-insn
            ##box-float
            ##box-alien
        } memq?
-    ] contains? ;
+    ] any? ;

 : linearize-basic-block ( bb -- )
    [ number>> _label ]
--- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor
+++ b/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 ;

--- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor
+++ b/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= }
--- a/basis/compiler/codegen/codegen.factor
+++ b/basis/compiler/codegen/codegen.factor
@ -1,9 +1,9 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces make math math.order math.parser sequences accessors
 kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays sets threads libc continuations.private
+alien.strings alien.arrays sets libc continuations.private
 fry cpu.architecture
 compiler.errors
 compiler.alien
@ -11,7 +11,8 @@ compiler.cfg
 compiler.cfg.instructions
 compiler.cfg.registers
 compiler.cfg.builder
-compiler.codegen.fixup ;
+compiler.codegen.fixup
+compiler.utilities ;
 IN: compiler.codegen

 GENERIC: generate-insn ( insn -- )
@ -69,8 +70,8 @@ SYMBOL: labels
 M: ##load-immediate generate-insn
    [ dst>> register ] [ val>> ] bi %load-immediate ;

-M: ##load-indirect generate-insn
-    [ dst>> register ] [ obj>> ] bi %load-indirect ;
+M: ##load-reference generate-insn
+    [ dst>> register ] [ obj>> ] bi %load-reference ;

 M: ##peek generate-insn
    [ dst>> register ] [ loc>> ] bi %peek ;
@ -95,7 +96,7 @@ M: ##dispatch-label generate-insn label>> %dispatch-label ;
 M: ##dispatch generate-insn
    [ src>> register ] [ temp>> register ] [ offset>> ] tri %dispatch ;

-: >slot<
+: >slot< ( insn -- dst obj slot tag )
    {
        [ dst>> register ]
        [ obj>> register ]
@ -109,7 +110,7 @@ M: ##slot generate-insn
 M: ##slot-imm generate-insn
    >slot< %slot-imm ;

-: >set-slot<
+: >set-slot< ( insn -- src obj slot tag )
    {
        [ src>> register ]
        [ obj>> register ]
@ -209,7 +210,8 @@ M: ##alien-cell       generate-insn dst/src %alien-cell       ;
 M: ##alien-float      generate-insn dst/src %alien-float      ;
 M: ##alien-double     generate-insn dst/src %alien-double     ;

-: >alien-setter< [ src>> register ] [ value>> register ] bi ; inline
+: >alien-setter< ( insn -- src value )
+    [ src>> register ] [ value>> register ] bi ; inline

 M: ##set-alien-integer-1 generate-insn >alien-setter< %set-alien-integer-1 ;
 M: ##set-alien-integer-2 generate-insn >alien-setter< %set-alien-integer-2 ;
@ -398,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
@ -462,7 +464,7 @@ TUPLE: callback-context ;
    dup current-callback eq? [
        drop
    ] [
-        yield wait-to-return
+        yield-hook get call wait-to-return
    ] if ;

 : do-callback ( quot token -- )
--- a/basis/compiler/compiler.factor
+++ b/basis/compiler/compiler.factor
@ -1,14 +1,14 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces arrays sequences io
 words fry continuations vocabs assocs dlists definitions math
-threads graphs generic combinators deques search-deques io
+graphs generic combinators deques search-deques io
 stack-checker stack-checker.state stack-checker.inlining
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder
 compiler.cfg.optimizer compiler.cfg.linearization
 compiler.cfg.two-operand compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.codegen ;
+compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
 IN: compiler

 SYMBOL: compile-queue
@ -24,7 +24,7 @@ SYMBOL: compiled
    } cond drop ;

 : maybe-compile ( word -- )
-    dup compiled>> [ drop ] [ queue-compile ] if ;
+    dup optimized>> [ drop ] [ queue-compile ] if ;

 SYMBOL: +failed+

@ -107,10 +107,10 @@ t compile-dependencies? set-global
    ] with-return ;

 : compile-loop ( deque -- )
-    [ (compile) yield ] slurp-deque ;
+    [ (compile) yield-hook get call ] slurp-deque ;

 : decompile ( word -- )
-    f 2array 1array t modify-code-heap ;
+    f 2array 1array modify-code-heap ;

 : optimized-recompile-hook ( words -- alist )
    [
--- a/basis/compiler/tests/codegen.factor
+++ b/basis/compiler/tests/codegen.factor
@ -75,7 +75,7 @@ unit-test
    -12 -13 [ [ 0 swap fixnum-fast ] bi@ ] compile-call
 ] unit-test

-[ -1 2 ] [ 1 2 [ >r 0 swap fixnum- r> ] compile-call ] unit-test
+[ -1 2 ] [ 1 2 [ [ 0 swap fixnum- ] dip ] compile-call ] unit-test

 [ 12 13 ] [
    -12 -13 [ [ 0 swap fixnum- ] bi@ ] compile-call
@ -88,13 +88,13 @@ unit-test
 ! Test slow shuffles
 [ 3 1 2 3 4 5 6 7 8 9 ] [
    1 2 3 4 5 6 7 8 9
-    [ >r >r >r >r >r >r >r >r >r 3 r> r> r> r> r> r> r> r> r> ]
+    [ [ [ [ [ [ [ [ [ [ 3 ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ] dip ]
    compile-call
 ] unit-test

 [ 2 2 2 2 2 2 2 2 2 2 1 ] [
    1 2
-    [ swap >r dup dup dup dup dup dup dup dup dup r> ] compile-call
+    [ swap [ dup dup dup dup dup dup dup dup dup ] dip ] compile-call
 ] unit-test

 [ ] [ [ 9 [ ] times ] compile-call ] unit-test
@ -110,7 +110,7 @@ unit-test
    float+ swap { [ "hey" ] [ "bye" ] } dispatch ;

 : try-breaking-dispatch-2 ( -- ? )
-    1 1.0 2.5 try-breaking-dispatch "bye" = >r 3.5 = r> and ;
+    1 1.0 2.5 try-breaking-dispatch "bye" = [ 3.5 = ] dip and ;

 [ t ] [
    10000000 [ drop try-breaking-dispatch-2 ] all?
@ -131,10 +131,10 @@ unit-test
    2dup 1 slot eq? [ 2drop ] [ 
        2dup array-nth tombstone? [ 
            [
-                [ array-nth ] 2keep >r 1 fixnum+fast r> array-nth
+                [ array-nth ] 2keep [ 1 fixnum+fast ] dip array-nth
                pick 2dup hellish-bug-1 3drop
            ] 2keep
-        ] unless >r 2 fixnum+fast r> hellish-bug-2
+        ] unless [ 2 fixnum+fast ] dip hellish-bug-2
    ] if ; inline recursive

 : hellish-bug-3 ( hash array -- ) 
@ -159,9 +159,9 @@ TUPLE: my-tuple ;
 [ 5 ] [ "hi" foox ] unit-test

 ! Making sure we don't needlessly unbox/rebox
-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ >r eq? r> ] compile-call ] unit-test
+[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ [ eq? ] dip ] compile-call ] unit-test

-[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call >r eq? r> ] unit-test
+[ t 3.0 ] [ 1.0 dup [ dup 2.0 float+ ] compile-call [ eq? ] dip ] unit-test

 [ t ] [ 1.0 dup [ [ 2.0 float+ ] keep ] compile-call nip eq? ] unit-test

@ -188,7 +188,7 @@ TUPLE: my-tuple ;

 [ 2 1 ] [
    2 1
-    [ 2dup fixnum< [ >r die r> ] when ] compile-call
+    [ 2dup fixnum< [ [ die ] dip ] when ] compile-call
 ] unit-test

 ! Regression
@ -211,7 +211,7 @@ TUPLE: my-tuple ;
    { tuple vector } 3 slot { word } declare
    dup 1 slot 0 fixnum-bitand { [ ] } dispatch ;

-[ t ] [ \ dispatch-alignment-regression compiled>> ] unit-test
+[ t ] [ \ dispatch-alignment-regression optimized>> ] unit-test

 [ vector ] [ dispatch-alignment-regression ] unit-test

@ -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
--- a/basis/compiler/tests/curry.factor
+++ b/basis/compiler/tests/curry.factor
@ -8,7 +8,7 @@ IN: compiler.tests
 [ 3 ] [ 5 [ 2 [ - ] 2curry call ] compile-call ] unit-test
 [ 3 ] [ 5 2 [ [ - ] 2curry call ] compile-call ] unit-test
 [ 3 ] [ 5 2 [ [ - ] 2curry 9 swap call /i ] compile-call ] unit-test
-[ 3 ] [ 5 2 [ [ - ] 2curry >r 9 r> call /i ] compile-call ] unit-test
+[ 3 ] [ 5 2 [ [ - ] 2curry [ 9 ] dip call /i ] compile-call ] unit-test

 [ -10 -20 ] [ 10 20 -1 [ [ * ] curry bi@ ] compile-call ] unit-test

@ -21,14 +21,14 @@ IN: compiler.tests
 [ [ 6 2 + ] ]
 [
    2 5
-    [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry ]
+    [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry ]
    compile-call >quotation
 ] unit-test

 [ 8 ]
 [
    2 5
-    [ >r [ + ] curry r> 0 < [ -2 ] [ 6 ] if swap curry call ]
+    [ [ [ + ] curry ] dip 0 < [ -2 ] [ 6 ] if swap curry call ]
    compile-call
 ] unit-test

--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@ -9,7 +9,7 @@ IN: optimizer.tests
 GENERIC: xyz ( obj -- obj )
 M: array xyz xyz ;

-[ t ] [ \ xyz compiled>> ] unit-test
+[ t ] [ \ xyz optimized>> ] unit-test

 ! Test predicate inlining
 : pred-test-1
@ -94,7 +94,7 @@ TUPLE: pred-test ;
 ! regression
 GENERIC: void-generic ( obj -- * )
 : breakage ( -- * ) "hi" void-generic ;
-[ t ] [ \ breakage compiled>> ] unit-test
+[ t ] [ \ breakage optimized>> ] unit-test
 [ breakage ] must-fail

 ! regression
@ -119,7 +119,7 @@ GENERIC: void-generic ( obj -- * )
 ! compiling <tuple> with a non-literal class failed
 : <tuple>-regression ( class -- tuple ) <tuple> ;

-[ t ] [ \ <tuple>-regression compiled>> ] unit-test
+[ t ] [ \ <tuple>-regression optimized>> ] unit-test

 GENERIC: foozul ( a -- b )
 M: reversed foozul ;
@ -228,7 +228,7 @@ USE: binary-search.private
 : node-successor-f-bug ( x -- * )
    [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;

-[ t ] [ \ node-successor-f-bug compiled>> ] unit-test
+[ t ] [ \ node-successor-f-bug optimized>> ] unit-test

 [ ] [ [ new ] build-tree optimize-tree drop ] unit-test

@ -242,18 +242,18 @@ USE: binary-search.private
        ] if
    ] if ;

-[ t ] [ \ lift-throw-tail-regression compiled>> ] unit-test
+[ t ] [ \ lift-throw-tail-regression optimized>> ] unit-test
 [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
 [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test

 : lift-loop-tail-test-1 ( a quot -- )
    over even? [
-        [ >r 3 - r> call ] keep lift-loop-tail-test-1
+        [ [ 3 - ] dip call ] keep lift-loop-tail-test-1
    ] [
        over 0 < [
            2drop
        ] [
-            [ >r 2 - r> call ] keep lift-loop-tail-test-1
+            [ [ 2 - ] dip call ] keep lift-loop-tail-test-1
        ] if
    ] if ; inline

@ -271,7 +271,7 @@ HINTS: recursive-inline-hang array ;
 : recursive-inline-hang-1 ( -- a )
    { } recursive-inline-hang ;

-[ t ] [ \ recursive-inline-hang-1 compiled>> ] unit-test
+[ t ] [ \ recursive-inline-hang-1 optimized>> ] unit-test

 DEFER: recursive-inline-hang-3

@ -290,7 +290,7 @@ HINTS: recursive-inline-hang-3 array ;

 ! Wow
 : counter-example ( a b c d -- a' b' c' d' )
-    dup 0 > [ 1 - >r rot 2 * r> counter-example ] when ; inline
+    dup 0 > [ 1 - [ rot 2 * ] dip counter-example ] when ; inline

 : counter-example' ( -- a' b' c' d' )
    1 2 3.0 3 counter-example ;
@ -330,7 +330,7 @@ PREDICATE: list < improper-list
 [ 0 5 ] [ 0 interval-inference-bug ] unit-test

 : aggressive-flush-regression ( a -- b )
-    f over >r <array> drop r> 1 + ;
+    f over [ <array> drop ] dip 1 + ;

 [ 1.0 aggressive-flush-regression drop ] must-fail

--- a/basis/compiler/tests/peg-regression.factor
+++ b/basis/compiler/tests/peg-regression.factor
@ -22,5 +22,5 @@ pipeline = "hello" => [[ ast>pipeline-expr ]]

 USE: tools.test

-[ t ] [ \ expr compiled>> ] unit-test
-[ t ] [ \ ast>pipeline-expr compiled>> ] unit-test
+[ t ] [ \ expr optimized>> ] unit-test
+[ t ] [ \ ast>pipeline-expr optimized>> ] unit-test
--- a/basis/compiler/tests/redefine1.factor
+++ b/basis/compiler/tests/redefine1.factor
@ -23,36 +23,36 @@ M: integer method-redefine-test 3 + ;
 : hey ( -- ) ;
 : there ( -- ) hey ;

-[ t ] [ \ hey compiled>> ] unit-test
-[ t ] [ \ there compiled>> ] unit-test
+[ t ] [ \ hey optimized>> ] unit-test
+[ t ] [ \ there optimized>> ] unit-test
 [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test
-[ f ] [ \ hey compiled>> ] unit-test
-[ f ] [ \ there compiled>> ] unit-test
+[ f ] [ \ hey optimized>> ] unit-test
+[ f ] [ \ there optimized>> ] unit-test
 [ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test
-[ t ] [ \ there compiled>> ] unit-test
+[ t ] [ \ there optimized>> ] unit-test

 : good ( -- ) ;
 : bad ( -- ) good ;
 : ugly ( -- ) bad ;

-[ t ] [ \ good compiled>> ] unit-test
-[ t ] [ \ bad compiled>> ] unit-test
-[ t ] [ \ ugly compiled>> ] unit-test
+[ t ] [ \ good optimized>> ] unit-test
+[ t ] [ \ bad optimized>> ] unit-test
+[ t ] [ \ ugly optimized>> ] unit-test

 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test

 [ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test

-[ f ] [ \ good compiled>> ] unit-test
-[ f ] [ \ bad compiled>> ] unit-test
-[ f ] [ \ ugly compiled>> ] unit-test
+[ f ] [ \ good optimized>> ] unit-test
+[ f ] [ \ bad optimized>> ] unit-test
+[ f ] [ \ ugly optimized>> ] unit-test

 [ t ] [ \ good compiled-usage assoc-empty? ] unit-test

 [ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test

-[ t ] [ \ good compiled>> ] unit-test
-[ t ] [ \ bad compiled>> ] unit-test
-[ t ] [ \ ugly compiled>> ] unit-test
+[ t ] [ \ good optimized>> ] unit-test
+[ t ] [ \ bad optimized>> ] unit-test
+[ t ] [ \ ugly optimized>> ] unit-test

 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test
--- a/basis/compiler/tests/redefine3.factor
+++ b/basis/compiler/tests/redefine3.factor
@ -14,7 +14,7 @@ M: empty-mixin sheeple drop "wake up" ;
 : sheeple-test ( -- string ) { } sheeple ;

 [ "sheeple" ] [ sheeple-test ] unit-test
-[ t ] [ \ sheeple-test compiled>> ] unit-test
+[ t ] [ \ sheeple-test optimized>> ] unit-test
 [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
 [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test

@ -27,6 +27,6 @@ M: empty-mixin sheeple drop "wake up" ;
 [ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test

 [ "sheeple" ] [ sheeple-test ] unit-test
-[ t ] [ \ sheeple-test compiled>> ] unit-test
+[ t ] [ \ sheeple-test optimized>> ] unit-test
 [ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
 [ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test
--- a/basis/compiler/tests/simple.factor
+++ b/basis/compiler/tests/simple.factor
@ -237,6 +237,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
 10 [
    [ "compiler.tests.foo" forget-vocab ] with-compilation-unit
    [ t ] [
-        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) compiled>>" eval
+        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval
    ] unit-test
 ] times
--- a/basis/compiler/tests/spilling.factor
+++ b/basis/compiler/tests/spilling.factor
@ -47,7 +47,7 @@ IN: compiler.tests
 [ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
 [ 1.0 float-spill-bug ] unit-test

-[ t ] [ \ float-spill-bug compiled>> ] unit-test
+[ t ] [ \ float-spill-bug optimized>> ] unit-test

 : float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
    {
@ -132,7 +132,7 @@ IN: compiler.tests
 [ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
 [ 1.0 float-fixnum-spill-bug ] unit-test

-[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
+[ t ] [ \ float-fixnum-spill-bug optimized>> ] unit-test

 : resolve-spill-bug ( a b -- c )
    [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
@ -159,7 +159,7 @@ IN: compiler.tests
        16 narray
    ] if ;

-[ t ] [ \ resolve-spill-bug compiled>> ] unit-test
+[ t ] [ \ resolve-spill-bug optimized>> ] unit-test

 [ 4 ] [ 1 1 resolve-spill-bug ] unit-test

--- a/basis/compiler/tests/stack-trace.factor
+++ b/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-contains?
+    \ + stack-trace-any?
+    \ > stack-trace-any?
 ] unit-test
--- a/basis/compiler/tree/builder/builder-tests.factor
+++ b/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
--- a/basis/compiler/tree/checker/checker.factor
+++ b/basis/compiler/tree/checker/checker.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: sequences kernel sets namespaces accessors assocs
 arrays combinators continuations columns math vectors
-stack-checker.branches
+grouping stack-checker.branches
 compiler.tree
 compiler.tree.def-use
 compiler.tree.combinators ;
@ -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 ;

--- a/basis/compiler/tree/cleanup/cleanup-tests.factor
+++ b/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

 [ ] [
--- a/basis/compiler/tree/combinators/combinators.factor
+++ b/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 ;
--- a/basis/compiler/tree/dead-code/dead-code-tests.factor
+++ b/basis/compiler/tree/dead-code/dead-code-tests.factor
@ -79,7 +79,7 @@ IN: compiler.tree.dead-code.tests

 [ [ read drop 1 2 ] ] [ [ read [ 1 2 ] dip drop ] optimize-quot ] unit-test

-[ [ over >r + r> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test
+[ [ over >R + R> ] ] [ [ [ + ] [ drop ] 2bi ] optimize-quot ] unit-test

 [ [ [ ] [ ] if ] ] [ [ [ 1 ] [ 2 ] if drop ] optimize-quot ] unit-test

--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/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? [
--- a/basis/compiler/tree/debugger/debugger.factor
+++ b/basis/compiler/tree/debugger/debugger.factor
@ -4,7 +4,7 @@ USING: kernel assocs match fry accessors namespaces make effects
 sequences sequences.private quotations generic macros arrays
 prettyprint prettyprint.backend prettyprint.custom
 prettyprint.sections math words combinators
-combinators.short-circuit io sorting hints qualified
+combinators.short-circuit io sorting hints
 compiler.tree
 compiler.tree.recursive
 compiler.tree.normalization
@ -80,10 +80,12 @@ M: shuffle-node pprint* effect>> effect>string text ;
        [ out-d>> length 1 = ]
    } 1&& ;

+SYMBOLS: >R R> ;
+
 M: #shuffle node>quot
    {
-        { [ dup #>r? ] [ drop \ >r , ] }
-        { [ dup #r>? ] [ drop \ r> , ] }
+        { [ dup #>r? ] [ drop \ >R , ] }
+        { [ dup #r>? ] [ drop \ R> , ] }
        {
            [ dup [ in-r>> empty? ] [ out-r>> empty? ] bi and ]
            [
--- a/basis/compiler/tree/escape-analysis/branches/branches.factor
+++ b/basis/compiler/tree/escape-analysis/branches/branches.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces sequences sets fry columns
-stack-checker.branches
+grouping stack-checker.branches
 compiler.tree
 compiler.tree.propagation.branches
 compiler.tree.escape-analysis.nodes
--- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
+++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor
@ -8,13 +8,13 @@ compiler.tree.debugger ;
 : test-modular-arithmetic ( quot -- quot' )
    build-tree optimize-tree nodes>quot ;

-[ [ >r >fixnum r> >fixnum fixnum+fast ] ]
+[ [ >R >fixnum R> >fixnum fixnum+fast ] ]
 [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test

 [ [ +-integer-integer dup >fixnum ] ]
 [ [ { integer integer } declare + dup >fixnum ] test-modular-arithmetic ] unit-test

-[ [ >r >fixnum r> >fixnum fixnum+fast 4 fixnum*fast ] ]
+[ [ >R >fixnum R> >fixnum fixnum+fast 4 fixnum*fast ] ]
 [ [ { integer integer } declare + 4 * >fixnum ] test-modular-arithmetic ] unit-test

 TUPLE: declared-fixnum { x fixnum } ;
--- a/basis/compiler/tree/normalization/normalization.factor
+++ b/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 ;
--- a/basis/compiler/tree/propagation/branches/branches.factor
+++ b/basis/compiler/tree/propagation/branches/branches.factor
--- a/basis/compiler/tree/propagation/copy/copy.factor
+++ b/basis/compiler/tree/propagation/copy/copy.factor
@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces sequences assocs math kernel accessors fry
-combinators sets locals columns
+combinators sets locals columns grouping
 stack-checker.branches
 compiler.tree
 compiler.tree.def-use
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@ -3,7 +3,7 @@
 USING: accessors kernel arrays sequences math math.order
 math.partial-dispatch generic generic.standard generic.math
 classes.algebra classes.union sets quotations assocs combinators
-words namespaces continuations classes fry
+words namespaces continuations classes fry combinators.smart
 compiler.tree
 compiler.tree.builder
 compiler.tree.recursive
@ -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 ;
@ -134,17 +134,19 @@ DEFER: (flat-length)
    over 2 <= [ drop ] [ 2/ 1+ * ] if 24 swap [-] 4 /i ;

 : inlining-rank ( #call word -- n )
-    [ classes-known? 2 0 ? ]
    [
-        {
-            [ body-length-bias ]
-            [ "default" word-prop -4 0 ? ]
-            [ "specializer" word-prop 1 0 ? ]
-            [ method-body? 1 0 ? ]
-        } cleave
-        node-count-bias
-        loop-nesting get 0 or 2 *
-    ] bi* + + + + + + ;
+        [ classes-known? 2 0 ? ]
+        [
+            {
+                [ body-length-bias ]
+                [ "default" word-prop -4 0 ? ]
+                [ "specializer" word-prop 1 0 ? ]
+                [ method-body? 1 0 ? ]
+            } cleave
+            node-count-bias
+            loop-nesting get 0 or 2 *
+        ] bi*
+    ] sum-outputs ;

 : should-inline? ( #call word -- ? )
    dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ;
--- a/basis/compiler/tree/propagation/known-words/known-words.factor
+++ b/basis/compiler/tree/propagation/known-words/known-words.factor
@ -6,7 +6,7 @@ math.parser math.order layouts words sequences sequences.private
 arrays assocs classes classes.algebra combinators generic.math
 splitting fry locals classes.tuple alien.accessors
 classes.tuple.private slots.private definitions strings.private
-vectors hashtables
+vectors hashtables generic
 stack-checker.state
 compiler.tree.comparisons
 compiler.tree.propagation.info
@ -337,3 +337,12 @@ generic-comparison-ops [
        bi
    ] [ 2drop object-info ] if
 ] "outputs" set-word-prop
+
+\ equal? [
+    ! If first input has a known type and second input is an
+    ! object, we convert this to [ swap equal? ].
+    in-d>> first2 value-info class>> object class= [
+        value-info class>> \ equal? specific-method
+        [ swap equal? ] f ?
+    ] [ drop f ] if
+] "custom-inlining" set-word-prop
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@ -18,7 +18,7 @@ IN: compiler.tree.propagation.tests

 [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test

-[ V{ fixnum } ] [ [ 1 >r r> ] final-classes ] unit-test
+[ V{ fixnum } ] [ [ 1 [ ] dip ] final-classes ] unit-test

 [ V{ fixnum object } ] [ [ 1 swap ] final-classes ] unit-test

@ -198,7 +198,7 @@ IN: compiler.tree.propagation.tests
    [
        { fixnum byte-array } declare
        [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
-        >r >r 298 * r> 100 * - r> 208 * - 128 + -8 shift
+        [ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift
        255 min 0 max
    ] final-classes
 ] unit-test
@ -640,6 +640,10 @@ MIXIN: empty-mixin
    [ { fixnum } declare log2 0 >= ] final-classes
 ] unit-test

+[ V{ POSTPONE: f } ] [
+    [ { word object } declare equal? ] final-classes
+] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test
--- a/basis/compiler/tree/tuple-unboxing/tuple-unboxing.factor
+++ b/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 ;
--- a/basis/compiler/utilities/utilities.factor
+++ b/basis/compiler/utilities/utilities.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 sequences sequences.private arrays vectors fry
-math.order ;
+math.order namespaces assocs ;
 IN: compiler.utilities

 : flattener ( seq quot -- seq vector quot' )
@ -22,10 +22,6 @@ IN: compiler.utilities

 : 2map-flat ( seq quot -- seq' ) [ 2each ] flattening ; inline

-: (3each) ( seq1 seq2 seq3 quot -- n quot' )
-    [ [ [ length ] tri@ min min ] 3keep ] dip
-    '[ [ _ nth-unsafe ] [ _ nth-unsafe ] [ _ nth-unsafe ] tri @ ] ; inline
+SYMBOL: yield-hook

-: 3each ( seq1 seq2 seq3 quot -- seq ) (3each) each ; inline
-
-: 3map ( seq1 seq2 seq3 quot -- seq ) (3each) map ; inline
+yield-hook global [ [ ] or ] change-at
--- a/Show More
+++ b/Show More