Merge branch 'master' of git://factorcode.org/git/factor into clean-linux-x86-32

README.txt

@@ -59,10 +59,10 @@ On Unix, Factor can either run a graphical user interface using X11, or
 a terminal listener.
 
 For X11 support, you need recent development libraries for libc,
-Pango, X11, OpenGL and GLUT. On a Debian-derived Linux distribution
+Pango, X11, and OpenGL. On a Debian-derived Linux distribution
 (like Ubuntu), you can use the following line to grab everything:
 
-    sudo apt-get install libc6-dev libpango-1.0-dev libx11-dev glutg3-dev
+    sudo apt-get install libc6-dev libpango-1.0-dev libx11-dev
 
 If your DISPLAY environment variable is set, the UI will start
 automatically:

basis/alarms/alarms-tests.factor

@@ -15,5 +15,3 @@ tools.test threads concurrency.count-downs ;
         [ resume ] curry instant later drop
     ] "test" suspend drop
 ] unit-test
-
-\ alarm-thread-loop must-infer

basis/alien/c-types/c-types-tests.factor

@@ -2,8 +2,6 @@ IN: alien.c-types.tests
 USING: alien alien.syntax alien.c-types kernel tools.test
 sequences system libc alien.strings io.encodings.utf8 ;
 
-\ expand-constants must-infer
-
 CONSTANT: xyz 123
 
 [ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test

basis/base64/base64-tests.factor

@@ -25,6 +25,3 @@ IN: base64.tests
 
 [ { 33 52 17 40 12 51 33 43 18 33 23 } base64> ]
 [ malformed-base64? ] must-fail-with
-
-\ >base64 must-infer
-\ base64> must-infer

basis/binary-search/binary-search-tests.factor

@@ -1,8 +1,6 @@
 IN: binary-search.tests
 USING: binary-search math.order vectors kernel tools.test ;
 
-\ sorted-member? must-infer
-
 [ f ] [ 3 { } [ <=> ] with search drop ] unit-test
 [ 0 ] [ 3 { 3 } [ <=> ] with search drop ] unit-test
 [ 1 ] [ 2 { 1 2 3 } [ <=> ] with search drop ] unit-test

basis/bootstrap/compiler/compiler.factor

@@ -108,7 +108,7 @@ nl
 
 "." write flush
 
-{ (compile) } compile-unoptimized
+{ compile-word } compile-unoptimized
 
 "." write flush
 

basis/bootstrap/image/image-tests.factor

@@ -2,9 +2,6 @@ IN: bootstrap.image.tests
 USING: bootstrap.image bootstrap.image.private tools.test
 kernel math ;
 
-\ ' must-infer
-\ write-image must-infer
-
 [ f ] [ { 1 2 3 } [ 1 2 3 ] eql? ] unit-test
 
 [ t ] [ [ 1 2 3 ] [ 1 2 3 ] eql? ] unit-test

basis/bootstrap/stage2.factor

@@ -16,13 +16,6 @@ SYMBOL: bootstrap-time
     vm file-name os windows? [ "." split1-last drop ] when
     ".image" append resource-path ;
 
-: do-crossref ( -- )
-    "Cross-referencing..." print flush
-    H{ } clone crossref set-global
-    xref-words
-    xref-generics
-    xref-sources ;
-
 : load-components ( -- )
     "include" "exclude"
     [ get-global " " split harvest ] bi@
@@ -68,8 +61,6 @@ SYMBOL: bootstrap-time
 
     (command-line) parse-command-line
 
-    do-crossref
-
     ! Set dll paths
     os wince? [ "windows.ce" require ] when
     os winnt? [ "windows.nt" require ] when
@@ -78,6 +69,8 @@ SYMBOL: bootstrap-time
         "stage2: deployment mode" print
     ] [
         "listener" require
+        "debugger" require
+        "tools.errors" require
         "none" require
     ] if
 

basis/calendar/calendar-tests.factor

@@ -2,10 +2,6 @@ USING: arrays calendar kernel math sequences tools.test
 continuations system math.order threads ;
 IN: calendar.tests
 
