Merge branch 'master' into irc

.gitignore

@@ -25,3 +25,5 @@ build-support/wordsize
 .#*
 *.swo
 checksums.txt
+*.so
+a.out

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
@@ -151,17 +150,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:

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/alien/libraries/libraries-docs.factor

@@ -58,3 +58,10 @@ $nl
     "} cond >>"
 }
 "Note the parse time evaluation with " { $link POSTPONE: << } "." } ;
+
+ARTICLE: "loading-libs" "Loading native libraries"
+"Before calling a C library, you must associate its path name on disk with a logical name which Factor uses to identify the library:"
+{ $subsection add-library }
+"Once a library has been defined, you can try loading it to see if the path name is correct:"
+{ $subsection load-library }
+"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again." ;

basis/alien/parser/parser.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien alien.c-types arrays assocs effects grouping kernel
-parser sequences splitting words fry locals ;
+parser sequences splitting words fry locals lexer namespaces ;
 IN: alien.parser
 
 : parse-arglist ( parameters return -- types effect )
@@ -12,8 +12,15 @@ IN: alien.parser
 : function-quot ( return library function types -- quot )
     '[ _ _ _ _ alien-invoke ] ;
 
-:: define-function ( return library function parameters -- )
+:: make-function ( return library function parameters -- word quot effect )
     function create-in dup reset-generic
     return library function
-    parameters return parse-arglist [ function-quot ] dip
+    parameters return parse-arglist [ function-quot ] dip ;
-    define-declared ;
+
+: (FUNCTION:) ( -- word quot effect )
+    scan "c-library" get scan ";" parse-tokens
+    [ "()" subseq? not ] filter
+    make-function ;
+
+: define-function ( return library function parameters -- )
+    make-function define-declared ;

basis/alien/syntax/syntax.factor

@@ -16,9 +16,7 @@ SYNTAX: BAD-ALIEN <bad-alien> parsed ;
 SYNTAX: LIBRARY: scan "c-library" set ;
 
 SYNTAX: FUNCTION:
-    scan "c-library" get scan ";" parse-tokens
+    (FUNCTION:) define-declared ;
-    [ "()" subseq? not ] filter
-    define-function ;
 
 SYNTAX: TYPEDEF:
     scan scan typedef ;

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/finish-bootstrap.factor

@@ -8,7 +8,7 @@ namespaces eval kernel vocabs.loader io ;
         (command-line) parse-command-line
         load-vocab-roots
         run-user-init
-        "e" get [ eval ] when*
+        "e" get [ eval( -- ) ] when*
         ignore-cli-args? not script get and
         [ run-script ] [ "run" get run ] if*
         output-stream get [ stream-flush ] when*

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

@@ -4,7 +4,7 @@ USING: accessors init namespaces words words.symbol io
 kernel.private math memory continuations kernel io.files
 io.pathnames io.backend system parser vocabs sequences
 vocabs.loader combinators splitting source-files strings
-definitions assocs compiler.errors compiler.units math.parser
+definitions assocs compiler.units math.parser
 generic sets command-line ;
 IN: bootstrap.stage2
 
@@ -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,18 +68,19 @@ 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
 
-    [
+    load-components
-        load-components
 
-        millis over - core-bootstrap-time set-global
+    millis over - core-bootstrap-time set-global
 
-        run-bootstrap-init
+    run-bootstrap-init
-    ] with-compiler-errors
-    :errors
 
     f error set-global
     f error-continuation set-global

basis/bootstrap/tools/tools.factor

@@ -6,6 +6,7 @@ IN: bootstrap.tools
     "bootstrap.image"
     "tools.annotations"
     "tools.crossref"
+    "tools.errors"
     "tools.deploy"
     "tools.disassembler"
     "tools.memory"

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 -
+    day 153 m * 2 + 5 /i + 365 y * +
-    ] ;
+    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 +
+    100 b * d + 4800 -
-        12 m 10 /i * -
+    m 10 /i + m 3 +
-        e 153 m * 2 + 5 /i - 1+
+    12 m 10 /i * -
-    ] ;
+    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/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

