Merge branch 'master' of git://factorcode.org/git/factor into autouse-existing-usings

.gitignore

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

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/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

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

basis/calendar/calendar-tests.factor

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

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

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

basis/combinators/smart/smart-tests.factor

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

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

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

basis/compiler/cfg/debugger/debugger.factor

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

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

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

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

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

basis/compiler/compiler-docs.factor

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

basis/compiler/compiler.factor

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

basis/compiler/errors/errors-docs.factor

@@ -2,33 +2,4 @@ IN: compiler.errors
 USING: help.markup help.syntax vocabs.loader words io
 quotations words.symbol ;
 
-ARTICLE: "compiler-errors" "Compiler warnings and errors"
-"After loading a vocabulary, you might see messages like:"
-{ $code
-    ":errors - print 2 compiler errors"
-    ":warnings - print 50 compiler warnings"
-}
-"These messages arise from the compiler's stack effect checker. Production code should not have any warnings and errors in it. Warning and error conditions are documented in " { $link "inference-errors" } "."
-$nl
-"Words to view warnings and errors:"
-{ $subsection :warnings }
-{ $subsection :errors }
-{ $subsection :linkage }
-"Compiler warnings and errors are reported using the " { $link "tools.errors" } " mechanism and are shown in the " { $link "ui.tools.error-list" } "." ;
-
-HELP: compiler-error
-{ $values { "error" "an error" } { "word" word } }
-{ $description "Saves the error for future persual via " { $link :errors } ", " { $link :warnings } " and " { $link :linkage } "." } ;
-
-HELP: :errors
-{ $description "Prints all serious compiler errors from the most recent compile to " { $link output-stream } "." } ;
-
-HELP: :warnings
-{ $description "Prints all ignorable compiler warnings from the most recent compile to " { $link output-stream } "." } ;
-
-HELP: :linkage
-{ $description "Prints all C library interface linkage errors from the most recent compile to " { $link output-stream } "." } ;
-
-{ :errors :warnings } related-words
-
 ABOUT: "compiler-errors"

basis/compiler/errors/errors.factor

@@ -1,7 +1,6 @@
 ! 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 ;
-tools.errors ;
 IN: compiler.errors
 
 TUPLE: compiler-error < source-file-error ;
@@ -44,6 +43,7 @@ T{ error-type
    { icon "vocab:ui/tools/error-list/icons/linkage-error.tiff" }
    { quot [ +linkage-error+ errors-of-type values ] }
    { forget-quot [ compiler-errors get delete-at ] }
+   { fatal? f }
 } define-error-type
 
 : <compiler-error> ( error word -- compiler-error )
