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

Makefile

@@ -7,7 +7,6 @@ CONSOLE_EXECUTABLE = factor-console
 TEST_LIBRARY = factor-ffi-test
 VERSION = 0.92
 
-IMAGE = factor.image
 BUNDLE = Factor.app
 LIBPATH = -L/usr/X11R6/lib
 CFLAGS = -Wall
@@ -16,9 +15,11 @@ FFI_TEST_CFLAGS = -fPIC
 ifdef DEBUG
 	CFLAGS += -g
 else
-	CFLAGS += -O3 $(SITE_CFLAGS)
+	CFLAGS += -O3
 endif
 
+CFLAGS += $(SITE_CFLAGS)
+
 ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
 
 ifdef CONFIG
@@ -151,17 +152,17 @@ macosx.app: factor
 		@executable_path/../Frameworks/libfactor.dylib \
 		Factor.app/Contents/MacOS/factor
 
-factor: $(DLL_OBJS) $(EXE_OBJS)
+$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
 	$(LINKER) $(ENGINE) $(DLL_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
 		$(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS)
 
-factor-console: $(DLL_OBJS) $(EXE_OBJS)
+$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
 	$(LINKER) $(ENGINE) $(DLL_OBJS)
 	$(CC) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
 		$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
 
-factor-ffi-test: vm/ffi_test.o
+$(TEST_LIBRARY): vm/ffi_test.o
 	$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
 
 clean:

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
@@ -77,6 +68,10 @@ SYMBOL: bootstrap-time
     "staging" get "deploy-vocab" get or [
         "stage2: deployment mode" print
     ] [
+        "debugger" require
+        "alien.prettyprint" require
+        "inspector" require
+        "tools.errors" require
         "listener" require
         "none" require
     ] if

basis/calendar/calendar-tests.factor

@@ -1,11 +1,7 @@
 USING: arrays calendar kernel math sequences tools.test
-continuations system math.order threads ;
+continuations system math.order threads accessors ;
 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
@@ -167,3 +163,10 @@ IN: calendar.tests
 [ t ] [ now 50 milliseconds sleep now before? ] unit-test
 [ t ] [ now 50 milliseconds sleep now swap after? ] unit-test
 [ t ] [ now 50 milliseconds sleep now 50 milliseconds sleep now swapd between? ] unit-test
+
+[ 4 12 ] [ 2009 easter [ month>> ] [ day>> ] bi ] unit-test
+[ 4 2 ] [ 1961 easter [ month>> ] [ day>> ] bi ] unit-test
+
+[ f ] [ now dup midnight eq? ] unit-test
+[ f ] [ now dup easter eq? ] unit-test
+[ f ] [ now dup beginning-of-year eq? ] unit-test

basis/calendar/calendar.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays classes.tuple combinators combinators.short-circuit
+USING: accessors arrays classes.tuple combinators
-    kernel locals math math.functions math.order namespaces sequences strings
+combinators.short-circuit kernel locals math math.functions
-    summary system threads vocabs.loader ;
+math.order sequences summary system threads vocabs.loader ;
 IN: calendar
 
 HOOK: gmt-offset os ( -- hours minutes seconds )
@@ -94,26 +94,50 @@ CONSTANT: day-abbreviations3
 :: julian-day-number ( year month day -- n )
     #! Returns a composite date number
     #! Not valid before year -4800
-    [let* | a [ 14 month - 12 /i ]
+    14 month - 12 /i :> a
-            y [ year 4800 + a - ]
+    year 4800 + a - :> y
-            m [ month 12 a * + 3 - ] |
+    month 12 a * + 3 - :> m
+
     day 153 m * 2 + 5 /i + 365 y * +
-        y 4 /i + y 100 /i - y 400 /i + 32045 -
+    y 4 /i + y 100 /i - y 400 /i + 32045 - ;
-    ] ;
 
 :: julian-day-number>date ( n -- year month day )
     #! Inverse of julian-day-number
-    [let* | a [ n 32044 + ]
+    n 32044 + :> a
-            b [ 4 a * 3 + 146097 /i ]
+    4 a * 3 + 146097 /i :> b
-            c [ a 146097 b * 4 /i - ]
+    a 146097 b * 4 /i - :> c
-            d [ 4 c * 3 + 1461 /i ]
+    4 c * 3 + 1461 /i :> d
-            e [ c 1461 d * 4 /i - ]
+    c 1461 d * 4 /i - :> e
-            m [ 5 e * 2 + 153 /i ] |
+    5 e * 2 + 153 /i :> m
+
     100 b * d + 4800 -
     m 10 /i + m 3 +
     12 m 10 /i * -
-        e 153 m * 2 + 5 /i - 1+
+    e 153 m * 2 + 5 /i - 1+ ;
-    ] ;
+
+GENERIC: easter ( obj -- obj' )
+
+:: easter-month-day ( year -- month day )
+    year 19 mod :> a
+    year 100 /mod :> c :> b
+    b 4 /mod :> e :> d
+    b 8 + 25 /i :> f
+    b f - 1 + 3 /i :> g
+    19 a * b + d - g - 15 + 30 mod :> h
+    c 4 /mod :> k :> i
+    32 2 e * + 2 i * + h - k - 7 mod :> l
+    a 11 h * + 22 l * + 451 /i :> m
+
+    h l + 7 m * - 114 + 31 /mod 1 + :> day :> month
+    month day ;
+
+M: integer easter ( year -- timestamp )
+    dup easter-month-day <date> ;
+
+M: timestamp easter ( timestamp -- timestamp )
+    clone
+    dup year>> easter-month-day
+    swapd >>day swap >>month ;
 
 : >date< ( timestamp -- year month day )
     [ year>> ] [ month>> ] [ day>> ] tri ;

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/checksums/md5/md5.factor

@@ -14,7 +14,7 @@ IN: checksums.md5
 SYMBOLS: a b c d old-a old-b old-c old-d ;
 
 : T ( N -- Y )
-    sin abs 4294967296 * >integer ; foldable
+    sin abs 32 2^ * >integer ; foldable
 
 : initialize-md5 ( -- )
     0 bytes-read set

basis/combinators/smart/smart-docs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.syntax kernel quotations math sequences
-multiline ;
+multiline stack-checker ;
 IN: combinators.smart
 
 HELP: input<sequence
@@ -108,7 +108,7 @@ HELP: append-outputs-as
 
 
 ARTICLE: "combinators.smart" "Smart combinators"
-"The macros in the " { $vocab-link "combinators.smart" } " vocabulary look at the static stack effects of input quotations and generate code which produces or consumes the relevant number of stack values." $nl
+"A " { $emphasis "smart combinator" } " is a macro which reflects on the stack effect of an input quotation. The " { $vocab-link "combinators.smart" } " vocabulary implements a few simple smart combinators which look at the static stack effects of input quotations and generate code which produces or consumes the relevant number of stack values." $nl
 "Call a quotation and discard all output values:"
 { $subsection drop-outputs }
 "Take all input values from a sequence:"
@@ -122,6 +122,7 @@ ARTICLE: "combinators.smart" "Smart combinators"
 { $subsection sum-outputs }
 "Concatenating output values:"
 { $subsection append-outputs }
-{ $subsection append-outputs-as } ;
+{ $subsection append-outputs-as }
+"New smart combinators can be created by defining " { $link "macros" } " which call " { $link infer } "." ;
 
 ABOUT: "combinators.smart"

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/combinators/smart/smart.factor

@@ -18,6 +18,10 @@ MACRO: input<sequence ( quot -- newquot )
     [ infer in>> ] keep
     '[ _ firstn @ ] ;
 
+MACRO: input<sequence-unsafe ( quot -- newquot )
+    [ infer in>> ] keep
+    '[ _ firstn-unsafe @ ] ;
+
 MACRO: reduce-outputs ( quot operation -- newquot )
     [ dup infer out>> 1 [-] ] dip n*quot compose ;
 

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/codegen/codegen.factor

@@ -375,45 +375,21 @@ M: long-long-type flatten-value-type ( type -- types )
 : box-return* ( node -- )
     return>> [ ] [ box-return ] if-void ;
 
-TUPLE: no-such-library name ;
-
-M: no-such-library summary
-    drop "Library not found" ;
-
-M: no-such-library error-type drop +linkage-error+ ;
-
-: no-such-library ( name -- )
-    \ no-such-library boa
-    compiling-word get compiler-error ;
-
-TUPLE: no-such-symbol name ;
-
-M: no-such-symbol summary
-    drop "Symbol not found" ;
-
-M: no-such-symbol error-type drop +linkage-error+ ;
-
-: no-such-symbol ( name -- )
-    \ no-such-symbol boa
-    compiling-word get compiler-error ;
-
 : check-dlsym ( symbols dll -- )
     dup dll-valid? [
         dupd '[ _ dlsym ] any?
-        [ drop ] [ no-such-symbol ] if
+        [ drop ] [ compiling-word get no-such-symbol ] if
     ] [
-        dll-path no-such-library drop
+        dll-path compiling-word get no-such-library drop
     ] if ;
 
-: stdcall-mangle ( symbol node -- symbol )
+: stdcall-mangle ( symbol params -- symbol )
-    "@"
+    parameters>> parameter-sizes drop number>string "@" glue ;
-    swap parameters>> parameter-sizes drop
-    number>string 3append ;
 
 : alien-invoke-dlsym ( params -- symbols dll )
-    dup function>> dup pick stdcall-mangle 2array
+    [ [ function>> dup ] keep stdcall-mangle 2array ]
-    swap library>> library dup [ dll>> ] when
+    [ library>> library dup [ dll>> ] when ]
-    2dup check-dlsym ;
+    bi 2dup check-dlsym ;
 
 M: ##alien-invoke generate-insn
     params>>

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 certain compile errors 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
@@ -46,9 +46,9 @@ $nl
     { "The " { $emphasis "non-optimizing quotation compiler" } " compiles quotations to naive machine code very quickly. The non-optimizing quotation compiler is part of the VM." }
     { "The " { $emphasis "optimizing word compiler" } " compiles whole words at a time while performing extensive data and control flow analysis. This provides greater performance for generated code, but incurs a much longer compile time. The optimizing compiler is written in Factor." }
 }
-"The optimizing compiler only compiles words which have a static stack effect. This means that methods defined on fundamental generic words such as " { $link nth } " should have a static stack effect. See " { $link "inference" } " and " { $link "cookbook-pitfalls" } "."
-$nl
 "The optimizing compiler also trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information."
+$nl
+"Most code you write will run with the optimizing compiler. Sometimes, the non-optimizing compiler is used, for example for listener interactions, or for running the quotation passed to " { $link POSTPONE: call( } "."
 { $subsection "compiler-errors" }
 { $subsection "hints" }
 { $subsection "compiler-usage" }
@@ -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

@@ -2,19 +2,20 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel namespaces arrays sequences io words fry
 continuations vocabs assocs dlists definitions math graphs generic
-combinators deques search-deques macros io source-files.errors stack-checker
+combinators deques search-deques macros io source-files.errors
-stack-checker.state stack-checker.inlining combinators.short-circuit
+stack-checker stack-checker.state stack-checker.inlining
-compiler.errors compiler.units compiler.tree.builder
+stack-checker.errors combinators.short-circuit compiler.errors
-compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer
+compiler.units compiler.tree.builder compiler.tree.optimizer
-compiler.cfg.linearization compiler.cfg.two-operand
+compiler.cfg.builder compiler.cfg.optimizer compiler.cfg.linearization
-compiler.cfg.linear-scan compiler.cfg.stack-frame compiler.codegen
+compiler.cfg.two-operand compiler.cfg.linear-scan
-compiler.utilities ;
+compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
 IN: compiler
 
 SYMBOL: compile-queue
 SYMBOL: compiled
 
 : queue-compile? ( word -- ? )
+    #! Don't attempt to compile certain words.
     {
         [ "forgotten" word-prop ]
         [ compiled get key? ]
@@ -25,67 +26,99 @@ 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
     H{ } clone dependencies set
     H{ } clone generic-dependencies set
-    f swap compiler-error ;
+    clear-compiler-error ;
 
 : ignore-error? ( word error -- ? )
+    #! Ignore some errors 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 ;
+    ] [
+        {
+            [ do-not-compile? ]
+            [ literal-expected? ]
+        } 1||
+    ] 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
+        [ dup def>> deoptimize-with ]
+        [ clear-compiler-error ]
+        bi
+    ] [
+        [ swap <compiler-error> compiler-error ]
+        [ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
+        2bi
+    ] if ;
 
 : 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 +132,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 +145,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 +173,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

@@ -1,54 +1,72 @@
 ! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors source-files.errors kernel namespaces assocs ;
+USING: accessors source-files.errors kernel namespaces assocs fry
+summary ;
 IN: compiler.errors
 
-TUPLE: compiler-error < source-file-error ;
+SYMBOL: +compiler-error+
-
-M: compiler-error error-type error>> error-type ;
-
 SYMBOL: compiler-errors
 
 compiler-errors [ H{ } clone ] initialize
 
-SYMBOLS: +compiler-error+ +compiler-warning+ +linkage-error+ ;
+TUPLE: compiler-error < source-file-error ;
 
-: errors-of-type ( type -- assoc )
+M: compiler-error error-type drop +compiler-error+ ;
-    compiler-errors get-global
+
-    swap [ [ nip error-type ] dip eq? ] curry
+SYMBOL: +linkage-error+
-    assoc-filter ;
+SYMBOL: linkage-errors
+
+linkage-errors [ H{ } clone ] initialize
+
+TUPLE: linkage-error < source-file-error ;
+
+M: linkage-error error-type drop +linkage-error+ ;
+
+: clear-compiler-error ( word -- )
+    compiler-errors linkage-errors
+    [ get-global delete-at ] bi-curry@ bi ;
+
+: compiler-error ( error -- )
+    dup asset>> compiler-errors get-global set-at ;
 
 T{ error-type
    { type +compiler-error+ }
    { word ":errors" }
    { plural "compiler errors" }
    { icon "vocab:ui/tools/error-list/icons/compiler-error.tiff" }
-   { quot [ +compiler-error+ errors-of-type values ] }
+   { quot [ compiler-errors get values ] }
    { forget-quot [ compiler-errors get delete-at ] }
 } define-error-type
 
-T{ error-type
+: <compiler-error> ( error word -- compiler-error )
-   { type +compiler-warning+ }
+    \ compiler-error <definition-error> ;
-   { word ":warnings" }
+
-   { plural "compiler warnings" }
+: <linkage-error> ( error word -- linkage-error )
-   { icon "vocab:ui/tools/error-list/icons/compiler-warning.tiff" }
+    \ linkage-error <definition-error> ;
-   { quot [ +compiler-warning+ errors-of-type values ] }
+
-   { forget-quot [ compiler-errors get delete-at ] }
+: linkage-error ( error word class -- )
-} define-error-type
+    '[ _ boa ] dip <linkage-error> dup asset>> linkage-errors get set-at ; inline
 
 T{ error-type
    { type +linkage-error+ }
    { word ":linkage" }
    { plural "linkage errors" }
    { icon "vocab:ui/tools/error-list/icons/linkage-error.tiff" }
-   { quot [ +linkage-error+ errors-of-type values ] }
+   { quot [ linkage-errors get values ] }
-   { forget-quot [ compiler-errors get delete-at ] }
+   { forget-quot [ linkage-errors get delete-at ] }
    { fatal? f }
 } define-error-type
 
-: <compiler-error> ( error word -- compiler-error )
+TUPLE: no-such-library name ;
-    \ compiler-error <definition-error> ;
 
-: compiler-error ( error word -- )
+M: no-such-library summary drop "Library not found" ;
-    compiler-errors get-global pick
+
-    [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
+: no-such-library ( name word -- ) \ no-such-library linkage-error ;
+
+TUPLE: no-such-symbol name ;
+
+M: no-such-symbol summary drop "Symbol not found" ;
+
+: no-such-symbol ( name word -- ) \ no-such-symbol linkage-error ;
+
+ERROR: not-compiled word error ;

basis/compiler/tests/alien.factor

@@ -5,7 +5,7 @@ continuations effects namespaces.private io io.streams.string
 memory system threads tools.test math accessors combinators
 specialized-arrays.float alien.libraries io.pathnames
 io.backend ;
-IN: compiler.tests
+IN: compiler.tests.alien
 
 <<
 : libfactor-ffi-tests-path ( -- string )

basis/compiler/tests/codegen.factor

@@ -4,7 +4,7 @@ sequences sequences.private tools.test namespaces.private
 slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
 combinators vectors grouping make ;
-IN: compiler.tests
+IN: compiler.tests.codegen
 
 ! Originally, this file did black box testing of templating
 ! optimization. We now have a different codegen, but the tests

basis/compiler/tests/curry.factor

@@ -1,6 +1,6 @@
 USING: tools.test quotations math kernel sequences
 assocs namespaces make compiler.units compiler ;
-IN: compiler.tests
+IN: compiler.tests.curry
 
 [ 3 ] [ 5 [ [ 2 - ] curry call ] compile-call ] unit-test
 [ 3 ] [ [ 5 [ 2 - ] curry call ] compile-call ] unit-test

basis/compiler/tests/float.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.float
 USING: compiler.units compiler kernel kernel.private memory math
 math.private tools.test math.floats.private ;
 

basis/compiler/tests/folding.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.folding
 
 ! Calls to generic words were not folded away.
 

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/intrinsics.factor

@@ -6,7 +6,7 @@ sbufs strings.private slots.private alien math.order
 alien.accessors alien.c-types alien.syntax alien.strings
 namespaces libc sequences.private io.encodings.ascii
 classes compiler ;
-IN: compiler.tests
+IN: compiler.tests.intrinsics
 
 ! Make sure that intrinsic ops compile to correct code.
 [ ] [ 1 [ drop ] compile-call ] unit-test

basis/compiler/tests/optimizer.factor

@@ -5,7 +5,7 @@ quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
 compiler.tree.builder compiler.tree.optimizer sequences.deep
 compiler ;
-IN: optimizer.tests
+IN: compiler.tests.optimizer
 
 GENERIC: xyz ( obj -- obj )
 M: array xyz xyz ;
@@ -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/peg-regression-2.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.peg-regression-2
 USING: peg.ebnf strings tools.test ;
 
 GENERIC: <times> ( times -- term' )

basis/compiler/tests/peg-regression.factor

@@ -5,7 +5,7 @@
 ! end of a compilation unit.
 
 USING: kernel accessors peg.ebnf ;
-IN: compiler.tests
+IN: compiler.tests.peg-regression
 
 TUPLE: pipeline-expr background ;
 

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

@@ -1,7 +1,7 @@
 USING: accessors compiler compiler.units tools.test math parser
 kernel sequences sequences.private classes.mixin generic
 definitions arrays words assocs eval strings ;
-IN: compiler.tests
+IN: compiler.tests.redefine1
 
 GENERIC: method-redefine-generic-1 ( a -- b )
 
@@ -11,7 +11,7 @@ M: integer method-redefine-generic-1 3 + ;
 
 [ 6 ] [ method-redefine-test-1 ] unit-test
 
-[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: math M: fixnum method-redefine-generic-1 4 + ;" eval( -- ) ] unit-test
 
 [ 7 ] [ method-redefine-test-1 ] unit-test
 
@@ -27,7 +27,7 @@ M: integer method-redefine-generic-2 3 + ;
 
 [ 6 ] [ method-redefine-test-2 ] unit-test
 
-[ ] [ "IN: compiler.tests USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine1 USE: kernel USE: math M: fixnum method-redefine-generic-2 4 + ; USE: strings M: string method-redefine-generic-2 drop f ;" eval( -- ) ] unit-test
 
 [ 7 ] [ method-redefine-test-2 ] unit-test
 
@@ -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/redefine10.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine10
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine11.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel classes.mixin arrays ;
-IN: compiler.tests
+IN: compiler.tests.redefine11
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine16.factor

@@ -7,4 +7,5 @@ quotations stack-checker ;
 [ ] [ "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 1quotation infer ] must-fail
+
+[ ] [ [ "blah" "compiler.tests.redefine16" lookup forget ] with-compilation-unit ] unit-test

basis/compiler/tests/redefine2.factor

@@ -1,11 +1,11 @@
-IN: compiler.tests
+IN: compiler.tests.redefine2
 USING: compiler compiler.units tools.test math parser kernel
 sequences sequences.private classes.mixin generic definitions
 arrays words assocs eval words.symbol ;
 
 DEFER: redefine2-test
 
-[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
+[ ] [ "USE: sequences USE: kernel IN: compiler.tests.redefine2 TUPLE: redefine2-test ; M: redefine2-test nth 2drop 3 ; INSTANCE: redefine2-test sequence" eval( -- ) ] unit-test
 
 [ t ] [ \ redefine2-test symbol? ] unit-test
 

basis/compiler/tests/redefine3.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine3
 USING: accessors compiler compiler.units tools.test math parser
 kernel sequences sequences.private classes.mixin generic
 definitions arrays words assocs eval ;
@@ -18,7 +18,7 @@ M: empty-mixin sheeple drop "wake up" ;
 [ 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
 
-[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine3 USE: arrays INSTANCE: array empty-mixin" eval( -- ) ] unit-test
 
 [ "wake up" ] [ sheeple-test ] unit-test
 [ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test

basis/compiler/tests/redefine4.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.redefine4
 USING: io.streams.string kernel tools.test eval ;
 
 : declaration-test-1 ( -- a ) 3 ; flushable
@@ -7,6 +7,6 @@ USING: io.streams.string kernel tools.test eval ;
 
 [ "" ] [ [ declaration-test ] with-string-writer ] unit-test
 
-[ ] [ "IN: compiler.tests USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
+[ ] [ "IN: compiler.tests.redefine4 USE: io : declaration-test-1 ( -- a ) \"X\" write f ;" eval( -- ) ] unit-test
 
 [ "X" ] [ [ declaration-test ] with-string-writer ] unit-test

basis/compiler/tests/redefine5.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine5
 
 ! Regression: if dispatch was eliminated but method was not inlined,
 ! compiled usage information was not recorded.

basis/compiler/tests/redefine6.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine6
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine7.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine7
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine8.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel ;
-IN: compiler.tests
+IN: compiler.tests.redefine8
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/redefine9.factor

@@ -1,6 +1,6 @@
 USING: eval tools.test compiler.units vocabs multiline words
 kernel generic.math ;
-IN: compiler.tests
+IN: compiler.tests.redefine9
 
 ! Mixin redefinition did not recompile all necessary words.
 

basis/compiler/tests/reload.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.reload
 USE: vocabs.loader
 
 ! "parser" reload

basis/compiler/tests/simple.factor

@@ -1,9 +1,7 @@
 USING: compiler compiler.units tools.test kernel kernel.private
 sequences.private math.private math combinators strings alien
 arrays memory vocabs parser eval ;
-IN: compiler.tests
+IN: compiler.tests.simple
-
-\ (compile) must-infer
 
 ! Test empty word
 [ ] [ [ ] compile-call ] unit-test

basis/compiler/tests/spilling.factor

@@ -1,6 +1,6 @@
 USING: math.private kernel combinators accessors arrays
 generalizations tools.test ;
-IN: compiler.tests
+IN: compiler.tests.spilling
 
 : float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
     {

basis/compiler/tests/stack-trace.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.stack-trace
 USING: compiler tools.test namespaces sequences
 kernel.private kernel math continuations continuations.private
 words splitting grouping sorting accessors ;

basis/compiler/tests/tuples.factor

@@ -1,4 +1,4 @@
-IN: compiler.tests
+IN: compiler.tests.tuples
 USING: kernel tools.test compiler.units compiler ;
 
 TUPLE: color red green blue ;

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 { "word/quot" { $or word quotation } } { "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 } { "word/quot" { $or word quotation } } { "nodes/f" { $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,59 @@ 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) infer-quot-here ;
-    #! 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 ;
-            {
+
-                [ check-cannot-infer ]
+: 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)
     [ check-no-compile ]
-                [ (build-tree-from-word) ]
+    [ word-body infer-quot-here ]
-                [ finish-word ]
+    [ current-effect check-effect ] tri ;
-            } cleave
+
-        ] maybe-cannot-infer
+: build-tree-with ( in-stack word/quot -- nodes )
-    ] with-tree-builder ;
+    [
+        <recursive-state> recursive-state set
+        V{ } clone stack-visitor set
+        [ [ >vector \ meta-d set ] [ length d-in set ] bi ]
+        [ (build-tree) ]
+        bi*
+    ] with-infer nip ;
+
+PRIVATE>
+
+: 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.
+    f specialize-method? [
+        [
+            #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
+    ] with-variable ;
 
 : 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/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/propagation/inlining/inlining.factor

@@ -4,6 +4,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 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 ] [
@@ -159,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
+                word remember-inlining
-            [ drop ] [ splicing-nodes ] 2bi
+                [ ] [ count-nodes ] [ (propagate) ] tri
-            [ >>body drop ] [ count-nodes ] [ (propagate) ] tri
+            ] with-scope
-        ] with-scope node-count +@
+            [ #call (>>body) ] [ node-count +@ ] bi* t
-        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 ;
 
@@ -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/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

@@ -126,14 +126,14 @@ HOOK: signal-error. os ( obj -- )
 : 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.               ] }
@@ -153,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" ;

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
 
 <<
@@ -65,6 +63,24 @@ WHERE
 
 [ 4 ] [ 1 3 blah ] unit-test
 
+<<
+
+FUNCTOR: symbol-test ( W -- )
+
+W DEFINES ${W}
+
+WHERE
+
+SYMBOL: W
+
+;FUNCTOR
+
+"blorgh" symbol-test
+
+>>
+
+[ blorgh ] [ blorgh ] unit-test
+
 GENERIC: some-generic ( a -- b )
 
 ! Does replacing an ordinary word with a functor-generated one work?
@@ -74,6 +90,7 @@ GENERIC: some-generic ( a -- b )
     TUPLE: some-tuple ;
     : some-word ( -- ) ;
     M: some-tuple some-generic ;
+    SYMBOL: some-symbol
     "> <string-reader> "functors-test" parse-stream
 ] unit-test
 
@@ -84,6 +101,7 @@ GENERIC: some-generic ( a -- b )
         "some-tuple" "functors.tests" lookup
         "some-generic" "functors.tests" lookup method >boolean
     ] unit-test ;
+    [ t ] [ "some-symbol" "functors.tests" lookup >boolean ] unit-test
 
 test-redefinition
 
@@ -92,12 +110,14 @@ FUNCTOR: redefine-test ( W -- )
 W-word DEFINES ${W}-word
 W-tuple DEFINES-CLASS ${W}-tuple
 W-generic IS ${W}-generic
+W-symbol DEFINES ${W}-symbol
 
 WHERE
 
 TUPLE: W-tuple ;
 : W-word ( -- ) ;
 M: W-tuple W-generic ;
+SYMBOL: W-symbol
 
 ;FUNCTOR
 
@@ -108,3 +128,4 @@ M: W-tuple W-generic ;
 ] unit-test
 
 test-redefinition
+

basis/functors/functors.factor

@@ -5,7 +5,7 @@ words interpolate namespaces sequences io.streams.string fry
 classes.mixin effects lexer parser classes.tuple.parser
 effects.parser locals.types locals.parser generic.parser
 locals.rewrite.closures vocabs.parser classes.parser
-arrays accessors ;
+arrays accessors words.symbol ;
 IN: functors
 
 ! This is a hack
@@ -18,6 +18,8 @@ IN: functors
 
 : define-declared* ( word def effect -- ) pick set-word define-declared ;
 
+TUPLE: fake-call-next-method ;
+
 TUPLE: fake-quotation seq ;
 
 GENERIC: >fake-quotations ( quot -- fake )
@@ -29,17 +31,25 @@ M: array >fake-quotations [ >fake-quotations ] { } map-as ;
 
 M: object >fake-quotations ;
 
-GENERIC: fake-quotations> ( fake -- quot )
+GENERIC: (fake-quotations>) ( fake -- )
 
-M: fake-quotation fake-quotations>
+: fake-quotations> ( fake -- quot )
-    seq>> [ fake-quotations> ] [ ] map-as ;
+    [ (fake-quotations>) ] [ ] make ;
 
-M: array fake-quotations> [ fake-quotations> ] map ;
+M: fake-quotation (fake-quotations>)
+    [ seq>> [ (fake-quotations>) ] each ] [ ] make , ;
 
-M: object fake-quotations> ;
+M: array (fake-quotations>)
+    [ [ (fake-quotations>) ] each ] { } make , ;
+
+M: fake-call-next-method (fake-quotations>)
+    drop method-body get literalize , \ (call-next-method) , ;
+
+M: object (fake-quotations>) , ;
 
 : parse-definition* ( accum -- accum )
-    parse-definition >fake-quotations parsed \ fake-quotations> parsed ;
+    parse-definition >fake-quotations parsed
+    [ fake-quotations> first ] over push-all ;
 
 : parse-declared* ( accum -- accum )
     complete-effect
@@ -64,7 +74,7 @@ SYNTAX: `TUPLE:
 SYNTAX: `M:
     scan-param parsed
     scan-param parsed
-    \ create-method-in parsed
+    [ create-method-in dup method-body set ] over push-all
     parse-definition*
     \ define* parsed ;
 
@@ -80,6 +90,10 @@ SYNTAX: `:
     parse-declared*
     \ define-declared* parsed ;
 
+SYNTAX: `SYMBOL:
+    scan-param parsed
+    \ define-symbol parsed ;
+
 SYNTAX: `SYNTAX:
     scan-param parsed
     parse-definition*
@@ -92,6 +106,8 @@ SYNTAX: `INSTANCE:
 
 SYNTAX: `inline [ word make-inline ] over push-all ;
 
+SYNTAX: `call-next-method T{ fake-call-next-method } parsed ;
+
 : (INTERPOLATE) ( accum quot -- accum )
     [ scan interpolate-locals ] dip
     '[ _ with-string-writer @ ] parsed ;
@@ -116,7 +132,9 @@ DEFER: ;FUNCTOR delimiter
         { ":" POSTPONE: `: }
         { "INSTANCE:" POSTPONE: `INSTANCE: }
         { "SYNTAX:" POSTPONE: `SYNTAX: }
+        { "SYMBOL:" POSTPONE: `SYMBOL: }
         { "inline" POSTPONE: `inline }
+        { "call-next-method" POSTPONE: `call-next-method }
     } ;
 
 : push-functor-words ( -- )

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/generalizations/generalizations.factor

@@ -26,11 +26,14 @@ MACRO: narray ( n -- )
 MACRO: nsum ( n -- )
     1- [ + ] n*quot ;
 
+MACRO: firstn-unsafe ( n -- )
+    [ '[ [ _ ] dip nth-unsafe ] ] map '[ _ cleave ] ;
+
 MACRO: firstn ( n -- )
     dup zero? [ drop [ drop ] ] [
-        [ [ '[ [ _ ] dip nth-unsafe ] ] map ]
+        [ 1- swap bounds-check 2drop ]
-        [ 1- '[ [ _ ] dip bounds-check 2drop ] ]
+        [ firstn-unsafe ]
-        bi prefix '[ _ cleave ]
+        bi-curry '[ _ _ bi ]
     ] if ;
 
 MACRO: npick ( n -- )

basis/help/cookbook/cookbook.factor

@@ -12,7 +12,7 @@ $nl
 $nl
 "Factor evaluates code left to right, and stores intermediate values on a " { $emphasis "stack" } ". If you think of the stack as a pile of papers, then " { $emphasis "pushing" } " a value on the stack corresponds to placing a piece of paper at the top of the pile, while " { $emphasis "popping" } " a value corresponds to removing the topmost piece."
 $nl
-"All words except those which only push literals on the stack must have a " { $emphasis "stack effect declaration" } ", for example " { $snippet "( x y -- z )" } " denotes that a word takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output. Stack effect declarations can be viewed by browsing source code, or using tools such as " { $link see } "; they are also checked by the compiler. See " { $link "effect-declaration" } "."
+"All words have a " { $emphasis "stack effect declaration" } ", for example " { $snippet "( x y -- z )" } " denotes that a word takes two inputs, with " { $snippet "y" } " at the top of the stack, and returns one output. Stack effect declarations can be viewed by browsing source code, or using tools such as " { $link see } "; they are also checked by the compiler. See " { $link "effects" } "."
 $nl
 "Coming back to the example in the beginning of this article, the following series of steps occurs as the code is evaluated:"
 { $table
@@ -56,18 +56,9 @@ $nl
     "5 0 -       ! Computes 5-0"
     "5 0 swap -  ! Computes 0-5"
 }
-"Also, in the above example a stack effect declaration is written between " { $snippet "(" } " and " { $snippet ")" } " with a mnemonic description of what the word does to the stack. See " { $link "effect-declaration" } " for details."
+"Also, in the above example a stack effect declaration is written between " { $snippet "(" } " and " { $snippet ")" } " with a mnemonic description of what the word does to the stack. See " { $link "effects" } " for details."
 { $curious
-    "This syntax will be familiar to anybody who has used Forth before. However the behavior is slightly different. In most Forth systems, the below code prints 2, because the definition of " { $snippet "b" } " still refers to the previous definition of " { $snippet "a" } ":"
+  "This syntax will be familiar to anybody who has used Forth before. However, unlike Forth, some additional static checks are performed. See " { $link "definition-checking" } " and " { $link "inference" } "."
-    { $code
-        ": a 1 ;"
-        ": b ( -- x ) a 1 + ;"
-        ": a 2 ;"
-        "b ."
-    }
-    "In Factor, this example will print 3 since word redefinition is explicitly supported."
-    $nl
-    "Indeed, redefining a word twice in the same source file is an error; this is almost always a mistake since there's no way to call the first definition. See " { $link "definition-checking" } "."
 }
 { $references
     { "A whole slew of shuffle words can be used to rearrange the stack. There are forms of word definition other than colon definition, words can be defined entirely at runtime, and word definitions can be " { $emphasis "annotated" } " with tracing calls and breakpoints without modifying the source code." }
@@ -175,53 +166,11 @@ $nl
     "parser"
 } ;
 
-ARTICLE: "cookbook-io" "Input and output cookbook"
-"Ask the user for their age, and print it back:"
-{ $code
-    "USING: io math.parser ;"
-    ": ask-age ( -- ) \"How old are you?\" print ;"
-    ": read-age ( -- n ) readln string>number ;"
-    ": print-age ( n -- )"
-    "    \"You are \" write"
-    "    number>string write"
-    "    \" years old.\" print ;"
-    ": example ( -- ) ask-age read-age print-age ;"
-    "example"
-}
-"Print the lines of a file in sorted order:"
-{ $code
-    "USING: io io.encodings.utf8 io.files sequences sorting ;"
-    "\"lines.txt\" utf8 file-lines natural-sort [ print ] each"
-}
-"Read 1024 bytes from a file:"
-{ $code
-    "USING: io io.encodings.binary io.files ;"
-    "\"data.bin\" binary [ 1024 read ] with-file-reader"
-}
-"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
-{ $code
-    "USING: accessors grouping io.files io.mmap.char kernel sequences ;"
-    "\"mydata.dat\" ["
-    "    4 <sliced-groups> [ reverse-here ] change-each"
-    "] with-mapped-char-file"
-}
-"Send some bytes to a remote host:"
-{ $code
-    "USING: io io.encodings.ascii io.sockets strings ;"
-    "\"myhost\" 1033 <inet> ascii"
-    "[ B{ 12 17 102 } write ] with-client"
-}
-{ $references
-    { }
-    "number-strings"
-    "io"
-} ;
-
 ARTICLE: "cookbook-application" "Application cookbook"
 "Vocabularies can define a main entry point:"
 { $code "IN: game-of-life"
 "..."
-": play-life ... ;"
+": play-life ( -- ) ... ;"
 ""
 "MAIN: play-life"
 }
@@ -318,7 +267,6 @@ $nl
     { "Use " { $link "cleave-combinators" } " and " { $link "spread-combinators" } " instead of " { $link "shuffle-words" } " to give your code more structure." }
     { "Not everything has to go on the stack. The " { $vocab-link "namespaces" } " vocabulary provides dynamically-scoped variables, and the " { $vocab-link "locals" } " vocabulary provides lexically-scoped variables. Learn both and use them where they make sense, but keep in mind that overuse of variables makes code harder to factor." }
     "Every time you define a word which simply manipulates sequences, hashtables or objects in an abstract way which is not related to your program domain, check the library to see if you can reuse an existing definition."
-    { "Learn to use the " { $link "inference" } " tool." }
     { "Write unit tests. Factor provides good support for unit testing; see " { $link "tools.test" } ". Once your program has a good test suite you can refactor with confidence and catch regressions early." }
     "Don't write Factor as if it were C. Imperative programming and indexed loops are almost always not the most idiomatic solution."
     { "Use sequences, assocs and objects to group related data. Object allocation is very cheap. Don't be afraid to create tuples, pairs and triples. Don't be afraid of operations which allocate new objects either, such as " { $link append } "." }
@@ -332,6 +280,7 @@ $nl
 "Factor tries to implement as much of itself as possible, because this improves simplicity and performance. One consequence is that Factor exposes its internals for extension and study. You even have the option of using low-level features not usually found in high-level languages, such manual memory management, pointer arithmetic, and inline assembly code."
 $nl
 "Unsafe features are tucked away so that you will not invoke them by accident, or have to use them to solve conventional programming problems. However when the need arises, unsafe features are invaluable, for example you might have to do some pointer arithmetic when interfacing directly with C libraries." ;
+
 ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid"
 "Factor is a very clean and consistent language. However, it has some limitations and leaky abstractions you should keep in mind, as well as behaviors which differ from other languages you may be used to."
 { $list
@@ -341,13 +290,6 @@ ARTICLE: "cookbook-pitfalls" "Pitfalls to avoid"
     { "If a literal object appears in a word definition, the object itself is pushed on the stack when the word executes, not a copy. If you intend to mutate this object, you must " { $link clone } " it first. See " { $link "syntax-literals" } "." }
     { "For a discussion of potential issues surrounding the " { $link f } " object, see " { $link "booleans" } "." }
     { "Factor's object system is quite flexible. Careless usage of union, mixin and predicate classes can lead to similar problems to those caused by “multiple inheritance” in other languages. In particular, it is possible to have two classes such that they have a non-empty intersection and yet neither is a subclass of the other. If a generic word defines methods on two such classes, various disambiguation rules are applied to ensure method dispatch remains deterministic, however they may not be what you expect. See " { $link "method-order" } " for details." }
-    { "Performance-sensitive code should have a static stack effect so that it can be compiled by the optimizing word compiler, which generates more efficient code than the non-optimizing quotation compiler. See " { $link "inference" } " and " { $link "compiler" } "."
-    $nl
-    "This means that methods defined on performance sensitive, frequently-called core generic words such as " { $link nth } " should have static stack effects which are consistent with each other, since a generic word will only have a static stack effect if all methods do."
-    $nl
-    "Unit tests for the " { $vocab-link "stack-checker" } " vocabulary can be used to ensure that any methods your vocabulary defines on core generic words have static stack effects:"
-    { $code "\"stack-checker\" test" }
-    "In general, you should strive to write code with inferable stack effects, even for sections of a program which are not performance sensitive; the " { $link infer. } " tool together with the optimizing compiler's error reporting can catch many bugs ahead of time." }
     { "Be careful when calling words which access variables from a " { $link make-assoc } " which constructs an assoc with arbitrary keys, since those keys might shadow variables." }
     { "If " { $link run-file } " throws a stack depth assertion, it means that the top-level form in the file left behind values on the stack. The stack depth is compared before and after loading a source file, since this type of situation is almost always an error. If you have a legitimate need to load a source file which returns data in some manner, define a word in the source file which produces this data on the stack and call the word after loading the file." }
 } ;
@@ -372,7 +314,6 @@ ARTICLE: "cookbook" "Factor cookbook"
 { $subsection "cookbook-combinators" }
 { $subsection "cookbook-variables" }
 { $subsection "cookbook-vocabs" }
-{ $subsection "cookbook-io" }
 { $subsection "cookbook-application" }
 { $subsection "cookbook-scripts" }
 { $subsection "cookbook-philosophy" }

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

@@ -39,7 +39,7 @@ $nl
     { { $snippet "$" { $emphasis "foo" } } { "help markup" } { $links $heading $emphasis } }
 }
 { $heading "Stack effect conventions" }
-"Stack effect conventions are documented in " { $link "effect-declaration" } "."
+"Stack effect conventions are documented in " { $link "effects" } "."
 { $heading "Glossary of terms" }
 "Common terminology and abbreviations used throughout Factor and its documentation:"
 { $table
@@ -229,9 +229,11 @@ ARTICLE: "handbook-language-reference" "The language"
 { $heading "Fundamentals" }
 { $subsection "conventions" }
 { $subsection "syntax" }
-{ $subsection "effects" }
+{ $heading "The stack" }
 { $subsection "evaluator" }
-{ $heading "Data types" }
+{ $subsection "effects" }
+{ $subsection "inference" }
+{ $heading "Basic data types" }
 { $subsection "booleans" }
 { $subsection "numbers" }
 { $subsection "collections" }
@@ -239,16 +241,18 @@ ARTICLE: "handbook-language-reference" "The language"
 { $subsection "words" }
 { $subsection "shuffle-words" }
 { $subsection "combinators" }
-{ $subsection "errors" }
+{ $subsection "threads" }
-{ $subsection "continuations" }
 { $heading "Named values" }
 { $subsection "locals" }
 { $subsection "namespaces" }
 { $subsection "namespaces-global" }
 { $subsection "values" }
 { $heading "Abstractions" }
+{ $subsection "errors" }
 { $subsection "objects" }
 { $subsection "destructors" }
+{ $subsection "continuations" }
+{ $subsection "memoize" }
 { $subsection "parsing-words" }
 { $subsection "macros" }
 { $subsection "fry" }
@@ -263,6 +267,7 @@ ARTICLE: "handbook-system-reference" "The implementation"
 { $subsection "vocabularies" }
 { $subsection "source-files" }
 { $subsection "compiler" }
+{ $subsection "tools.errors" }
 { $heading "Virtual machine" }
 { $subsection "images" }
 { $subsection "cli" }
@@ -283,7 +288,7 @@ ARTICLE: "handbook-tools-reference" "Developer tools"
 { $subsection "prettyprint" }
 { $subsection "inspector" }
 { $subsection "tools.annotations" }
-{ $subsection "inference" }
+{ $subsection "tools.inference" }
 { $heading "Browsing" }
 { $subsection "see" }
 { $subsection "tools.crossref" }

basis/help/help.factor

@@ -54,7 +54,7 @@ M: word article-title
     dup [ parsing-word? ] [ symbol? ] bi or [
         name>> 
     ] [
-        [ name>> ]
+        [ unparse ]
         [ stack-effect [ effect>string " " prepend ] [ "" ] if* ] bi
         append
     ] if ;
@@ -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/inverse/inverse-tests.factor

@@ -83,3 +83,9 @@ C: <nil> nil
 [ [ sqrt ] ] [ [ sq ] [undo] ] unit-test
 [ [ not ] ] [ [ not ] [undo] ] unit-test
 [ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] undo ] unit-test
+
+TUPLE: funny-tuple ;
+: <funny-tuple> ( -- funny-tuple ) \ funny-tuple boa ;
+: funny-tuple ( -- ) "OOPS" throw ;
+
+[ ] [ [ <funny-tuple> ] [undo] drop ] unit-test

basis/inverse/inverse.factor

@@ -12,7 +12,7 @@ IN: inverse
 ERROR: fail ;
 M: fail summary drop "Matching failed" ;
 
-: assure ( ? -- ) [ fail ] unless ;
+: assure ( ? -- ) [ fail ] unless ; inline
 
 : =/fail ( obj1 obj2 -- ) = assure ;
 
@@ -74,7 +74,9 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
 
 : fold-word ( stack word -- stack )
     2dup enough?
-    [ 1quotation with-datastack ] [ [ % ] [ , ] bi* { } ] if ;
+    [ 1quotation with-datastack ]
+    [ [ [ literalize , ] each ] [ , ] bi* { } ]
+    if ;
 
 : fold ( quot -- folded-quot )
     [ { } [ fold-word ] reduce % ] [ ] make ; 
@@ -217,9 +219,7 @@ DEFER: _
     "predicate" word-prop [ dupd call assure ] curry ;
 
 : slot-readers ( class -- quot )
-    all-slots
+    all-slots [ name>> reader-word 1quotation ] map [ cleave ] curry ;
-    [ name>> reader-word 1quotation [ keep ] curry ] map concat
-    [ ] like [ drop ] compose ;
 
 : ?wrapped ( object -- wrapped )
     dup wrapper? [ wrapped>> ] when ;

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

@@ -15,13 +15,20 @@ HELP: each-file
     }
 } ;
 
-HELP: recursive-directory
+HELP: recursive-directory-files
 { $values
      { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
      { "paths" "a sequence of pathname strings" }
 }
 { $description "Traverses a directory path recursively and returns a sequence of files in a breadth-first or depth-first manner." } ;
 
+HELP: recursive-directory-entries
+{ $values
+     { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" }
+     { "directory-entries" "a sequence of directory-entries" }
+}
+{ $description "Traverses a directory path recursively and returns a sequence of directory-entries in a breadth-first or depth-first manner." } ;
+
 HELP: find-file
 { $values
      { "path" "a pathname string" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
@@ -41,11 +48,11 @@ HELP: find-all-files
      { "path" "a pathname string" } { "quot" quotation }
      { "paths/f" "a sequence of pathname strings or f" }
 }
-{ $description "Finds all files in the input directory matching the predicate quotation in a breadth-first or depth-first traversal." } ;
+{ $description "Recursively finds all files in the input directory matching the predicate quotation." } ;
 
 HELP: find-all-in-directories
 { $values
-     { "directories" "a sequence of directory paths" } { "bfs?" "a boolean, breadth-first or depth-first" } { "quot" quotation }
+     { "directories" "a sequence of directory paths" } { "quot" quotation }
      { "paths/f" "a sequence of pathname strings or f" }
 }
 { $description "Finds all files in the input directories matching the predicate quotation in a breadth-first or depth-first traversal." } ;
@@ -55,7 +62,8 @@ HELP: find-all-in-directories
 ARTICLE: "io.directories.search" "Searching directories"
 "The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
 "Traversing directories:"
-{ $subsection recursive-directory }
+{ $subsection recursive-directory-files }
+{ $subsection recursive-directory-entries }
 { $subsection each-file }
 "Finding files:"
 { $subsection find-file }