@@ -5,6 +5,7 @@ kernel kernel.private layouts assocs words summary arrays
 combinators classes.algebra alien alien.c-types alien.structs
 alien.strings alien.arrays alien.complex sets libc alien.libraries
 continuations.private fry cpu.architecture
+source-files.errors
 compiler.errors
 compiler.alien
 compiler.cfg
@@ -374,47 +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 compiler-error-type
-    drop +linkage+ ;
-
-: 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 compiler-error-type
-    drop +linkage+ ;
-
-: 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

@@ -1,5 +1,7 @@
-USING: help.markup help.syntax words io parser
+USING: assocs compiler.cfg.builder compiler.cfg.optimizer
-assocs words.private sequences compiler.units quotations ;
+compiler.errors compiler.tree.builder compiler.tree.optimizer
+compiler.units help.markup help.syntax io parser quotations
+sequences words words.private ;
 IN: compiler
 
 HELP: enable-compiler
@@ -18,6 +20,24 @@ ARTICLE: "compiler-usage" "Calling the optimizing compiler"
 { $subsection compile-call }
 "Higher-level words can be found in " { $link "compilation-units" } "." ;
 
+ARTICLE: "compiler-impl" "Compiler implementation"
+"The " { $vocab-link "compiler" } "vocabulary, in addition to providing the user-visible words of the compiler, implements the main compilation loop."
+$nl
+"Words are added to the " { $link compile-queue } " variable as needed and compiled."
+{ $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 } " word performs the actual task of compiling an individual word. The process proceeds as follows:"
+{ $list
+  { "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 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
+"Calling " { $link modify-code-heap } " is handled not by the " { $vocab-link "compiler" } " vocabulary, but rather " { $vocab-link "compiler.units" } ". The optimizing compiler merely provides an implementation of the " { $link recompile } " generic word." ;
+
 ARTICLE: "compiler" "Optimizing compiler"
 "Factor includes two compilers which work behind the scenes. Words are always compiled, and the compilers do not have to be invoked explicitly. For the most part, compilation is fully transparent. However, there are a few things worth knowing about the compilation process."
 $nl
@@ -26,12 +46,13 @@ $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" } ;
+{ $subsection "compiler-usage" }
+{ $subsection "compiler-impl" } ;
 
 ABOUT: "compiler"
 
@@ -39,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 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,59 +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 -- ? )
-    [ [ inline? ] [ macro? ] bi or ]
+    #! Ignore some errors on inline combinators, macros, and special
-    [ compiler-error-type +warning+ eq? ] bi* and ;
+    #! words such as 'call'.
-
-: fail ( word error -- * )
-    [ 2dup ignore-error? [ 2drop ] [ swap compiler-error ] if ]
     [
+        {
+            [ macro? ]
+            [ inline? ]
+            [ "special" word-prop ]
+            [ "no-compile" word-prop ]
+        } 1||
+    ] [
+        {
+            [ do-not-compile? ]
+            [ literal-expected? ]
+        } 1||
+    ] bi* and ;
+
+: 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 ]
+    [
+        dup crossref? [
+            dependencies get
+            generic-dependencies get
+            compiled-xref
+        ] [ drop ] if
+    ] tri ;
+
+: deoptimize-with ( word def -- * )
+    #! 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
-        [ compiled-unxref ]
+        [ dup def>> deoptimize-with ]
-        [ f swap compiled get set-at ]
+        [ clear-compiler-error ]
-        [ +unoptimized+ save-compiled-status ]
+        bi
-        tri
+    ] [
-    ] 2bi
+        [ swap <compiler-error> compiler-error ]
-    return ;
+        [ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
+        2bi
+    ] if ;
 
 : frontend ( word -- nodes )
-    [ build-tree-from-word ] [ fail ] recover optimize-tree ;
+    #! If the word contains breakpoints, don't optimize it, since
+    #! 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 -- )
@@ -91,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 ]
@@ -114,14 +145,16 @@ 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 ;
 
+\ compile-call t "no-compile" set-word-prop
+
 SINGLETON: optimizing-compiler
 
 M: optimizing-compiler recompile ( words -- alist )
@@ -140,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-docs.factor

@@ -0,0 +1,5 @@
+IN: compiler.errors
+USING: help.markup help.syntax vocabs.loader words io
+quotations words.symbol ;
+
+ABOUT: "compiler-errors"