@@ -53,11 +53,4 @@ T{ error-type
     compiler-errors get-global pick
     [ [ [ <compiler-error> ] keep ] dip set-at ] [ delete-at drop ] if ;
 
-: compiler-errors. ( type -- )
+ERROR: not-compiled word error ;
-    errors-of-type values errors. ;
-
-: :errors ( -- ) +compiler-error+ compiler-errors. ;
-
-: :warnings ( -- ) +compiler-warning+ compiler-errors. ;
-
-: :linkage ( -- ) +linkage-error+ compiler-errors. ;

basis/compiler/tests/folding.factor

@@ -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/optimizer.factor

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

basis/compiler/tests/redefine0.factor

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

basis/compiler/tests/redefine1.factor

@@ -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 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 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

@@ -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

@@ -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/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

@@ -5,7 +5,7 @@ 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 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

@@ -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 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

@@ -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 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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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/simple.factor

@@ -3,8 +3,6 @@ sequences.private math.private math combinators strings alien
 arrays memory vocabs parser eval ;
 IN: compiler.tests
 
-\ (compile) must-infer
-
 ! Test empty word
 [ ] [ [ ] compile-call ] unit-test
 
@@ -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>>" (( -- obj )) 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/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,60 @@ stack-checker.backend
 stack-checker.recursive-state ;
 IN: compiler.tree.builder
 
-: with-tree-builder ( quot -- nodes )
+<PRIVATE
-    '[ V{ } clone stack-visitor set @ ]
-    with-infer nip ; inline
 
-: build-tree ( quot -- nodes )
+GENERIC: (build-tree) ( quot -- )
-    #! Not safe to call from inference transforms.
-    [ f initial-recursive-state infer-quot ] with-tree-builder ;
 
-: build-tree-with ( in-stack quot -- nodes out-stack )
+M: callable (build-tree) f initial-recursive-state infer-quot ;
-    #! Not safe to call from inference transforms.
-    [
-        [ >vector \ meta-d set ]
-        [ f initial-recursive-state infer-quot ] bi*
-    ] with-tree-builder
-    unclip-last in-d>> ;
-
-: build-sub-tree ( #call quot -- nodes )
-    [ [ out-d>> ] [ in-d>> ] bi ] dip build-tree-with
-    over ends-with-terminate?
-    [ drop swap [ f swap #push ] map append ]
-    [ rot #copy suffix ]
-    if ;
-
-: (build-tree-from-word) ( word -- )
-    dup initial-recursive-state recursive-state set
-    dup [ "inline" word-prop ] [ "recursive" word-prop ] bi and
-    [ 1quotation ] [ specialized-def ] if
-    infer-quot-here ;
-
-: check-cannot-infer ( word -- )
-    dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ;
-
-TUPLE: do-not-compile word ;
 
 : check-no-compile ( word -- )
-    dup "no-compile" word-prop [ do-not-compile inference-warning ] [ drop ] if ;
+    dup "no-compile" word-prop [ do-not-compile ] [ drop ] if ;
 
-: build-tree-from-word ( word -- nodes )
+: check-effect ( word effect -- )
-    [
+    swap required-stack-effect 2dup effect<=
-        [
+    [ 2drop ] [ effect-error ] if ;
+
+: inline-recursive? ( word -- ? )
+    [ "inline" word-prop ] [ "recursive" word-prop ] bi and ;
+
+: word-body ( word -- quot )
+    dup inline-recursive? [ 1quotation ] [ specialized-def ] if ;
+
+M: word (build-tree)
     {
-                [ check-cannot-infer ]
+        [ initial-recursive-state recursive-state set ]
         [ check-no-compile ]
-                [ (build-tree-from-word) ]
+        [ word-body infer-quot-here ]
-                [ finish-word ]
+        [ current-effect check-effect ]
-            } cleave
+    } cleave ;
-        ] maybe-cannot-infer
+
-    ] with-tree-builder ;
+: build-tree-with ( in-stack word/quot -- nodes )
+    [
+        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.
+    specialize-method? off
+    [
+        #call in-d>> word/quot build-tree-with unclip-last in-d>> :> in-d
+        {
+            { [ dup not ] [ ] }
+            { [ dup ends-with-terminate? ] [ #call out-d>> [ f swap #push ] map append ] }
+            [ in-d #call out-d>> #copy suffix ]
+        } cond
+    ] [ dup inference-error? [ drop f ] [ rethrow ] if ] recover ;
 
 : contains-breakpoints? ( word -- ? )
     def>> [ word? ] filter [ "break?" word-prop ] any? ;

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

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

basis/compiler/tree/checker/checker.factor

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

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

@@ -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 )

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 ( a b -- b a ) 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

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

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

basis/compiler/tree/optimizer/optimizer.factor

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

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

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

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

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

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

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

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

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

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

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

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

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

basis/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

@@ -88,8 +88,7 @@ M: string error. print ;
 : divide-by-zero-error. ( obj -- )
     "Division by zero" print drop ;
 
-: signal-error. ( obj -- )
+HOOK: signal-error. os ( obj -- )
-    "Operating system signal " write third . ;
 
 : array-size-error. ( obj -- )
     "Invalid array size: " write dup third .
@@ -127,14 +126,14 @@ M: string error. print ;
 : primitive-error. ( error -- ) 
     "Unimplemented primitive" print drop ;
 
-PREDICATE: kernel-error < array
+PREDICATE: vm-error < array
     {
         { [ dup empty? ] [ drop f ] }
         { [ dup first "kernel-error" = not ] [ drop f ] }
         [ second 0 15 between? ]
     } cond ;
 
-: kernel-errors ( error -- n errors )
+: vm-errors ( error -- n errors )
     second {
         { 0  [ expired-error.          ] }
         { 1  [ io-error.               ] }
@@ -154,9 +153,11 @@ PREDICATE: kernel-error < array
         { 15 [ memory-error.           ] }
     } ; inline
 
-M: kernel-error error. dup kernel-errors case ;
+M: vm-error summary drop "VM error" ;
 
-M: kernel-error error-help kernel-errors at first ;
+M: vm-error error. dup vm-errors case ;
+
+M: vm-error error-help vm-errors at first ;
 
 M: no-method summary
     drop "No suitable method" ;
@@ -307,3 +308,8 @@ 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" ;
+
+{
+    { [ 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 ;

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" } ;
+
+"To quickly scaffold a " { $snippet ".emacs" } " file, run the following code:"
+{ $code "USE: tools.scaffold"
+    "scaffold-emacs"
+}
+
+{ $see-also "editor" }
+
+;
 
 ABOUT: "editors.emacs"

basis/editors/emacs/emacs.factor

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

basis/editors/emacs/windows/authors.txt

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

basis/editors/gedit/gedit.factor

@@ -0,0 +1,17 @@
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: editors io.launcher kernel make math.parser namespaces
+sequences ;
+IN: editors.gedit
+
+: gedit-path ( -- path )
+    \ gedit-path get-global [
+        "gedit"
+    ] unless* ;
+
+: gedit ( file line -- )
+    [
+        gedit-path , number>string "+" prepend , ,
+    ] { } make run-detached drop ;
+
+[ gedit ] edit-hook set-global

basis/editors/gedit/summary.txt

@@ -0,0 +1 @@
+gedit integration

basis/editors/gedit/tags.txt

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

basis/eval/eval-tests.factor

@@ -1,4 +1,6 @@
 IN: eval.tests
 USING: eval tools.test ;
 
+[ 4 ] [ "USE: math 2 2 +" eval( -- result ) ] unit-test
+[ "USE: math 2 2 +" eval( -- ) ] must-fail
 [ "4\n" ] [ "USING: math prettyprint ; 2 2 + ." eval>string ] unit-test

basis/fry/fry-tests.factor

@@ -56,7 +56,7 @@ sequences eval accessors ;
     3 '[ [ [ _ 1array ] call 1array ] call 1array ] call
 ] unit-test
 
-[ "USING: fry locals.backend ; f '[ load-local _ ]" (( -- quot )) eval ]
+[ "USING: fry locals.backend ; f '[ load-local _ ]" eval( -- quot ) ]
 [ error>> >r/r>-in-fry-error? ] must-fail-with
 
 [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [

basis/functors/functors-tests.factor

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

basis/furnace/auth/auth-tests.factor

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

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

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

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

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

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

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

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

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

basis/furnace/db/db-tests.factor

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

basis/generalizations/generalizations-docs.factor

@@ -272,8 +272,8 @@ HELP: nweave
 
 HELP: n*quot
 { $values
-     { "n" integer } { "seq" sequence }
+     { "n" integer } { "quot" quotation }
-     { "seq'" sequence }
+     { "quot'" quotation }
 }
 { $examples
     { $example "USING: generalizations prettyprint math ;"

basis/generalizations/generalizations.factor

@@ -7,7 +7,7 @@ IN: generalizations
 
 <<
 
-: n*quot ( n seq -- seq' ) <repetition> concat >quotation ;
+: n*quot ( n quot -- quot' ) <repetition> concat >quotation ;
 
 : repeat ( n obj quot -- ) swapd times ; inline
 

basis/hash2/hash2-tests.factor

@@ -6,9 +6,9 @@ IN: hash2.tests
 
 : sample-hash ( -- hash )
     5 <hash2>
-    dup 2 3 "foo" roll set-hash2
+    [ [ 2 3 "foo" ] dip set-hash2 ] keep
-    dup 4 2 "bar" roll set-hash2
+    [ [ 4 2 "bar" ] dip set-hash2 ] keep
-    dup 4 7 "other" roll set-hash2 ;
+    [ [ 4 7 "other" ] dip set-hash2 ] keep ;
 
 [ "foo" ] [ 2 3 sample-hash hash2 ] unit-test
 [ "bar" ] [ 4 2 sample-hash hash2 ] unit-test

basis/hash2/hash2.factor

@@ -1,4 +1,6 @@
-USING: kernel sequences arrays math vectors ;
+! Copyright (C) 2007 Daniel Ehrenberg
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences arrays math vectors locals ;
 IN: hash2
 
 ! Little ad-hoc datastructure used to map two numbers
@@ -22,8 +24,8 @@ IN: hash2
 : assoc2 ( a b alist -- value )
     (assoc2) dup [ third ] when ; inline
 
-: set-assoc2 ( value a b alist -- alist )
+:: set-assoc2 ( value a b alist -- alist )
-    [ rot 3array ] dip ?push ; inline
+    { a b value } alist ?push ; inline
 
 : hash2@ ( a b hash2 -- a b bucket hash2 )
     [ 2dup hashcode2 ] dip [ length mod ] keep ; inline
@@ -31,8 +33,8 @@ IN: hash2
 : hash2 ( a b hash2 -- value/f )
     hash2@ nth dup [ assoc2 ] [ 3drop f ] if ;
 
-: set-hash2 ( a b value hash2 -- )
+:: set-hash2 ( a b value hash2 -- )
-    [ -rot ] dip hash2@ [ set-assoc2 ] change-nth ;
+    value a b hash2 hash2@ [ set-assoc2 ] change-nth ;
 
 : alist>hash2 ( alist size -- hash2 )
     <hash2> [ over [ first3 ] dip set-hash2 ] reduce ; inline

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-tests.factor

@@ -4,7 +4,7 @@ definitions assocs sequences kernel namespaces parser arrays
 io.streams.string continuations debugger compiler.units eval ;
 
 [ ] [
-    "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" (( -- )) eval
+    "IN: help.crossref.tests USING: help.syntax help.markup ; : foo ( -- ) ; HELP: foo \"foo is great\" ; ARTICLE: \"foo\" \"Foo\" { $subsection foo } ;" eval( -- )
 ] unit-test
 
 [ $subsection ] [
@@ -23,7 +23,7 @@ io.streams.string continuations debugger compiler.units eval ;
 ] unit-test
 
 [ ] [
-    "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" (( -- )) eval
+    "IN: help.crossref.tests USING: help.syntax help.markup ; : bar ( -- ) ; HELP: bar \"bar is great\" ; ARTICLE: \"bar\" \"Bar\" { $subsection bar } ;" eval( -- )
 ] unit-test
 
 [ ] [

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

@@ -32,7 +32,7 @@ IN: help.definitions.tests
         "hello" "help.definitions.tests" lookup "help" word-prop
     ] unit-test
 
-    [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" (( -- )) eval ] unit-test
+    [ ] [ "IN: help.definitions.tests USING: help.syntax ; : xxx ( -- ) ; HELP: xxx ;" eval( -- ) ] unit-test
 
     [ ] [ "xxx" "help.definitions.tests" lookup print-topic ] unit-test
 

basis/help/handbook/handbook.factor

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