-\ time+ must-infer
-\ time* must-infer
-\ time- must-infer
-
 [ f ] [ 2004 12 32 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
 [ f ] [ 2004  2 30 0   0  0 instant <timestamp> valid-timestamp? ] unit-test
 [ f ] [ 2003  2 29 0   0  0 instant <timestamp> valid-timestamp? ] unit-test

basis/calendar/format/macros/macros-tests.factor

@@ -1,4 +1,4 @@
-USING: tools.test kernel ;
+USING: tools.test kernel accessors ;
 IN: calendar.format.macros
 
 [ 2 ] [ { [ 2 ] } attempt-all-quots ] unit-test
@@ -10,6 +10,6 @@ IN: calendar.format.macros
 : compiled-test-1 ( -- n )
     { [ 1 throw ] [ 2 ] } attempt-all-quots ;
 
-\ compiled-test-1 must-infer
+\ compiled-test-1 def>> must-infer
 
 [ 2 ] [ compiled-test-1 ] unit-test

basis/combinators/smart/smart-tests.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test combinators.smart math kernel ;
+USING: tools.test combinators.smart math kernel accessors ;
 IN: combinators.smart.tests
 
 : test-bi ( -- 9 11 )
@@ -42,7 +42,7 @@ IN: combinators.smart.tests
 : nested-smart-combo-test ( -- array )
     [ [ 1 2 ] output>array [ 3 4 ] output>array ] output>array ;
 
-\ nested-smart-combo-test must-infer
+\ nested-smart-combo-test def>> must-infer
 
 [ { { 1 2 } { 3 4 } } ] [ nested-smart-combo-test ] unit-test
 

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

@@ -5,8 +5,6 @@ math.private compiler.tree.builder compiler.tree.optimizer
 compiler.cfg.builder compiler.cfg.debugger arrays locals byte-arrays
 kernel.private math ;
 
-\ build-cfg must-infer
-
 ! Just ensure that various CFGs build correctly.
 : unit-test-cfg ( quot -- ) '[ _ test-cfg drop ] [ ] swap unit-test ;
 

basis/compiler/cfg/debugger/debugger.factor

@@ -16,7 +16,7 @@ M: callable test-cfg
     build-tree optimize-tree gensym build-cfg ;
 
 M: word test-cfg
-    [ build-tree-from-word optimize-tree ] keep build-cfg ;
+    [ build-tree optimize-tree ] keep build-cfg ;
 
 SYMBOL: allocate-registers?
 

basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor

@@ -1,4 +1,4 @@
 USING: compiler.cfg.linear-scan.assignment tools.test ;
 IN: compiler.cfg.linear-scan.assignment.tests
 
-\ assign-registers must-infer
+

basis/compiler/cfg/linearization/linearization-tests.factor

@@ -1,4 +1,4 @@
 IN: compiler.cfg.linearization.tests
 USING: compiler.cfg.linearization tools.test ;
 
-\ build-mr must-infer
+

basis/compiler/compiler-docs.factor

@@ -27,12 +27,12 @@ $nl
 { $subsection compile-queue }
 "Once compiled, a word is added to the assoc stored in the " { $link compiled } " variable. When compilation is complete, this assoc is passed to " { $link modify-code-heap } "."
 $nl
-"The " { $link (compile) } " word performs the actual task of compiling an individual word. The process proceeds as follows:"
+"The " { $link compile-word } " word performs the actual task of compiling an individual word. The process proceeds as follows:"
 { $list
-  { "The " { $link frontend } " word calls " { $link build-tree-from-word } ". If this fails, the error is passed to " { $link fail } ". The logic for ignoring compile warnings generated for inline words and macros is located here. If the error is not ignorable, it is added to the global " { $link compiler-errors } " assoc (see " { $link "compiler-errors" } ")." }
+  { "The " { $link frontend } " word calls " { $link build-tree } ". If this fails, the error is passed to " { $link deoptimize } ". The logic for ignoring compile warnings generated for inline words and macros is located here. If the error is not ignorable, it is added to the global " { $link compiler-errors } " assoc (see " { $link "compiler-errors" } ")." }
   { "If the word contains a breakpoint, compilation ends here. Otherwise, all remaining steps execute until machine code is generated. Any further errors thrown by the compiler are not reported as compile errors, but instead are ordinary exceptions. This is because they indicate bugs in the compiler, not errors in user code." }
   { "The " { $link frontend } " word then calls " { $link optimize-tree } ". This produces the final optimized tree IR, and this stage of the compiler is complete." }
-  { "The " { $link backend } " word calls " { $link build-cfg } " followed by " { $link optimize-cfg } " and a few other stages. Finally, it calls " { $link save-asm } ", and adds any uncompiled words called by this word to the compilation queue with " { $link maybe-compile } "." }
+  { "The " { $link backend } " word calls " { $link build-cfg } " followed by " { $link optimize-cfg } " and a few other stages. Finally, it calls " { $link save-asm } ", and adds any uncompiled words called by this word to the compilation queue with " { $link compile-dependency } "." }
 }
 "If compilation fails, the word is stored in the " { $link compiled } " assoc with a value of " { $link f } ". This causes the VM to compile the word with the non-optimizing compiler."
 $nl
@@ -60,7 +60,7 @@ HELP: decompile
 { $values { "word" word } }
 { $description "Removes a word's optimized definition. The word will be compiled with the non-optimizing compiler until recompiled with the optimizing compiler again." } ;
 
-HELP: (compile)
+HELP: compile-word
 { $values { "word" word } }
 { $description "Compile a single word." }
 { $notes "This is an internal word, and user code should call " { $link compile } " instead." } ;

basis/compiler/compiler.factor

@@ -15,6 +15,7 @@ SYMBOL: compile-queue
 SYMBOL: compiled
 
 : queue-compile? ( word -- ? )
+    #! Don't attempt to compile certain words.
     {
         [ "forgotten" word-prop ]
         [ compiled get key? ]
@@ -25,26 +26,14 @@ SYMBOL: compiled
 : queue-compile ( word -- )
     dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
 
-: maybe-compile ( word -- )
+: recompile-callers? ( word -- ? )
-    dup optimized>> [ drop ] [ queue-compile ] if ;
+    changed-effects get key? ;
 
-SYMBOLS: +optimized+ +unoptimized+ ;
+: recompile-callers ( words -- )
-
+    #! If a word's stack effect changed, recompile all words that
-: ripple-up ( words -- )
+    #! have compiled calls to it.
-    dup "compiled-status" word-prop +unoptimized+ eq?
+    dup recompile-callers?
-    [ usage [ word? ] filter ] [ compiled-usage keys ] if
+    [ compiled-usage keys [ queue-compile ] each ] [ drop ] if ;
-    [ queue-compile ] each ;
-
-: ripple-up? ( status word -- ? )
-    [
-        [ nip changed-effects get key? ]
-        [ "compiled-status" word-prop eq? not ] 2bi or
-    ] keep "compiled-status" word-prop and ;
-
-: save-compiled-status ( word status -- )
-    [ over ripple-up? [ ripple-up ] [ drop ] if ]
-    [ "compiled-status" set-word-prop ]
-    2bi ;
 
 : start ( word -- )
     "trace-compilation" get [ dup name>> print flush ] when
@@ -53,39 +42,72 @@ SYMBOLS: +optimized+ +unoptimized+ ;
     f swap compiler-error ;
 
 : ignore-error? ( word error -- ? )
+    #! Ignore warnings on inline combinators, macros, and special
+    #! words such as 'call'.
     [
         {
-            [ inline? ]
             [ macro? ]
-            [ "transform-quot" word-prop ]
+            [ inline? ]
-            [ "no-compile" word-prop ]
             [ "special" word-prop ]
+            [ "no-compile" word-prop ]
         } 1||
     ] [ error-type +compiler-warning+ eq? ] bi* and ;
 
-: (fail) ( word -- * )
+: finish ( word -- )
+    #! Recompile callers if the word's stack effect changed, then
+    #! save the word's dependencies so that if they change, the
+    #! word can get recompiled too.
+    [ recompile-callers ]
     [ compiled-unxref ]
-    [ f swap compiled get set-at ]
+    [
-    [ +unoptimized+ save-compiled-status ]
+        dup crossref? [
-    tri
+            dependencies get
-    return ;
+            generic-dependencies get
+            compiled-xref
+        ] [ drop ] if
+    ] tri ;
 
-: fail ( word error -- * )
+: deoptimize-with ( word def -- * )
-    [ 2dup ignore-error? [ drop f ] when swap compiler-error ] [ drop (fail) ] 2bi ;
+    #! If the word failed to infer, compile it with the
+    #! non-optimizing compiler. 
+    swap [ finish ] [ compiled get set-at ] bi return ;
+
+: not-compiled-def ( word error -- def )
+    '[ _ _ not-compiled ] [ ] like ;
+
+: deoptimize ( word error -- * )
+    #! If the error is ignorable, compile the word with the
+    #! non-optimizing compiler, using its definition. Otherwise,
+    #! if the compiler error is not ignorable, use a dummy
+    #! definition from 'not-compiled-def' which throws an error.
+    2dup ignore-error?
+    [ drop f over def>> ]
+    [ 2dup not-compiled-def ] if
+    [ swap compiler-error ] [ deoptimize-with ] bi-curry* bi ;
 
 : frontend ( word -- nodes )
-    dup contains-breakpoints? [ (fail) ] [
+    #! If the word contains breakpoints, don't optimize it, since
-        [ build-tree-from-word ] [ fail ] recover optimize-tree
+    #! the walker does not support this.
+    dup contains-breakpoints? [ dup def>> deoptimize-with ] [
+        [ build-tree ] [ deoptimize ] recover optimize-tree
     ] if ;
 
+: compile-dependency ( word -- )
+    #! If a word calls an unoptimized word, try to compile the callee.
+    dup optimized>> [ drop ] [ queue-compile ] if ;
+
 ! Only switch this off for debugging.
 SYMBOL: compile-dependencies?
 
 t compile-dependencies? set-global
 
+: compile-dependencies ( asm -- )
+    compile-dependencies? get
+    [ calls>> [ compile-dependency ] each ] [ drop ] if ;
+
 : save-asm ( asm -- )
     [ [ code>> ] [ label>> ] bi compiled get set-at ]
-    [ compile-dependencies? get [ calls>> [ maybe-compile ] each ] [ drop ] if ]
+    [ compile-dependencies ]
     bi ;
 
 : backend ( nodes word -- )
@@ -99,19 +121,9 @@ t compile-dependencies? set-global
         save-asm
     ] each ;
 
-: finish ( word -- )
+: compile-word ( word -- )
-    [ +optimized+ save-compiled-status ]
+    #! We return early if the word has breakpoints or if it
-    [ compiled-unxref ]
+    #! failed to infer.
-    [
-        dup crossref?
-        [
-            dependencies get
-            generic-dependencies get
-            compiled-xref
-        ] [ drop ] if
-    ] tri ;
-
-: (compile) ( word -- )
     '[
         _ {
             [ start ]
@@ -122,10 +134,10 @@ t compile-dependencies? set-global
     ] with-return ;
 
 : compile-loop ( deque -- )
-    [ (compile) yield-hook get call( -- ) ] slurp-deque ;
+    [ compile-word yield-hook get call( -- ) ] slurp-deque ;
 
 : decompile ( word -- )
-    f 2array 1array modify-code-heap ;
+    dup def>> 2array 1array modify-code-heap ;
 
 : compile-call ( quot -- )
     [ dup infer define-temp ] with-compilation-unit execute ;
@@ -150,4 +162,4 @@ M: optimizing-compiler recompile ( words -- alist )
     f compiler-impl set-global ;
 
 : recompile-all ( -- )
-    forget-errors all-words compile ;
+    all-words compile ;

basis/compiler/errors/errors.factor

@@ -52,3 +52,5 @@ T{ error-type
 : compiler-error ( error word -- )
     compiler-errors get-global pick
     [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
+
+ERROR: not-compiled word error ;

basis/compiler/tests/insane.factor

@@ -1,5 +0,0 @@
-IN: compiler.tests
-USING: words kernel stack-checker alien.strings tools.test
-compiler.units ;
-
-[ ] [ [ \ if redefined ] with-compilation-unit [ string>alien ] infer. ] unit-test

basis/compiler/tests/optimizer.factor

@@ -261,7 +261,7 @@ USE: binary-search.private
 : lift-loop-tail-test-2 ( -- a b c )
     10 [ ] lift-loop-tail-test-1 1 2 3 ;
 
-\ lift-loop-tail-test-2 must-infer
+\ lift-loop-tail-test-2 def>> must-infer
 
 [ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
 
@@ -302,8 +302,8 @@ HINTS: recursive-inline-hang-3 array ;
 
 : member-test ( obj -- ? ) { + - * / /i } member? ;
 
-\ member-test must-infer
+\ member-test def>> must-infer
-[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
+[ ] [ \ member-test build-tree optimize-tree drop ] unit-test
 [ t ] [ \ + member-test ] unit-test
 [ f ] [ \ append member-test ] unit-test
 
@@ -325,7 +325,7 @@ PREDICATE: list < improper-list
     dup "a" get { array-capacity } declare >=
     [ dup "b" get { array-capacity } declare >= [ 3 ] [ 4 ] if ] [ 5 ] if ;
 
-\ interval-inference-bug must-infer
+[ t ] [ \ interval-inference-bug optimized>> ] unit-test
 
 [ ] [ 1 "a" set 2 "b" set ] unit-test
 [ 2 3 ] [ 2 interval-inference-bug ] unit-test

basis/compiler/tests/redefine0.factor

@@ -0,0 +1,107 @@
+IN: compiler.tests.redefine0
+USING: tools.test eval compiler compiler.errors compiler.units definitions kernel math
+namespaces macros assocs ;
+
+! Test ripple-up behavior
+: test-1 ( -- a ) 3 ;
+: test-2 ( -- ) test-1 ;
+
+[ test-2 ] [ not-compiled? ] must-fail-with
+
+[ ] [ "IN: compiler.tests.redefine0 : test-1 ( -- ) ;" eval( -- ) ] unit-test
+
+{ 0 0 } [ test-1 ] must-infer-as
+
+[ ] [ test-2 ] unit-test
+
+[ ] [
+    [
+        \ test-1 forget
+        \ test-2 forget
+    ] with-compilation-unit
+] unit-test
+
+: test-3 ( a -- ) drop ;
+: test-4 ( -- ) [ 1 2 3 ] test-3 ;
+
+[ ] [ test-4 ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 USE: kernel : test-3 ( a -- ) call ; inline" eval( -- ) ] unit-test
+
+[ test-4 ] [ not-compiled? ] must-fail-with
+
+[ ] [
+    [
+        \ test-3 forget
+        \ test-4 forget
+    ] with-compilation-unit
+] unit-test
+
+: test-5 ( a -- quot ) ;
+: test-6 ( a -- b ) test-5 ;
+
+[ 31337 ] [ 31337 test-6 ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 USING: macros kernel ; MACRO: test-5 ( a -- quot ) drop [ ] ;" eval( -- ) ] unit-test
+
+[ 31337 test-6 ] [ not-compiled? ] must-fail-with
+
+[ ] [
+    [
+        \ test-5 forget
+        \ test-6 forget
+    ] with-compilation-unit
+] unit-test
+
+GENERIC: test-7 ( a -- b )
+
+M: integer test-7 + ;
+
+: test-8 ( a -- b ) 255 bitand test-7 ;
+
+[ 1 test-7 ] [ not-compiled? ] must-fail-with
+[ 1 test-8 ] [ not-compiled? ] must-fail-with
+
+[ ] [ "IN: compiler.tests.redefine0 USING: macros math kernel ; GENERIC: test-7 ( x y -- z ) : test-8 ( a b -- c ) 255 bitand test-7 ;" eval( -- ) ] unit-test
+
+[ 4 ] [ 1 3 test-7 ] unit-test
+[ 4 ] [ 1 259 test-8 ] unit-test
+
+[ ] [
+    [
+        \ test-7 forget
+        \ test-8 forget
+    ] with-compilation-unit
+] unit-test
+
+! Indirect dependency on an unoptimized word
+: test-9 ( -- ) ;
+<< SYMBOL: quot
+[ test-9 ] quot set-global >>
+MACRO: test-10 ( -- quot ) quot get ;
+: test-11 ( -- ) test-10 ;
+
+[ ] [ test-11 ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) 1 ;" eval( -- ) ] unit-test
+
+! test-11 should get recompiled now
+
+[ test-11 ] [ not-compiled? ] must-fail-with
+
+[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- a ) 1 ;" eval( -- ) ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine0 : test-9 ( -- ) ;" eval( -- ) ] unit-test
+
+[ ] [ test-11 ] unit-test
+
+quot global delete-at
+
+[ ] [
+    [
+        \ test-9 forget
+        \ test-10 forget
+        \ test-11 forget
+        \ quot forget
+    ] with-compilation-unit
+] unit-test

basis/compiler/tests/redefine1.factor

@@ -36,41 +36,3 @@ M: integer method-redefine-generic-2 3 + ;
         fixnum string [ \ method-redefine-generic-2 method forget ] bi@
     ] with-compilation-unit
 ] unit-test
-
-! Test ripple-up behavior
-: hey ( -- ) ;
-: there ( -- ) hey ;
-
-[ t ] [ \ hey optimized>> ] unit-test
-[ t ] [ \ there optimized>> ] unit-test
-[ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval( -- ) ] unit-test
-[ f ] [ \ hey optimized>> ] unit-test
-[ f ] [ \ there optimized>> ] unit-test
-[ ] [ "IN: compiler.tests : hey ( -- ) ;" eval( -- ) ] unit-test
-[ t ] [ \ there optimized>> ] unit-test
-
-: good ( -- ) ;
-: bad ( -- ) good ;
-: ugly ( -- ) bad ;
-
-[ 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 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 optimized>> ] unit-test
-[ t ] [ \ bad optimized>> ] unit-test
-[ t ] [ \ ugly optimized>> ] unit-test
-
-[ f ] [ \ good compiled-usage assoc-empty? ] unit-test

basis/compiler/tests/redefine16.factor

@@ -0,0 +1,11 @@
+IN: compiler.tests.redefine16
+USING: eval tools.test definitions words compiler.units
+quotations stack-checker ;
+
+[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test
+
+[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- )" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine16 USING: strings math arrays prettyprint ; M: string blah 1 + 3array . ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine16 GENERIC# blah 2 ( foo bar baz -- x )" eval( -- ) ] unit-test
+
+[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test

basis/compiler/tests/simple.factor

@@ -3,8 +3,6 @@ sequences.private math.private math combinators strings alien
 arrays memory vocabs parser eval ;
 IN: compiler.tests
 
-\ (compile) must-infer
-
 ! Test empty word
 [ ] [ [ ] compile-call ] unit-test
 

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

@@ -3,12 +3,11 @@ compiler.tree stack-checker.errors ;
 IN: compiler.tree.builder
 
 HELP: build-tree
-{ $values { "quot" quotation } { "nodes" "a sequence of nodes" } }
+{ $values { "quot/word" { $or quotation word } } { "nodes" "a sequence of nodes" } }
 { $description "Attempts to construct tree SSA IR from a quotation." }
 { $notes "This is the first stage of the compiler." }
 { $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;
 
-HELP: build-tree-with
+HELP: build-sub-tree
-{ $values { "in-stack" "a sequence of values" } { "quot" quotation } { "nodes" "a sequence of nodes" } { "out-stack" "a sequence of values" } }
+{ $values { "#call" #call } { "quot/word" { $or quotation word } } { "nodes" { $maybe "a sequence of nodes" } } }
-{ $description "Attempts to construct tree SSA IR from a quotation, starting with an initial data stack of values, and outputting stack resulting at the end." }
+{ $description "Attempts to construct tree SSA IR from a quotation, starting with an initial data stack of values from the call site. Outputs " { $link f } " if stack effect inference fails." } ;
-{ $errors "Throws an " { $link inference-error } " if stack effect inference fails." } ;

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

@@ -1,11 +1,27 @@
 IN: compiler.tree.builder.tests
 USING: compiler.tree.builder tools.test sequences kernel
-compiler.tree ;
+compiler.tree stack-checker stack-checker.errors ;
-
-\ build-tree must-infer
-\ build-tree-with must-infer
-\ build-tree-from-word must-infer
 
 : inline-recursive ( -- ) inline-recursive ; inline recursive
 
-[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test
+[ t ] [ \ inline-recursive build-tree [ #recursive? ] any? ] unit-test
+
+: bad-recursion-1 ( a -- b )
+    dup [ drop bad-recursion-1 5 ] [ ] if ;
+
+[ \ bad-recursion-1 build-tree ] [ inference-error? ] must-fail-with
+
+FORGET: bad-recursion-1
+
+: bad-recursion-2 ( obj -- obj )
+    dup [ dup first swap second bad-recursion-2 ] [ ] if ;
+
+[ \ bad-recursion-2 build-tree ] [ inference-error? ] must-fail-with
+
+FORGET: bad-recursion-2
+
+: bad-bin ( a b -- ) 5 [ 5 bad-bin bad-bin 5 ] [ 2drop ] if ;
+
+[ \ bad-bin build-tree ] [ inference-error? ] must-fail-with
+
+FORGET: bad-bin

basis/compiler/tree/builder/builder.factor

@@ -1,7 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: fry accessors quotations kernel sequences namespaces
+USING: fry locals accessors quotations kernel sequences namespaces
-assocs words arrays vectors hints combinators compiler.tree
+assocs words arrays vectors hints combinators continuations
+effects compiler.tree
 stack-checker
 stack-checker.state
 stack-checker.errors
@@ -10,54 +11,60 @@ stack-checker.backend
 stack-checker.recursive-state ;
 IN: compiler.tree.builder
 
-: with-tree-builder ( quot -- nodes )
+<PRIVATE
-    '[ V{ } clone stack-visitor set @ ]
-    with-infer nip ; inline
 
-: build-tree ( quot -- nodes )
+GENERIC: (build-tree) ( quot -- )
-    #! Not safe to call from inference transforms.
-    [ f initial-recursive-state infer-quot ] with-tree-builder ;
 
-: build-tree-with ( in-stack quot -- nodes out-stack )
+M: callable (build-tree) f initial-recursive-state infer-quot ;
-    #! Not safe to call from inference transforms.
-    [
-        [ >vector \ meta-d set ]
-        [ f initial-recursive-state infer-quot ] bi*
-    ] with-tree-builder
-    unclip-last in-d>> ;
-
-: build-sub-tree ( #call quot -- nodes )
-    [ [ out-d>> ] [ in-d>> ] bi ] dip build-tree-with
-    over ends-with-terminate?
-    [ drop swap [ f swap #push ] map append ]
-    [ rot #copy suffix ]
-    if ;
-
-: (build-tree-from-word) ( word -- )
-    dup initial-recursive-state recursive-state set
-    dup [ "inline" word-prop ] [ "recursive" word-prop ] bi and
-    [ 1quotation ] [ specialized-def ] if
-    infer-quot-here ;
-
-: check-cannot-infer ( word -- )
-    dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ;
-
-TUPLE: do-not-compile word ;
 
 : check-no-compile ( word -- )
-    dup "no-compile" word-prop [ do-not-compile inference-warning ] [ drop ] if ;
+    dup "no-compile" word-prop [ do-not-compile ] [ drop ] if ;
 
-: build-tree-from-word ( word -- nodes )
+: check-effect ( word effect -- )
+    swap required-stack-effect 2dup effect<=
+    [ 2drop ] [ effect-error ] if ;
+
+: inline-recursive? ( word -- ? )
+    [ "inline" word-prop ] [ "recursive" word-prop ] bi and ;
+
+: word-body ( word -- quot )
+    dup inline-recursive? [ 1quotation ] [ specialized-def ] if ;
+
+M: word (build-tree)
+    {
+        [ initial-recursive-state recursive-state set ]
+        [ check-no-compile ]
+        [ word-body infer-quot-here ]
+        [ current-effect check-effect ]
+    } cleave ;
+
+: build-tree-with ( in-stack word/quot -- nodes )
     [
-        [
+        V{ } clone stack-visitor set
-            {
+        [ [ >vector \ meta-d set ] [ length d-in set ] bi ]
-                [ check-cannot-infer ]
+        [ (build-tree) ]
-                [ check-no-compile ]
+        bi*
-                [ (build-tree-from-word) ]
+    ] with-infer nip ;
-                [ finish-word ]
+
-            } cleave
+PRIVATE>
-        ] maybe-cannot-infer
+
-    ] with-tree-builder ;
+: build-tree ( word/quot -- nodes )
+    [ f ] dip build-tree-with ;
+
+:: build-sub-tree ( #call word/quot -- nodes/f )
+    #! We don't want methods on mixins to have a declaration for that mixin.
+    #! This slows down compiler.tree.propagation.inlining since then every
+    #! inlined usage of a method has an inline-dependency on the mixin, and
+    #! not the more specific type at the call site.
+    specialize-method? off
+    [
+        #call in-d>> word/quot build-tree-with unclip-last in-d>> :> in-d
+        {
+            { [ dup not ] [ ] }
+            { [ dup ends-with-terminate? ] [ #call out-d>> [ f swap #push ] map append ] }
+            [ in-d #call out-d>> #copy suffix ]
+        } cond
+    ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ;
 
 : contains-breakpoints? ( word -- ? )
     def>> [ word? ] filter [ "break?" word-prop ] any? ;

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

@@ -1,4 +1,4 @@
 IN: compiler.tree.checker.tests
 USING: compiler.tree.checker tools.test ;
 
-\ check-nodes must-infer
+

basis/compiler/tree/checker/checker.factor

@@ -144,13 +144,15 @@ M: #terminate check-stack-flow*
 
 SYMBOL: branch-out
 
-: check-branch ( nodes -- stack )
+: check-branch ( nodes -- datastack )
     [
         datastack [ clone ] change
-        V{ } clone retainstack set
+        retainstack [ clone ] change
-        (check-stack-flow)
+        retainstack get clone [ (check-stack-flow) ] dip
-        terminated? get [ assert-retainstack-empty ] unless
+        terminated? get [ drop f ] [
-        terminated? get f datastack get ?
+            retainstack get assert=
+            datastack get
+        ] if
     ] with-scope ;
 
 M: #branch check-stack-flow*

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

@@ -9,8 +9,6 @@ accessors combinators io prettyprint words sequences.deep
 sequences.private arrays classes kernel.private ;
 IN: compiler.tree.dead-code.tests
 
-\ remove-dead-code must-infer
-
 : count-live-values ( quot -- n )
     build-tree
     analyze-recursive

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

@@ -1,8 +1,5 @@
 IN: compiler.tree.debugger.tests
 USING: compiler.tree.debugger tools.test sorting sequences io math.order ;
 
-\ optimized. must-infer
-\ optimizer-report. must-infer
-
 [ [ <=> ] sort ] optimized.
 [ <reversed> [ print ] each ] optimizer-report.

basis/compiler/tree/debugger/debugger.factor

@@ -142,8 +142,7 @@ SYMBOL: node-count
 
 : make-report ( word/quot -- assoc )
     [
-        dup word? [ build-tree-from-word ] [ build-tree ] if
+        build-tree optimize-tree
-        optimize-tree
 
         H{ } clone words-called set
         H{ } clone generics-called set

basis/compiler/tree/def-use/def-use-tests.factor

@@ -7,8 +7,6 @@ compiler.tree.def-use arrays kernel.private sorting math.order
 binary-search compiler.tree.checker ;
 IN: compiler.tree.def-use.tests
 
-\ compute-def-use must-infer
-
 [ t ] [
     [ 1 2 3 ] build-tree compute-def-use drop
     def-use get {

basis/compiler/tree/escape-analysis/escape-analysis-tests.factor

@@ -11,8 +11,6 @@ compiler.tree.propagation.info stack-checker.errors
 compiler.tree.checker
 kernel.private ;
 
-\ escape-analysis must-infer
-
 GENERIC: count-unboxed-allocations* ( m node -- n )
 
 : (count-unboxed-allocations) ( m node -- n )

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

@@ -6,9 +6,6 @@ compiler.tree.normalization.renaming
 compiler.tree compiler.tree.checker
 sequences accessors tools.test kernel math ;
 
-\ count-introductions must-infer
-\ normalize must-infer
-
 [ 3 ] [ [ 3drop 1 2 3 ] build-tree count-introductions ] unit-test
 
 [ 4 ] [ [ 3drop 1 2 3 3drop drop ] build-tree count-introductions ] unit-test

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

@@ -1,4 +1,4 @@
 USING: compiler.tree.optimizer tools.test ;
 IN: compiler.tree.optimizer.tests
 
-\ optimize-tree must-infer
+

basis/compiler/tree/optimizer/optimizer.factor

@@ -18,11 +18,18 @@ IN: compiler.tree.optimizer
 
 SYMBOL: check-optimizer?
 
+: ?check ( nodes -- nodes' )
+    check-optimizer? get [
+        compute-def-use
+        dup check-nodes
+    ] when ;
+
 : optimize-tree ( nodes -- nodes' )
     analyze-recursive
     normalize
     propagate
     cleanup
+    ?check
     dup run-escape-analysis? [
         escape-analysis
         unbox-tuples
@@ -30,10 +37,7 @@ SYMBOL: check-optimizer?
     apply-identities
     compute-def-use
     remove-dead-code
-    check-optimizer? get [
+    ?check
-        compute-def-use
-        dup check-nodes
-    ] when
     compute-def-use
     optimize-modular-arithmetic
     finalize ;

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

@@ -3,7 +3,8 @@
 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 combinators.smart
+words namespaces continuations classes fry combinators.smart hints
+locals
 compiler.tree
 compiler.tree.builder
 compiler.tree.recursive
@@ -27,24 +28,34 @@ SYMBOL: node-count
 SYMBOL: inlining-count
 
 ! Splicing nodes
-GENERIC: splicing-nodes ( #call word/quot/f -- nodes )
+: splicing-call ( #call word -- nodes )
-
-M: word splicing-nodes
     [ [ in-d>> ] [ out-d>> ] bi ] dip #call 1array ;
 
-M: callable splicing-nodes
+: splicing-body ( #call quot/word -- nodes/f )
-    build-sub-tree analyze-recursive normalize ;
+    build-sub-tree dup [ analyze-recursive normalize ] when ;
 
 ! Dispatch elimination
+: undo-inlining ( #call -- ? )
+    f >>method f >>body f >>class drop f ;
+
+: propagate-body ( #call -- ? )
+    body>> (propagate) t ;
+
+GENERIC: splicing-nodes ( #call word/quot -- nodes/f )
+
+M: word splicing-nodes splicing-call ;
+
+M: callable splicing-nodes splicing-body ;
+
 : eliminate-dispatch ( #call class/f word/quot/f -- ? )
     dup [
         [ >>class ] dip
-        over method>> over = [ drop ] [
+        over method>> over = [ drop propagate-body ] [
-            2dup splicing-nodes
+            2dup splicing-nodes dup [
-            [ >>method ] [ >>body ] bi*
+                [ >>method ] [ >>body ] bi* propagate-body
+            ] [ 2drop undo-inlining ] if
         ] if
-        body>> (propagate) t
+    ] [ 2drop undo-inlining ] if ;
-    ] [ 2drop f >>method f >>body f >>class drop f ] if ;
 
 : inlining-standard-method ( #call word -- class/f method/f )
     dup "methods" word-prop assoc-empty? [ 2drop f f ] [
@@ -136,12 +147,10 @@ DEFER: (flat-length)
     [
         [ classes-known? 2 0 ? ]
         [
-            {
+            [ body-length-bias ]
-                [ body-length-bias ]
+            [ "specializer" word-prop 1 0 ? ]
-                [ "default" word-prop -4 0 ? ]
+            [ method-body? 1 0 ? ]
-                [ "specializer" word-prop 1 0 ? ]
+            tri
-                [ method-body? 1 0 ? ]
-            } cleave
             node-count-bias
             loop-nesting get 0 or 2 *
         ] bi*
@@ -161,19 +170,17 @@ SYMBOL: history
     [ history [ swap suffix ] change ]
     bi ;
 
-: inline-word-def ( #call word quot -- ? )
+:: inline-word ( #call word -- ? )
-    over history get memq? [ 3drop f ] [
+    word history get memq? [ f ] [
-        [
+        #call word splicing-body [
-            [ remember-inlining ] dip
+            [
-            [ drop ] [ splicing-nodes ] 2bi
+                word remember-inlining
-            [ >>body drop ] [ count-nodes ] [ (propagate) ] tri
+                [ ] [ count-nodes ] [ (propagate) ] tri
-        ] with-scope node-count +@
+            ] with-scope
-        t
+            [ #call (>>body) ] [ node-count +@ ] bi* t
+        ] [ f ] if*
     ] if ;
 
-: inline-word ( #call word -- ? )
-    dup def>> inline-word-def ;
-
 : inline-method-body ( #call word -- ? )
     2dup should-inline? [ inline-word ] [ 2drop f ] if ;
 
@@ -181,7 +188,9 @@ SYMBOL: history
     { curry compose } memq? ;
 
 : never-inline-word? ( word -- ? )
-    [ deferred? ] [ { call execute } memq? ] bi or ;
+    [ deferred? ]
+    [ "default" word-prop ]
+    [ { call execute } memq? ] tri or or ;
 
 : custom-inlining? ( word -- ? )
     "custom-inlining" word-prop ;
@@ -191,10 +200,6 @@ SYMBOL: history
     call( #call -- word/quot/f )
     object swap eliminate-dispatch ;
 
-: inline-instance-check ( #call word -- ? )
-    over in-d>> second value-info literal>> dup class?
-    [ "predicate" word-prop '[ drop @ ] inline-word-def ] [ 3drop f ] if ;
-
 : (do-inlining) ( #call word -- ? )
     #! If the generic was defined in an outer compilation unit,
     #! then it doesn't have a definition yet; the definition
@@ -206,7 +211,6 @@ SYMBOL: history
     #! discouraged, but it should still work.)
     {
         { [ dup never-inline-word? ] [ 2drop f ] }
-        { [ dup \ instance? eq? ] [ inline-instance-check ] }
         { [ dup always-inline-word? ] [ inline-word ] }
         { [ dup standard-generic? ] [ inline-standard-method ] }
         { [ dup math-generic? ] [ inline-math-method ] }

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -341,6 +341,11 @@ generic-comparison-ops [
     ] [ 2drop object-info ] if
 ] "outputs" set-word-prop
 
+\ instance? [
+    in-d>> second value-info literal>> dup class?
+    [ "predicate" word-prop '[ drop @ ] ] [ drop f ] if
+] "custom-inlining" set-word-prop
+
 \ equal? [
     ! If first input has a known type and second input is an
     ! object, we convert this to [ swap equal? ].

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

@@ -12,8 +12,6 @@ specialized-arrays.double system sorting math.libm
 math.intervals ;
 IN: compiler.tree.propagation.tests
 
-\ propagate must-infer
-
 [ V{ } ] [ [ ] final-classes ] unit-test
 
 [ V{ fixnum } ] [ [ 1 ] final-classes ] unit-test

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

@@ -10,8 +10,6 @@ compiler.tree.combinators ;
 [ { f t t t } ] [ t { f f t t } (tail-calls) ] unit-test
 [ { f f f t } ] [ t { f f t f } (tail-calls) ] unit-test
 
-\ analyze-recursive must-infer
-
 : label-is-loop? ( nodes word -- ? )
     [
         {
@@ -21,8 +19,6 @@ compiler.tree.combinators ;
         } 2&&
     ] curry contains-node? ;
 
-\ label-is-loop? must-infer
-
 : label-is-not-loop? ( nodes word -- ? )
     [
         {
@@ -32,8 +28,6 @@ compiler.tree.combinators ;
         } 2&&
     ] curry contains-node? ;
 
-\ label-is-not-loop? must-infer
-
 : loop-test-1 ( a -- )
     dup [ 1+ loop-test-1 ] [ drop ] if ; inline recursive
                           

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

@@ -8,8 +8,6 @@ compiler.tree.def-use kernel accessors sequences math
 math.private sorting math.order binary-search sequences.private
 slots.private ;
 
-\ unbox-tuples must-infer
-
 : test-unboxing ( quot -- )
     build-tree
     analyze-recursive

basis/cpu/ppc/assembler/assembler-tests.factor

@@ -114,5 +114,3 @@ make vocabs sequences ;
 { HEX: fc411800 } [ 1 2 3 FCMPU ] test-assembler
 { HEX: fc411840 } [ 1 2 3 FCMPO ] test-assembler
 { HEX: 3c601234 HEX: 60635678 } [ HEX: 12345678 3 LOAD ] test-assembler
-
-"cpu.ppc.assembler" words [ must-infer ] each

basis/db/pools/pools-tests.factor

@@ -2,8 +2,6 @@ IN: db.pools.tests
 USING: db.pools tools.test continuations io.files io.files.temp
 io.directories namespaces accessors kernel math destructors ;
 
-\ <db-pool> must-infer
-
 { 1 0 } [ [ ] with-db-pool ] must-infer-as
 
 { 1 0 } [ [ ] with-pooled-db ] must-infer-as

basis/db/tester/tester.factor

@@ -3,7 +3,7 @@
 USING: concurrency.combinators db.pools db.sqlite db.tuples
 db.types kernel math random threads tools.test db sequences
 io prettyprint db.postgresql db.sqlite accessors io.files.temp
-namespaces fry system ;
+namespaces fry system math.parser ;
 IN: db.tester
 
 : postgresql-test-db ( -- postgresql-db )
@@ -56,6 +56,10 @@ test-2 "TEST2" {
    { "z" "Z" { VARCHAR 256 } +not-null+ }
 } define-persistent
 
+: test-1-tuple ( -- tuple )
+    f 100 random 100 random 100 random [ number>string ] tri@
+    test-1 boa ;
+
 : db-tester ( test-db -- )
     [
         [
@@ -67,8 +71,7 @@ test-2 "TEST2" {
             drop
             10 [
                 dup [
-                    f 100 random 100 random 100 random test-1 boa
+                    test-1-tuple insert-tuple yield
-                    insert-tuple yield
                 ] with-db
             ] times
         ] with parallel-each
@@ -84,8 +87,7 @@ test-2 "TEST2" {
         <db-pool> [
             10 [
                 10 [
-                    f 100 random 100 random 100 random test-1 boa
+                    test-1-tuple insert-tuple yield
-                    insert-tuple yield
                 ] times
             ] parallel-each
         ] with-pooled-db

basis/db/tuples/tuples-tests.factor

@@ -592,17 +592,6 @@ string-encoding-test "STRING_ENCODING_TEST" {
 [ test-string-encoding ] test-sqlite
 [ test-string-encoding ] test-postgresql
 
-! Don't comment these out. These words must infer
-\ bind-tuple must-infer
-\ insert-tuple must-infer
-\ update-tuple must-infer
-\ delete-tuples must-infer
-\ select-tuple must-infer
-\ define-persistent must-infer
-\ ensure-table must-infer
-\ create-table must-infer
-\ drop-table must-infer
-
 : test-queries ( -- )
     [ ] [ exam ensure-table ] unit-test
     [ ] [ 1000 [ random-exam insert-tuple ] times ] unit-test

basis/debugger/debugger-tests.factor

@@ -2,3 +2,6 @@ IN: debugger.tests
 USING: debugger kernel continuations tools.test ;
 
 [ ] [ [ drop ] [ error. ] recover ] unit-test
+
+[ f ] [ { } vm-error? ] unit-test
+[ f ] [ { "A" "B" } vm-error? ] unit-test

basis/debugger/debugger.factor

@@ -88,8 +88,7 @@ M: string error. print ;
 : divide-by-zero-error. ( obj -- )
     "Division by zero" print drop ;
 
-: signal-error. ( obj -- )
+HOOK: signal-error. os ( obj -- )
-    "Operating system signal " write third . ;
 
 : array-size-error. ( obj -- )
     "Invalid array size: " write dup third .
@@ -127,14 +126,14 @@ M: string error. print ;
 : primitive-error. ( error -- ) 
     "Unimplemented primitive" print drop ;
 
-PREDICATE: kernel-error < array
+PREDICATE: vm-error < array
     {
         { [ dup empty? ] [ drop f ] }
         { [ dup first "kernel-error" = not ] [ drop f ] }
         [ second 0 15 between? ]
     } cond ;
 
-: kernel-errors ( error -- n errors )
+: vm-errors ( error -- n errors )
     second {
         { 0  [ expired-error.          ] }
         { 1  [ io-error.               ] }
@@ -154,9 +153,11 @@ PREDICATE: kernel-error < array
         { 15 [ memory-error.           ] }
     } ; inline
 
-M: kernel-error error. dup kernel-errors case ;
+M: vm-error summary drop "VM error" ;
 
-M: kernel-error error-help kernel-errors at first ;
+M: vm-error error. dup vm-errors case ;
+
+M: vm-error error-help vm-errors at first ;
 
 M: no-method summary
     drop "No suitable method" ;
@@ -306,4 +307,9 @@ M: check-mixin-class summary drop "Not a mixin class" ;
 
 M: not-found-in-roots summary drop "Cannot resolve vocab: path" ;
 
-M: wrong-values summary drop "Quotation called with wrong stack effect" ;
+M: wrong-values summary drop "Quotation called with wrong stack effect" ;
+
+{
+    { [ os windows? ] [ "debugger.windows" require ] }
+    { [ os unix? ] [ "debugger.unix" require ] }
+} cond

basis/debugger/unix/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/debugger/unix/unix.factor

@@ -0,0 +1,23 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: debugger io kernel math prettyprint sequences system ;
+IN: debugger.unix
+
+CONSTANT: signal-names
+{
+    "SIGHUP" "SIGINT" "SIGQUIT" "SIGILL" "SIGTRAP" "SIGABRT"
+    "SIGEMT" "SIGFPE" "SIGKILL" "SIGBUS" "SIGSEGV" "SIGSYS"
+    "SIGPIPE" "SIGALRM" "SIGTERM" "SIGURG" "SIGSTOP" "SIGTSIP"
+    "SIGCONT" "SIGCHLD" "SIGTTIN" "SIGTTOU" "SIGIO" "SIGXCPU"
+    "SIGXFSZ" "SIGVTALRM" "SIGPROF" "SIGWINCH" "SIGINFO"
+    "SIGUSR1" "SIGUSR2"
+}
+
+: signal-name ( n -- str/f ) 1- signal-names ?nth ;
+
+: signal-name. ( n -- )
+    signal-name [ " (" ")" surround write ] when* ;
+
+M: unix signal-error. ( obj -- )
+    "Unix signal #" write
+    third [ pprint ] [ signal-name. ] bi nl ;

basis/debugger/windows/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/debugger/windows/windows.factor

@@ -0,0 +1,6 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: debugger io prettyprint sequences system ;
+IN: debugger.windows
+
+M: windows signal-error. "Windows exception #" write third .h ;

basis/editors/emacs/authors.txt

@@ -1 +1,2 @@
 Eduardo Cavazos
+Doug Coleman

basis/editors/emacs/emacs-docs.factor

@@ -2,10 +2,23 @@ USING: help help.syntax help.markup ;
 IN: editors.emacs
 
 ARTICLE: "editors.emacs" "Integration with Emacs"
-"Put this in your " { $snippet ".emacs" } " file:"
+"Full Emacs integration with Factor requires the use of two executable files -- " { $snippet "emacs" } " and " { $snippet "emacsclient" } ", which act as a client/server pair. To start the server, run the " { $snippet "emacs" } " binary and run " { $snippet "M-x server-start" } " or start " { $snippet "emacs" } " with the following line in your " { $snippet ".emacs" } " file:"
 { $code "(server-start)" }
+"On Windows, if you install Emacs to " { $snippet "Program Files" } " or " { $snippet "Program Files(x86)" } ", Factor will automatically detect the path to " { $snippet "emacsclient.exe" } ". On Unix systems, make sure that " { $snippet "emacsclient" } " is in your path. To set the path manually, use the following snippet:"
+{ $code "USE: edtiors.emacs"
+        "\"/my/crazy/bin/emacsclient\" emacsclient-path set-global"
+}
+
 "If you would like a new window to open when you ask Factor to edit an object, put this in your " { $snippet ".emacs" } " file:"
 { $code "(setq server-window 'switch-to-buffer-other-frame)" }
-{ $see-also "editor" } ;
 
-ABOUT: "editors.emacs"
+"To quickly scaffold a " { $snippet ".emacs" } " file, run the following code:"
+{ $code "USE: tools.scaffold"
+    "scaffold-emacs"
+}
+
+{ $see-also "editor" }
+
+;
+
+ABOUT: "editors.emacs"

basis/editors/emacs/emacs.factor

@@ -11,7 +11,10 @@ M: object default-emacsclient ( -- path ) "emacsclient" ;
 
 : emacsclient ( file line -- )
     [
-        { [ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
+        {
+            [ emacsclient-path get-global ]
+            [ default-emacsclient dup emacsclient-path set-global ]
+        } 0|| ,
         "--no-wait" ,
         number>string "+" prepend ,
         ,

basis/editors/emacs/windows/authors.txt

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

basis/editors/emacs/windows/tags.txt

@@ -0,0 +1 @@
+unportable

basis/functors/functors-tests.factor

@@ -43,8 +43,6 @@ WHERE
 
 >>
 
-\ sqsq must-infer
-
 [ 16 ] [ 2 sqsq ] unit-test
 
 <<

basis/furnace/auth/auth-tests.factor

@@ -1,6 +1,3 @@
 USING: furnace.auth tools.test ;
 IN: furnace.auth.tests
 
-\ logged-in-username must-infer
-\ <protected> must-infer
-\ new-realm must-infer

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

@@ -1,4 +1,4 @@
 IN: furnace.auth.features.edit-profile.tests
 USING: tools.test furnace.auth.features.edit-profile ;
 
-\ allow-edit-profile must-infer
+

basis/furnace/auth/features/recover-password/recover-password-tests.factor

@@ -1,4 +1,4 @@
 IN: furnace.auth.features.recover-password
 USING: tools.test furnace.auth.features.recover-password ;
 
-\ allow-password-recovery must-infer
+

basis/furnace/auth/features/registration/registration-tests.factor

@@ -1,4 +1,4 @@
 IN: furnace.auth.features.registration.tests
 USING: tools.test furnace.auth.features.registration ;
 
-\ allow-registration must-infer
+

basis/furnace/auth/login/login-tests.factor

@@ -1,4 +1,4 @@
 IN: furnace.auth.login.tests
 USING: tools.test furnace.auth.login ;
 
-\ <login-realm> must-infer
+

basis/furnace/db/db-tests.factor

@@ -1,4 +1,4 @@
 IN: furnace.db.tests
 USING: tools.test furnace.db ;
 
-\ <db-persistence> must-infer
+

basis/help/crossref/crossref-docs.factor

@@ -17,8 +17,3 @@ HELP: xref-article
 { $values { "topic" "an article name or a word" } }
 { $description "Sets the " { $link article-parent } " of each child of this article." }
 $low-level-note ;
-
-HELP: unxref-article
-{ $values { "topic" "an article name or a word" } }
-{ $description "Clears the " { $link article-parent } " of each child of this article." }
-$low-level-note ;

basis/help/crossref/crossref.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays definitions generic assocs math fry
 io kernel namespaces prettyprint prettyprint.sections
@@ -12,9 +12,6 @@ IN: help.crossref
 : article-children ( topic -- seq )
     { $subsection } article-links ;
 
-M: link uses
-    { $subsection $link $see-also } article-links ;
-
 : help-path ( topic -- seq )
     [ article-parent ] follow rest ;
 
@@ -22,10 +19,7 @@ M: link uses
     article-children [ set-article-parent ] with each ;
 
 : xref-article ( topic -- )
-    dup >link xref dup set-article-parents ;
+    dup set-article-parents ;
-
-: unxref-article ( topic -- )
-    >link unxref ;
 
 : prev/next ( obj seq n -- obj' )
     [ [ index dup ] keep ] dip swap

basis/help/handbook/handbook.factor

@@ -13,13 +13,13 @@ ARTICLE: "conventions" "Conventions"
 { $heading "Documentation conventions" }
 "Factor documentation consists of two distinct bodies of text. There is a hierarchy of articles, much like this one, and there is word documentation. Help articles reference word documentation, and vice versa, but not every documented word is referenced from some help article."
 $nl
-"Every article has links to parent articles at the top. These can be persued if the article is too specific."
+"Every article has links to parent articles at the top. Explore these if the article you are reading is too specific."
 $nl
 "Some generic words have " { $strong "Description" } " headings, and others have " { $strong "Contract" } " headings. A distinction is made between words which are not intended to be extended with user-defined methods, and those that are."
 { $heading "Vocabulary naming conventions" }
 "A vocabulary name ending in " { $snippet ".private" } " contains words which are either implementation detail, unsafe, or both. For example, the " { $snippet "sequence.private" } " vocabulary contains words which access sequence elements without bounds checking (" { $link "sequences-unsafe" } ")."
 $nl
-"You should should avoid using internal words from the Factor library unless absolutely necessary. Similarly, your own code can place words in internal vocabularies if you do not want other people to use them unless they have a good reason."
+"You should avoid using internal words from the Factor library unless absolutely necessary. Similarly, your own code can place words in internal vocabularies if you do not want other people to use them unless they have a good reason."
 { $heading "Word naming conventions" }
 "These conventions are not hard and fast, but are usually a good first step in understanding a word's behavior:"
 { $table
@@ -249,6 +249,7 @@ ARTICLE: "handbook-language-reference" "The language"
 { $heading "Abstractions" }
 { $subsection "objects" }
 { $subsection "destructors" }
+{ $subsection "parsing-words" }
 { $subsection "macros" }
 { $subsection "fry" }
 { $heading "Program organization" }

basis/help/help.factor

@@ -156,10 +156,7 @@ help-hook [ [ print-topic ] ] initialize
     error get (:help) ;
 
 : remove-article ( name -- )
-    dup articles get key? [
+    articles get delete-at ;
-        dup unxref-article
-        dup articles get delete-at
-    ] when drop ;
 
 : add-article ( article name -- )
     [ remove-article ] keep
@@ -167,7 +164,6 @@ help-hook [ [ print-topic ] ] initialize
     xref-article ;
 
 : remove-word-help ( word -- )
-    dup word-help [ dup unxref-article ] when
     f "help" set-word-prop ;
 
 : set-word-help ( content word -- )

basis/help/markup/markup-tests.factor

@@ -5,7 +5,7 @@ IN: help.markup.tests
 
 TUPLE: blahblah quux ;
 
-[ "an int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
+[ "int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
 
 [ ] [ \ quux>> print-topic ] unit-test
 [ ] [ \ >>quux print-topic ] unit-test
@@ -26,5 +26,3 @@ TUPLE: blahblah quux ;
 [ "a string, a fixnum, or an integer" ]
 [ [ { $or string fixnum integer } print-element ] with-string-writer ] unit-test
 
-\ print-element must-infer
-\ print-topic must-infer

basis/help/markup/markup.factor

@@ -138,7 +138,7 @@ ALIAS: $slot $snippet
 
 ! Images
 : $image ( element -- )
-    [ [ "" ] dip first image associate format ] ($span) ;
+    [ first write-image ] ($span) ;
 
 : <$image> ( path -- element )
     1array \ $image prefix ;
@@ -251,7 +251,7 @@ M: word ($instance)
     dup name>> a/an write bl ($link) ;
 
 M: string ($instance)
-    dup a/an write bl $snippet ;
+    write ;
 
 M: f ($instance)
     drop { f } $link ;

basis/help/topics/topics-tests.factor

@@ -3,11 +3,6 @@ help.markup help.syntax kernel sequences tools.test words parser
 namespaces assocs source-files eval ;
 IN: help.topics.tests
 
-\ article-name must-infer
-\ article-title must-infer
-\ article-content must-infer
-\ article-parent must-infer
-
 ! Test help cross-referencing
 
 [ ] [ "Test B" { "Hello world." } <article> { "test" "b" } add-article ] unit-test

basis/hints/hints.factor

@@ -2,9 +2,9 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: parser words definitions kernel sequences assocs arrays
 kernel.private fry combinators accessors vectors strings sbufs
-byte-arrays byte-vectors io.binary io.streams.string splitting
+byte-arrays byte-vectors io.binary io.streams.string splitting math
-math math.parser generic generic.standard generic.standard.engines classes
+math.parser generic generic.standard generic.standard.engines classes
-hashtables ;
+hashtables namespaces ;
 IN: hints
 
 GENERIC: specializer-predicate ( spec -- quot )
@@ -37,13 +37,18 @@ M: object specializer-declaration class ;
 : specialize-quot ( quot specializer -- quot' )
     specializer-cases alist>quot ;
 
-: method-declaration ( method -- quot )
+! compiler.tree.propagation.inlining sets this to f
-    [ "method-generic" word-prop dispatch# object <array> ]
+SYMBOL: specialize-method?
-    [ "method-class" word-prop ]
+
-    bi prefix ;
+t specialize-method? set-global
 
 : specialize-method ( quot method -- quot' )
-    [ method-declaration '[ _ declare ] prepend ]
+    [
+        specialize-method? get [
+            [ "method-class" word-prop ] [ "method-generic" word-prop ] bi
+            method-declaration prepend
+        ] [ drop ] if
+    ]
     [ "method-generic" word-prop "specializer" word-prop ] bi
     [ specialize-quot ] when* ;
 
@@ -65,7 +70,7 @@ M: object specializer-declaration class ;
 
 SYNTAX: HINTS:
     scan-object
-    [ redefined ]
+    [ changed-definition ]
     [ parse-definition "specializer" set-word-prop ] bi ;
 
 ! Default specializers

basis/html/components/components-tests.factor

@@ -4,8 +4,6 @@ io.streams.null accessors inspector html.streams
 html.components html.forms namespaces
 xml.writer ;
 
-\ render must-infer
-
 [ ] [ begin-form ] unit-test
 
 [ ] [ 3 "hi" set-value ] unit-test

basis/http/client/client-tests.factor

@@ -1,8 +1,6 @@
 USING: http.client http.client.private http tools.test
 namespaces urls ;
 
-\ download must-infer
-
 [ "localhost" f ] [ "localhost" parse-host ] unit-test
 [ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
 

basis/http/server/dispatchers/dispatchers-tests.factor

@@ -3,8 +3,6 @@ tools.test kernel namespaces accessors io http math sequences
 assocs arrays classes words urls ;
 IN: http.server.dispatchers.tests
 
-\ find-responder must-infer
-
 TUPLE: mock-responder path ;
 
 C: <mock-responder> mock-responder

basis/http/server/redirection/redirection-tests.factor

@@ -2,8 +2,6 @@ IN: http.server.redirection.tests
 USING: http http.server.redirection urls accessors
 namespaces tools.test present kernel ;
 
-\ relative-to-request must-infer
-
 [
     <request>
         <url>

basis/http/server/server-tests.factor

@@ -4,8 +4,6 @@ IN: http.server.tests
 
 [ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
 
-\ make-http-error must-infer
-
 [ "text/plain; charset=UTF-8" ] [
     <response>
         "text/plain" >>content-type

basis/io/buffers/buffers.factor

@@ -22,7 +22,7 @@ M: buffer dispose* ptr>> free ;
     swap >>fill 0 >>pos drop ;
 
 : buffer-capacity ( buffer -- n )
-    [ size>> ] [ fill>> ] bi - ; inline
+    [ size>> ] [ fill>> ] bi - >fixnum ; inline
 
 : buffer-empty? ( buffer -- ? )
     fill>> zero? ; inline

basis/io/directories/search/search.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays continuations deques dlists fry
 io.directories io.files io.files.info io.pathnames kernel
-sequences system vocabs.loader ;
+sequences system vocabs.loader locals math namespaces
+sorting assocs ;
 IN: io.directories.search
 
 <PRIVATE
@@ -13,10 +14,10 @@ TUPLE: directory-iterator path bfs queue ;
     dup directory-files [ append-path ] with map ;
 
 : push-directory ( path iter -- )
-    [ qualified-directory ] dip [
+    [ qualified-directory ] dip '[
-        [ queue>> ] [ bfs>> ] bi
+        _ [ queue>> ] [ bfs>> ] bi
         [ push-front ] [ push-back ] if
-    ] curry each ;
+    ] each ;
 
 : <directory-iterator> ( path bfs? -- iterator )
     <dlist> directory-iterator boa
@@ -28,12 +29,11 @@ TUPLE: directory-iterator path bfs queue ;
         [ over push-directory next-file ] [ nip ] if
     ] if ;
 
-: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
+:: iterate-directory ( iter quot: ( obj -- ? ) -- obj )
-    over next-file [
+    iter next-file [
-        over call
+        quot call [ iter quot iterate-directory ] unless*
-        [ 2nip ] [ iterate-directory ] if*
     ] [
-        2drop f
+        f
     ] if* ; inline recursive
 
 PRIVATE>
@@ -70,4 +70,30 @@ ERROR: file-not-found ;
 : find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
     '[ _ _ find-all-files ] map concat ; inline
 
+: with-qualified-directory-files ( path quot -- )
+    '[
+        "" directory-files current-directory get
+        '[ _ prepend-path ] map @
+    ] with-directory ; inline
+
+: with-qualified-directory-entries ( path quot -- )
+    '[
+        "" directory-entries current-directory get
+        '[ [ _ prepend-path ] change-name ] map @
+    ] with-directory ; inline
+
+: directory-size ( path -- n )
+    0 swap t [ link-info size-on-disk>> + ] each-file ;
+
+: directory-usage ( path -- assoc )
+    [
+        [
+            [ name>> dup ] [ directory? ] bi [
+                directory-size
+            ] [
+                link-info size-on-disk>>
+            ] if
+        ] { } map>assoc
+    ] with-qualified-directory-entries sort-values ;
+
 os windows? [ "io.directories.search.windows" require ] when

basis/io/encodings/8-bit/8-bit-tests.factor

@@ -4,11 +4,11 @@ IN: io.encodings.8-bit.tests
 
 [ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" latin1 encode ] unit-test
 [ { 256 } >string latin1 encode ] must-fail
-[ B{ 255 } ] [ { 255 } latin1 encode ] unit-test
+[ B{ 255 } ] [ { 255 } >string latin1 encode ] unit-test
 
 [ "bar" ] [ "bar" latin1 decode ] unit-test
-[ { CHAR: b 233 CHAR: r } ] [ { CHAR: b 233 CHAR: r } latin1 decode >array ] unit-test
+[ { CHAR: b 233 CHAR: r } ] [ B{ CHAR: b 233 CHAR: r } latin1 decode >array ] unit-test
-[ { HEX: fffd HEX: 20AC } ] [ { HEX: 81 HEX: 80 } windows-1252 decode >array ] unit-test
+[ { HEX: fffd HEX: 20AC } ] [ B{ HEX: 81 HEX: 80 } windows-1252 decode >array ] unit-test
 
 [ t ] [ \ latin1 8-bit-encoding? ] unit-test
 [ "bar" ] [ "bar" \ latin1 decode ] unit-test

basis/io/encodings/ascii/ascii-tests.factor

@@ -3,7 +3,7 @@ IN: io.encodings.ascii.tests
 
 [ B{ CHAR: f CHAR: o CHAR: o } ] [ "foo" ascii encode ] unit-test
 [ { 128 } >string ascii encode ] must-fail
-[ B{ 127 } ] [ { 127 } ascii encode ] unit-test
+[ B{ 127 } ] [ { 127 } >string ascii encode ] unit-test
 
 [ "bar" ] [ "bar" ascii decode ] unit-test
-[ { CHAR: b HEX: fffd CHAR: r } ] [ { CHAR: b 233 CHAR: r } ascii decode >array ] unit-test
+[ { CHAR: b HEX: fffd CHAR: r } ] [ B{ CHAR: b 233 CHAR: r } ascii decode >array ] unit-test

basis/io/encodings/gb18030/gb18030-tests.factor

@@ -6,7 +6,7 @@ IN: io.encodings.gb18030.tests
 [ "hello" ] [ "hello" gb18030 encode >string ] unit-test
 [ "hello" ] [ "hello" gb18030 decode ] unit-test
 [ B{ HEX: A1 HEX: A4 HEX: 81 HEX: 30 HEX: 86 HEX: 30 } ]
-[ B{ HEX: B7 HEX: B8 } gb18030 encode ] unit-test
+[ B{ HEX: B7 HEX: B8 } >string gb18030 encode ] unit-test
 [ { HEX: B7 HEX: B8 } ]
 [ B{ HEX: A1 HEX: A4 HEX: 81 HEX: 30 HEX: 86 HEX: 30 } gb18030 decode >array ] unit-test
 [ { HEX: B7 CHAR: replacement-character } ]
@@ -18,9 +18,9 @@ IN: io.encodings.gb18030.tests
 [ { HEX: B7 } ]
 [ B{ HEX: A1 HEX: A4 } gb18030 decode >array ] unit-test
 [ { CHAR: replacement-character } ]
-[ B{ HEX: A1 } gb18030 decode >array ] unit-test
+[ B{ HEX: A1 } >string gb18030 decode >array ] unit-test
 [ { HEX: 44D7 HEX: 464B } ]
 [ B{ HEX: 82 HEX: 33 HEX: A3 HEX: 39 HEX: 82 HEX: 33 HEX: C9 HEX: 31 }
   gb18030 decode >array ] unit-test
 [ { HEX: 82 HEX: 33 HEX: A3 HEX: 39 HEX: 82 HEX: 33 HEX: C9 HEX: 31 } ]
-[ { HEX: 44D7 HEX: 464B } gb18030 encode >array ] unit-test
+[ { HEX: 44D7 HEX: 464B } >string gb18030 encode >array ] unit-test

basis/io/encodings/utf16/utf16-tests.factor

@@ -1,25 +1,25 @@
 ! Copyright (C) 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel tools.test io.encodings.utf16 arrays sbufs
-io.streams.byte-array sequences io.encodings io
+io.streams.byte-array sequences io.encodings io strings
 io.encodings.string alien.c-types alien.strings accessors classes ;
 IN: io.encodings.utf16.tests
 
-[ { CHAR: x } ] [ { 0 CHAR: x } utf16be decode >array ] unit-test
+[ { CHAR: x } ] [ B{ 0 CHAR: x } utf16be decode >array ] unit-test
-[ { HEX: 1D11E } ] [ { HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode >array ] unit-test
+[ { HEX: 1D11E } ] [ B{ HEX: D8 HEX: 34 HEX: DD HEX: 1E } utf16be decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { BIN: 11011111 CHAR: q } utf16be decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ BIN: 11011111 CHAR: q } utf16be decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ BIN: 11011011 CHAR: x BIN: 11011011 CHAR: x } utf16be decode >array ] unit-test
 
-[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } utf16be encode >array ] unit-test
+[ { 0 120 216 52 221 30 } ] [ { CHAR: x HEX: 1d11e } >string utf16be encode >array ] unit-test
 
-[ { CHAR: x } ] [ { CHAR: x 0 } utf16le decode >array ] unit-test
+[ { CHAR: x } ] [ B{ CHAR: x 0 } utf16le decode >array ] unit-test
-[ { 119070 } ] [ { HEX: 34 HEX: D8 HEX: 1E HEX: DD } utf16le decode >array ] unit-test
+[ { 119070 } ] [ B{ HEX: 34 HEX: D8 HEX: 1E HEX: DD } >string utf16le decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } utf16le decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ { 0 BIN: 11011111 } >string utf16le decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } utf16le decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ { 0 BIN: 11011011 0 0 } >string utf16le decode >array ] unit-test
 
-[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16le encode >array ] unit-test
+[ { 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } >string utf16le encode >array ] unit-test
 
-[ { CHAR: x } ] [ { HEX: ff HEX: fe CHAR: x 0 } utf16 decode >array ] unit-test
+[ { CHAR: x } ] [ B{ HEX: ff HEX: fe CHAR: x 0 } utf16 decode >array ] unit-test
-[ { CHAR: x } ] [ { HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test
+[ { CHAR: x } ] [ B{ HEX: fe HEX: ff 0 CHAR: x } utf16 decode >array ] unit-test
 
-[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } utf16 encode >array ] unit-test
+[ { HEX: ff HEX: fe 120 0 52 216 30 221 } ] [ { CHAR: x HEX: 1d11e } >string utf16 encode >array ] unit-test

basis/io/encodings/utf32/utf32-tests.factor

@@ -1,30 +1,30 @@
 ! Copyright (C) 2009 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel tools.test io.encodings.utf32 arrays sbufs
-io.streams.byte-array sequences io.encodings io
+io.streams.byte-array sequences io.encodings io strings
 io.encodings.string alien.c-types alien.strings accessors classes ;
 IN: io.encodings.utf32.tests
 
-[ { CHAR: x } ] [ { 0 0 0 CHAR: x } utf32be decode >array ] unit-test
+[ { CHAR: x } ] [ B{ 0 0 0 CHAR: x } utf32be decode >array ] unit-test
-[ { HEX: 1D11E } ] [ { 0 1 HEX: D1 HEX: 1E } utf32be decode >array ] unit-test
+[ { HEX: 1D11E } ] [ B{ 0 1 HEX: D1 HEX: 1E } utf32be decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 1 HEX: D1 } utf32be decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ 0 1 HEX: D1 } utf32be decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 1 } utf32be decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ 0 1 } utf32be decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { 0 } utf32be decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ 0 } utf32be decode >array ] unit-test
 [ { } ] [ { } utf32be decode >array ] unit-test
 
-[ { 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } utf32be encode >array ] unit-test
+[ { 0 0 0 CHAR: x 0 1 HEX: D1 HEX: 1E } ] [ { CHAR: x HEX: 1d11e } >string utf32be encode >array ] unit-test
 
-[ { CHAR: x } ] [ { CHAR: x 0 0 0 } utf32le decode >array ] unit-test
+[ { CHAR: x } ] [ B{ CHAR: x 0 0 0 } utf32le decode >array ] unit-test
-[ { HEX: 1d11e } ] [ { HEX: 1e HEX: d1 1 0 } utf32le decode >array ] unit-test
+[ { HEX: 1d11e } ] [ B{ HEX: 1e HEX: d1 1 0 } utf32le decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { HEX: 1e HEX: d1 1 } utf32le decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ HEX: 1e HEX: d1 1 } utf32le decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { HEX: 1e HEX: d1 } utf32le decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ HEX: 1e HEX: d1 } utf32le decode >array ] unit-test
-[ { CHAR: replacement-character } ] [ { HEX: 1e } utf32le decode >array ] unit-test
+[ { CHAR: replacement-character } ] [ B{ HEX: 1e } utf32le decode >array ] unit-test
 [ { } ] [ { } utf32le decode >array ] unit-test
 
-[ { 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } utf32le encode >array ] unit-test
+[ { 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32le encode >array ] unit-test
 
-[ { CHAR: x } ] [ { HEX: ff HEX: fe 0 0 CHAR: x 0 0 0 } utf32 decode >array ] unit-test
+[ { CHAR: x } ] [ B{ HEX: ff HEX: fe 0 0 CHAR: x 0 0 0 } utf32 decode >array ] unit-test
-[ { CHAR: x } ] [ { 0 0 HEX: fe HEX: ff 0 0 0 CHAR: x } utf32 decode >array ] unit-test
+[ { CHAR: x } ] [ B{ 0 0 HEX: fe HEX: ff 0 0 0 CHAR: x } utf32 decode >array ] unit-test
 
-[ { HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } utf32 encode >array ] unit-test
+[ { HEX: ff HEX: fe 0 0 120 0 0 0 HEX: 1e HEX: d1 1 0 } ] [ { CHAR: x HEX: 1d11e } >string utf32 encode >array ] unit-test
 

basis/io/files/info/info-tests.factor

@@ -3,9 +3,6 @@ io.directories kernel io.pathnames accessors tools.test
 sequences io.files.temp ;
 IN: io.files.info.tests
 
-\ file-info must-infer
-\ link-info must-infer
-
 [ t ] [
     temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory
     temp-directory "test41" append-path utf8 file-contents "hi41" =

basis/io/files/info/info.factor

@@ -5,7 +5,7 @@ vocabs.loader io.files.types ;
 IN: io.files.info
 
 ! File info
-TUPLE: file-info type size permissions created modified
+TUPLE: file-info type size size-on-disk permissions created modified
 accessed ;
 
 HOOK: file-info os ( path -- info )
@@ -25,4 +25,4 @@ HOOK: file-system-info os ( path -- file-system-info )
 {
     { [ os unix? ] [ "io.files.info.unix." os name>> append ] }
     { [ os windows? ] [ "io.files.info.windows" ] }
-} cond require
+} cond require

basis/io/files/info/unix/unix.factor

@@ -63,6 +63,8 @@ M: unix link-info ( path -- info )
 
 M: unix new-file-info ( -- class ) unix-file-info new ;
 
+CONSTANT: standard-unix-block-size 512
+
 M: unix stat>file-info ( stat -- file-info )
     [ new-file-info ] dip
     {
@@ -80,6 +82,7 @@ M: unix stat>file-info ( stat -- file-info )
         [ stat-st_rdev >>rdev ]
         [ stat-st_blocks >>blocks ]
         [ stat-st_blksize >>blocksize ]
+        [ drop dup blocks>> standard-unix-block-size * >>size-on-disk ]
     } cleave ;
 
 : n>file-type ( n -- type )

basis/io/files/info/windows/windows.factor

@@ -5,11 +5,33 @@ io.files.windows io.files.windows.nt kernel windows.kernel32
 windows.time windows accessors alien.c-types combinators
 generalizations system alien.strings io.encodings.utf16n
 sequences splitting windows.errors fry continuations destructors
-calendar ascii combinators.short-circuit ;
+calendar ascii combinators.short-circuit locals ;
 IN: io.files.info.windows
 
+:: round-up-to ( n multiple -- n' )
+    n multiple rem dup 0 = [
+        drop n
+    ] [
+        multiple swap - n +
+    ] if ;
+
 TUPLE: windows-file-info < file-info attributes ;
 
+: get-compressed-file-size ( path -- n )
+    "DWORD" <c-object> [ GetCompressedFileSize ] keep
+    over INVALID_FILE_SIZE = [
+        win32-error-string throw
+    ] [
+        *uint >64bit
+    ] if ;
+
+: set-windows-size-on-disk ( file-info path -- file-info )
+    over attributes>> +compressed+ swap member? [
+        get-compressed-file-size
+    ] [
+        drop dup size>> 4096 round-up-to
+    ] if >>size-on-disk ;
+
 : WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
     [ \ windows-file-info new ] dip
     {
@@ -79,7 +101,9 @@ TUPLE: windows-file-info < file-info attributes ;
     ] if ;
 
 M: windows file-info ( path -- info )
-    normalize-path get-file-information-stat ;
+    normalize-path
+    [ get-file-information-stat ]
+    [ set-windows-size-on-disk ] bi ;
 
 M: windows link-info ( path -- info )
     file-info ;

basis/io/files/unique/unique-tests.factor

@@ -5,7 +5,7 @@ IN: io.files.unique.tests
 
 [ 123 ] [
     "core" ".test" [
-        [ [ 123 CHAR: a <repetition> ] dip ascii set-file-contents ]
+        [ [ 123 CHAR: a <string> ] dip ascii set-file-contents ]
         [ file-info size>> ] bi
     ] cleanup-unique-file
 ] unit-test

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

@@ -4,7 +4,7 @@ io.backend.windows io.files.windows io.encodings.utf16n windows
 windows.kernel32 kernel libc math threads system environment
 alien.c-types alien.arrays alien.strings sequences combinators
 combinators.short-circuit ascii splitting alien strings assocs
-namespaces make accessors tr windows.time ;
+namespaces make accessors tr windows.time windows.shell32 ;
 IN: io.files.windows.nt
 
 M: winnt cwd
@@ -58,4 +58,9 @@ M: winnt open-append
     [ dup windows-file-size ] [ drop 0 ] recover
     [ (open-append) ] dip >>ptr ;
 
-M: winnt home "USERPROFILE" os-env ;
+M: winnt home
+    {
+        [ "HOMEDRIVE" os-env "HOMEPATH" os-env append-path ]
+        [ "USERPROFILE" os-env ]
+        [ my-documents ]
+    } 0|| ;

basis/io/launcher/launcher-tests.factor

@@ -1,6 +1,3 @@
 IN: io.launcher.tests
 USING: tools.test io.launcher ;
 
-\ <process-stream> must-infer
-\ <process-reader> must-infer
-\ <process-writer> must-infer

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

@@ -4,8 +4,6 @@ concurrency.mailboxes tools.test destructors io.files.info
 io.pathnames io.files.temp io.directories.hierarchy ;
 IN: io.monitors.recursive.tests
 
-\ pump-thread must-infer
-
 SINGLETON: mock-io-backend
 
 TUPLE: counter i ;

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

@@ -1,4 +1,4 @@
 IN: io.monitors.windows.nt.tests
 USING: io.monitors.windows.nt tools.test ;
 
-\ fill-queue-thread must-infer
+

basis/io/ports/ports.factor

@@ -189,4 +189,4 @@ HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii }
 
 HINTS: decoder-readln { input-port utf8 } { input-port ascii } ;
 
-HINTS: encoder-write { string output-port utf8 } { string output-port ascii } ;
+HINTS: encoder-write { object output-port utf8 } { object output-port ascii } ;

basis/io/sockets/secure/unix/unix-tests.factor

@@ -5,7 +5,6 @@ io.backend.unix classes words destructors threads tools.test
 concurrency.promises byte-arrays locals calendar io.timeouts
 io.sockets.secure.unix.debug ;
 
-\ <secure-config> must-infer
 { 1 0 } [ [ ] with-secure-context ] must-infer-as
 
 [ ] [ <promise> "port" set ] unit-test

basis/io/streams/byte-array/byte-array-tests.factor

@@ -1,11 +1,11 @@
 USING: tools.test io.streams.byte-array io.encodings.binary
 io.encodings.utf8 io kernel arrays strings namespaces ;
 
-[ B{ 1 2 3 } ] [ binary [ { 1 2 3 } write ] with-byte-writer ] unit-test
+[ B{ 1 2 3 } ] [ binary [ B{ 1 2 3 } write ] with-byte-writer ] unit-test
 [ B{ 1 2 3 } ] [ { 1 2 3 } binary [ 3 read ] with-byte-reader ] unit-test
 
 [ B{ BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 BIN: 11101111 BIN: 10000000 BIN: 10111111 BIN: 11011111 BIN: 10000000 CHAR: x } ]
-[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } utf8 [ write ] with-byte-writer ] unit-test
+[ { BIN: 101111111000000111111 BIN: 1111000000111111 BIN: 11111000000 CHAR: x } >string utf8 [ write ] with-byte-writer ] unit-test
 [ { BIN: 101111111000000111111 } t ] [ { BIN: 11110101 BIN: 10111111 BIN: 10000000 BIN: 10111111 } utf8 <byte-reader> contents dup >array swap string? ] unit-test
 
 [ B{ 121 120 } 0 ] [

basis/io/streams/string/string.factor

@@ -33,5 +33,6 @@ M: sbuf stream-element-type drop +character+ ;
     512 <sbuf> ;
 
 : with-string-writer ( quot -- str )
-    <string-writer> swap [ output-stream get ] compose with-output-stream*
+    <string-writer> [
-    >string ; inline
+        swap with-output-stream*
+    ] keep >string ; inline

basis/io/styles/styles-tests.factor

@@ -1,8 +1,2 @@
 IN: io.styles.tests
 USING: io.styles tools.test ;
-
-\ stream-format must-infer
-\ stream-write-table must-infer
-\ make-span-stream must-infer
-\ make-block-stream must-infer
-\ make-cell-stream must-infer

basis/io/styles/styles.factor

@@ -156,3 +156,5 @@ M: input summary
     ] "" make ;
 
 : write-object ( str obj -- ) presented associate format ;
+
+: write-image ( image -- ) [ "" ] dip image associate format ;

basis/lcs/lcs-tests.factor

@@ -2,10 +2,6 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: tools.test lcs ;
 
-\ lcs must-infer
-\ diff must-infer
-\ levenshtein must-infer
-
 [ 3 ] [ "sitting" "kitten" levenshtein ] unit-test
 [ 3 ] [ "kitten" "sitting" levenshtein ] unit-test
 [ 1 ] [ "freshpak" "freshpack" levenshtein ] unit-test