basis/compiler/errors/errors.factor

@@ -0,0 +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 fry
+summary ;
+IN: compiler.errors
+
+SYMBOL: +compiler-error+
+SYMBOL: compiler-errors
+
+compiler-errors [ H{ } clone ] initialize
+
+TUPLE: compiler-error < source-file-error ;
+
+M: compiler-error error-type drop +compiler-error+ ;
+
+SYMBOL: +linkage-error+
+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-errors get values ] }
+   { forget-quot [ compiler-errors get delete-at ] }
+} define-error-type
+
+: <compiler-error> ( error word -- compiler-error )
+    \ compiler-error <definition-error> ;
+
+: <linkage-error> ( error word -- linkage-error )
+    \ linkage-error <definition-error> ;
+
+: linkage-error ( error word class -- )
+    '[ _ 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-errors get values ] }
+   { forget-quot [ linkage-errors get delete-at ] }
+   { fatal? f }
+} define-error-type
+
+TUPLE: no-such-library name ;
+
+M: no-such-library summary drop "Library not found" ;
+
+: 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
@@ -281,4 +281,4 @@ TUPLE: cucumber ;
 
 M: cucumber equal? "The cucumber has no equal" throw ;
 
-[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test
+[ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test

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.
 
@@ -12,7 +12,7 @@ IN: compiler.tests
     IN: compiler.tests.folding
     GENERIC: foldable-generic ( a -- b ) foldable
     M: integer foldable-generic f <array> ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -20,7 +20,7 @@ IN: compiler.tests
     USING: math arrays ;
     IN: compiler.tests.folding
     : fold-test ( -- x ) 10 foldable-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ t ] [

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' )
@@ -12,4 +12,4 @@ Regexp = Times:t => [[ t <times> ]]
 
 ;EBNF
 
-[ "foo" ] [ "a" parse-regexp ] unit-test
+[ "foo" ] [ "a" parse-regexp ] unit-test

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.
 
@@ -13,7 +13,7 @@ IN: compiler.tests
     MIXIN: my-mixin
     INSTANCE: fixnum my-mixin
     : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -21,7 +21,7 @@ IN: compiler.tests
     USE: math
     IN: compiler.tests.redefine10
     INSTANCE: float my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 2.0 ] [

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.
 
@@ -17,7 +17,7 @@ IN: compiler.tests
     M: my-mixin my-generic drop 0 ;
     M: object my-generic drop 1 ;
     : my-inline ( -- b ) { } my-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [

basis/compiler/tests/redefine12.factor

@@ -15,6 +15,6 @@ M: object g drop t ;
 
 TUPLE: jeah ;
 
-[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" eval ] unit-test
+[ ] [ "USE: kernel IN: compiler.tests.redefine12 M: jeah g drop f ;" eval( -- ) ] unit-test
 
 [ f ] [ T{ jeah } h ] unit-test

basis/compiler/tests/redefine15.factor

@@ -17,4 +17,4 @@ DEFER: word-1
 
 [ \ word-3 [ [ 2 + ] bi@ ] (( a b -- c d )) define-declared ] with-compilation-unit
 
-[ 2 3 ] [ 0 word-4 ] unit-test
+[ 2 3 ] [ 0 word-4 ] 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/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.
@@ -14,7 +14,7 @@ IN: compiler.tests
     GENERIC: my-generic ( a -- b )
     M: object my-generic [ <=> ] sort ;
     : my-inline ( a -- b ) my-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -23,7 +23,7 @@ IN: compiler.tests
     IN: compiler.tests.redefine5
     TUPLE: my-tuple ;
     M: my-tuple my-generic drop 0 ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 0 ] [

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.
 
@@ -14,7 +14,7 @@ IN: compiler.tests
     MIXIN: my-mixin
     M: my-mixin my-generic drop 0 ;
     : my-inline ( a -- b ) { my-mixin } declare my-generic ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -24,7 +24,7 @@ IN: compiler.tests
     TUPLE: my-tuple ;
     M: my-tuple my-generic drop 1 ;
     INSTANCE: my-tuple my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 1 ] [

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.
 
@@ -13,7 +13,7 @@ IN: compiler.tests
     MIXIN: my-mixin
     INSTANCE: fixnum my-mixin
     : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -21,7 +21,7 @@ IN: compiler.tests
     USE: math
     IN: compiler.tests.redefine7
     INSTANCE: float my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 2.0 ] [

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.
 
@@ -16,7 +16,7 @@ IN: compiler.tests
     ! We add the bogus quotation here to hinder inlining
     ! since otherwise we cannot trigger this bug.
     M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -24,7 +24,7 @@ IN: compiler.tests
     USE: math
     IN: compiler.tests.redefine8
     INSTANCE: float my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ 2.0 ] [

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.
 
@@ -16,7 +16,7 @@ IN: compiler.tests
     ! We add the bogus quotation here to hinder inlining
     ! since otherwise we cannot trigger this bug.
     M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [ ] [
@@ -25,7 +25,7 @@ IN: compiler.tests
     IN: compiler.tests.redefine9
     TUPLE: my-tuple ;
     INSTANCE: my-tuple my-mixin
-    "> eval
+    "> eval( -- )
 ] unit-test
 
 [

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
@@ -237,6 +235,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
 10 [
     [ "compiler.tests.foo" forget-vocab ] with-compilation-unit
     [ t ] [
-        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval
+        "USING: prettyprint words accessors ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline recursive : recursive ( -- ) (recursive) ; \\ (recursive) optimized>>" eval( -- obj )
     ] unit-test
 ] times

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,49 +11,58 @@ 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 ;
 
 : check-no-compile ( word -- )
-    dup "no-compile" word-prop [ cannot-infer-effect ] [ 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)
+    [ check-no-compile ]
+    [ word-body infer-quot-here ]
+    [ current-effect check-effect ] tri ;
+
+: build-tree-with ( in-stack word/quot -- nodes )
     [
-        [
+        <recursive-state> recursive-state set
-            {
+        V{ } clone stack-visitor set
-                [ check-cannot-infer ]
+        [ [ >vector \ meta-d set ] [ length d-in set ] bi ]
-                [ check-no-compile ]
+        [ (build-tree) ]
-                [ (build-tree-from-word) ]
+        bi*
-                [ finish-word ]
+    ] with-infer nip ;
-            } cleave
+
-        ] maybe-cannot-infer
+PRIVATE>
-    ] 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/cleanup/cleanup-tests.factor

@@ -197,7 +197,7 @@ M: fixnum annotate-entry-test-1 drop ;
         [ dup annotate-entry-test-1 1+ ] dip (annotate-entry-test-2)
     ] if ; inline recursive
 
-: annotate-entry-test-2 ( from to -- ) 0 -rot (annotate-entry-test-2) ; inline
+: annotate-entry-test-2 ( from to -- obj ) 0 -rot (annotate-entry-test-2) ; inline
 
 [ f ] [
     [ { bignum } declare annotate-entry-test-2 ]
@@ -302,7 +302,7 @@ cell-bits 32 = [
 ] unit-test
 
 [ t ] [
-    [ 1000 [ 1+ ] map ] { 1+ fixnum+ } inlined?
+    [ 1000 iota [ 1+ ] map ] { 1+ fixnum+ } inlined?
 ] unit-test
 
 : rec ( a -- b )
@@ -519,4 +519,4 @@ cell-bits 32 = [
 [ t ] [
     [ { integer integer } declare + drop ]
     { + +-integer-integer } inlined?
-] unit-test
+] unit-test

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
@@ -17,13 +14,13 @@ sequences accessors tools.test kernel math ;
 
 [ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
 
-: foo ( -- ) swap ; inline recursive
+: foo ( quot: ( -- ) -- ) call ; inline recursive
 
 : recursive-inputs ( nodes -- n )
     [ #recursive? ] find nip child>> first in-d>> length ;
 
-[ 0 2 ] [
+[ 1 3 ] [
-    [ foo ] build-tree
+    [ [ swap ] foo ] build-tree
     [ recursive-inputs ]
     [ analyze-recursive normalize recursive-inputs ] bi
 ] unit-test
@@ -34,18 +31,18 @@ sequences accessors tools.test kernel math ;
 [ ] [ [ [ 1 ] [ 2 ] if + * ] test-normalization ] unit-test
 
 DEFER: bbb
-: aaa ( x -- ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
+: aaa ( obj x -- obj ) dup [ dup [ bbb ] dip aaa ] [ drop ] if ; inline recursive
-: bbb ( x -- ) [ drop 0 ] dip aaa ; inline recursive
+: bbb ( obj x -- obj ) [ drop 0 ] dip aaa ; inline recursive
 
 [ ] [ [ bbb ] test-normalization ] unit-test
 
-: ccc ( -- ) ccc drop 1 ; inline recursive
+: ccc ( obj -- 1 ) ccc drop 1 ; inline recursive
 
 [ ] [ [ ccc ] test-normalization ] unit-test
 
 DEFER: eee
-: ddd ( -- ) eee ; inline recursive
+: ddd ( a b -- a b ) eee ; inline recursive
-: eee ( -- ) swap ddd ; inline recursive
+: eee ( a b -- a b ) swap ddd ; inline recursive
 
 [ ] [ [ eee ] test-normalization ] 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,6 +18,12 @@ 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
@@ -30,10 +36,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,19 +147,21 @@ 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*
     ] sum-outputs ;
 
 : should-inline? ( #call word -- ? )
-    dup "inline" word-prop [ 2drop t ] [ inlining-rank 5 >= ] if ;
+    {
+        { [ dup contains-breakpoints? ] [ 2drop f ] }
+        { [ dup "inline" word-prop ] [ 2drop t ] }
+        [ inlining-rank 5 >= ]
+    } cond ;
 
 SYMBOL: history
 
@@ -157,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 ;
 
@@ -177,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 ;
@@ -187,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
@@ -202,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
@@ -680,11 +678,11 @@ TUPLE: littledan-2 { from read-only } { to read-only } ;
 : (littledan-3-test) ( x -- )
     length 1+ f <array> (littledan-3-test) ; inline recursive
 
-: littledan-3-test ( x -- )
+: littledan-3-test ( -- )
     0 f <array> (littledan-3-test) ; inline
 
 [ ] [ [ littledan-3-test ] final-classes drop ] unit-test
 
 [ V{ 0 } ] [ [ { } length ] final-literals ] unit-test
 
-[ V{ 1 } ] [ [ { } length 1+ f <array> length ] final-literals ] unit-test
+[ V{ 1 } ] [ [ { } length 1+ f <array> length ] final-literals ] 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
                           
@@ -57,7 +51,7 @@ compiler.tree.combinators ;
     \ (each-integer) label-is-loop?
 ] unit-test
 
-: loop-test-2 ( a -- )
+: loop-test-2 ( a b -- a' )
     dup [ 1+ loop-test-2 1- ] [ drop ] if ; inline recursive
 
 [ t ] [

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/concurrency/exchangers/exchangers-tests.factor

@@ -3,7 +3,7 @@ USING: sequences tools.test concurrency.exchangers
 concurrency.count-downs concurrency.promises locals kernel
 threads ;
 
-:: exchanger-test ( -- )
+:: exchanger-test ( -- string )
     [let |
         ex [ <exchanger> ]
         c [ 2 <count-down> ]

basis/concurrency/flags/flags-tests.factor

@@ -11,7 +11,7 @@ kernel threads locals accessors calendar ;
 
 [ f ] [ flag-test-1 ] unit-test
 
-:: flag-test-2 ( -- )
+:: flag-test-2 ( -- ? )
     [let | f [ <flag> ] |
         [ 1 seconds sleep f raise-flag ] "Flag test" spawn drop
         f lower-flag

basis/concurrency/promises/promises-docs.factor

@@ -7,6 +7,10 @@ IN: concurrency.promises
 HELP: promise
 { $class-description "The class of write-once promises." } ;
 
+HELP: <promise>
+{ $values { "promise" promise } }
+{ $description "Creates a new promise which may be fulfilled by calling " { $link fulfill } "." } ;
+
 HELP: promise-fulfilled?
 { $values { "promise" promise } { "?" "a boolean" } }
 { $description "Tests if " { $link fulfill } " has previously been called on the promise, in which case " { $link ?promise } " will return immediately without blocking." } ;

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/cpu/ppc/bootstrap.factor

@@ -310,7 +310,7 @@ CONSTANT: rs-reg 30
     4 ds-reg 0 LWZ
     5 ds-reg -4 LWZU
     5 0 4 CMP
-    2 swap execute ! magic number
+    2 swap execute( offset -- ) ! magic number
     \ f tag-number 3 LI
     3 ds-reg 0 STW ;
 
@@ -341,7 +341,7 @@ CONSTANT: rs-reg 30
 : jit-math ( insn -- )
     3 ds-reg 0 LWZ
     4 ds-reg -4 LWZU
-    [ 5 3 4 ] dip execute
+    [ 5 3 4 ] dip execute( dst src1 src2 -- )
     5 ds-reg 0 STW ;
 
 [ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive

basis/cpu/x86/bootstrap.factor

@@ -334,7 +334,7 @@ big-endian off
     ! compare with second value
     ds-reg [] temp0 CMP
     ! move t if true
-    [ temp1 temp3 ] dip execute
+    [ temp1 temp3 ] dip execute( dst src -- )
     ! store
     ds-reg [] temp1 MOV ;
 
@@ -355,7 +355,7 @@ big-endian off
     ! pop stack
     ds-reg bootstrap-cell SUB
     ! compute result
-    [ ds-reg [] temp0 ] dip execute ;
+    [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 
 [ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
 

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

@@ -8,8 +8,9 @@ classes.mixin classes.tuple continuations continuations.private
 combinators generic.math classes.builtin classes compiler.units
 generic.standard vocabs init kernel.private io.encodings
 accessors math.order destructors source-files parser
-classes.tuple.parser effects.parser lexer compiler.errors
+classes.tuple.parser effects.parser lexer
-generic.parser strings.parser vocabs.loader vocabs.parser ;
+generic.parser strings.parser vocabs.loader vocabs.parser see
+source-files.errors ;
 IN: debugger
 
 GENERIC: error. ( error -- )
@@ -87,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 .
@@ -126,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.               ] }
@@ -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" ;
@@ -213,14 +215,13 @@ M: condition error-help error>> error-help ;
 
 M: assert summary drop "Assertion failed" ;
 
-M: assert error.
+M: assert-sequence summary drop "Assertion failed" ;
-    "Assertion failed" print
+
+M: assert-sequence error.
     standard-table-style [
-        15 length-limit set
+        [ "=== Expected:" print expected>> stack. ]
-        5 line-limit set
+        [ "=== Got:" print got>> stack. ] bi
-        [ expect>> [ [ "Expect:" write ] with-cell pprint-cell ] with-row ]
+    ] tabular-output ;
-        [ got>> [ [ "Got:" write ] with-cell pprint-cell ] with-row ] bi
-    ] tabular-output nl ;
 
 M: immutable summary drop "Sequence is immutable" ;
 
@@ -268,20 +269,6 @@ M: duplicate-slot-names summary
 M: invalid-slot-name summary
     drop "Invalid slot name" ;
 
-: file. ( file -- ) path>> <pathname> . ;
-
-M: source-file-error error.
-    [ file>> file. ] [ error>> error. ] bi ;
-
-M: source-file-error summary
-    error>> summary ;
-
-M: source-file-error compute-restarts
-    error>> compute-restarts ;
-
-M: source-file-error error-help
-    error>> error-help ;
-
 M: not-in-a-method-error summary
     drop "call-next-method can only be called in a method definition" ;
 
@@ -309,12 +296,6 @@ M: lexer-error compute-restarts
 M: lexer-error error-help
     error>> error-help ;
 
-M: object compiler-error. ( error word -- )
-    nl
-    "While compiling " write pprint ": " print
-    nl
-    print-error ;
-
 M: bad-effect summary
     drop "Bad stack effect declaration" ;
 
@@ -326,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/delegate/delegate-tests.factor

@@ -35,7 +35,7 @@ M: hello bing hello-test ;
 [ 3 ] [ 1 0 <hello> 2 whoa ] unit-test
 [ 3 ] [ 1 0 <hello> f <goodbye> 2 whoa ] unit-test
 
-[ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval ] times ] unit-test
+[ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval( -- ) ] times ] unit-test
 [ H{ { goodbye T{ consultation f baz goodbye [ these>> ] } } } ] [ baz protocol-consult ] unit-test
 [ H{ } ] [ bee protocol-consult ] unit-test
 
@@ -63,22 +63,22 @@ CONSULT: beta hey value>> 1- ;
 [ 0 ] [ 1 <hey> three ] unit-test
 [ { hey } ] [ alpha protocol-users ] unit-test
 [ { hey } ] [ beta protocol-users ] unit-test
-[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" eval ] unit-test
+[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: alpha one ;" eval( -- ) ] unit-test
 [ f ] [ hey \ two method ] unit-test
 [ f ] [ hey \ four method ] unit-test
-[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" eval ] unit-test
+[ ] [ "USE: delegate IN: delegate.tests PROTOCOL: beta two three four ;" eval( -- ) ] unit-test
 [ { hey } ] [ alpha protocol-users ] unit-test
 [ { hey } ] [ beta protocol-users ] unit-test
 [ 2 ] [ 1 <hey> one ] unit-test
 [ 0 ] [ 1 <hey> two ] unit-test
 [ 0 ] [ 1 <hey> three ] unit-test
 [ 0 ] [ 1 <hey> four ] unit-test
-[ ] [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" eval ] unit-test
+[ ] [ "USING: math accessors delegate ; IN: delegate.tests CONSULT: beta hey value>> 2 - ;" eval( -- ) ] unit-test
 [ 2 ] [ 1 <hey> one ] unit-test
 [ -1 ] [ 1 <hey> two ] unit-test
 [ -1 ] [ 1 <hey> three ] unit-test
 [ -1 ] [ 1 <hey> four ] unit-test
-[ ] [ "IN: delegate.tests FORGET: alpha" eval ] unit-test
+[ ] [ "IN: delegate.tests FORGET: alpha" eval( -- ) ] unit-test
 [ f ] [ hey \ one method ] unit-test
 
 TUPLE: slot-protocol-test-1 a b ;
@@ -196,4 +196,4 @@ DEFER: seq-delegate
     seq-delegate
     sequence-protocol \ protocol-consult word-prop
     key?
-] unit-test
+] unit-test

basis/editors/editors-docs.factor

@@ -1,4 +1,5 @@
-USING: help.markup help.syntax parser source-files vocabs.loader ;
+USING: help.markup help.syntax parser source-files
+source-files.errors vocabs.loader ;
 IN: editors
 
 ARTICLE: "editor" "Editor integration"
@@ -13,6 +14,9 @@ ARTICLE: "editor" "Editor integration"
 
 ABOUT: "editor"
 
+HELP: edit-hook
+{ $var-description "A quotation with stack effect " { $snippet "( file line -- )" } ". If not set, the " { $link edit } " word throws a condition with restarts for loading one of the sub-vocabularies of the " { $vocab-link "editors" } " vocabulary." } ;
+
 HELP: edit
 { $values { "defspec" "a definition specifier" } }
 { $description "Opens the source file containing the definition using the current " { $link edit-hook } ". See " { $link "editor" } "." }

basis/editors/editors.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser lexer kernel namespaces sequences definitions
+USING: parser lexer kernel namespaces sequences definitions io.files
-io.files io.backend io.pathnames io summary continuations
+io.backend io.pathnames io summary continuations tools.crossref
-tools.crossref tools.vocabs prettyprint source-files assocs
+tools.vocabs prettyprint source-files source-files.errors assocs
 vocabs vocabs.loader splitting accessors debugger prettyprint
 help.topics ;
 IN: editors
@@ -57,7 +57,7 @@ M: lexer-error error-line
     [ error>> error-line ] [ line>> ] bi or ;
 
 M: source-file-error error-file
-    [ error>> error-file ] [ file>> path>> ] bi or ;
+    [ error>> error-file ] [ file>> ] bi or ;
 
 M: source-file-error error-line
     error>> error-line ;
@@ -81,6 +81,9 @@ M: object error-line
 : :edit ( -- )
     error get (:edit) ;
 
+: edit-error ( error -- )
+    [ file>> ] [ line#>> ] bi 2dup and [ edit-location ] [ 2drop ] if ;
+
 : edit-each ( seq -- )
     [
         [ "Editing " write . ]

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"