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

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 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" } ")." }
+  { "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 } "." }
+}
+"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
@@ -31,7 +51,8 @@ $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."
 { $subsection "compiler-errors" }
 { $subsection "hints" }
-{ $subsection "compiler-usage" } ;
+{ $subsection "compiler-usage" }
+{ $subsection "compiler-impl" } ;
 
 ABOUT: "compiler"
 

basis/compiler/compiler.factor

@@ -63,19 +63,20 @@ SYMBOLS: +optimized+ +unoptimized+ ;
         } 1||
     ] [ error-type +compiler-warning+ eq? ] bi* and ;
 
-: fail ( word error -- * )
+: (fail) ( word -- * )
-    [ 2dup ignore-error? [ drop f ] when swap compiler-error ]
-    [
-        drop
     [ compiled-unxref ]
     [ f swap compiled get set-at ]
     [ +unoptimized+ save-compiled-status ]
     tri
-    ] 2bi
     return ;
 
+: fail ( word error -- * )
+    [ 2dup ignore-error? [ drop f ] when swap compiler-error ] [ drop (fail) ] 2bi ;
+
 : frontend ( word -- nodes )
-    [ build-tree-from-word ] [ fail ] recover optimize-tree ;
+    dup contains-breakpoints? [ (fail) ] [
+        [ build-tree-from-word ] [ fail ] recover optimize-tree
+    ] if ;
 
 ! Only switch this off for debugging.
 SYMBOL: compile-dependencies?

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/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
 
@@ -43,10 +43,10 @@ M: integer method-redefine-generic-2 3 + ;
 
 [ t ] [ \ hey optimized>> ] unit-test
 [ t ] [ \ there optimized>> ] unit-test
-[ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] 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
+[ ] [ "IN: compiler.tests : hey ( -- ) ;" (( -- )) eval ] unit-test
 [ t ] [ \ there optimized>> ] unit-test
 
 : good ( -- ) ;
@@ -59,7 +59,7 @@ M: integer method-redefine-generic-2 3 + ;
 
 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test
 
-[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test
+[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" (( -- )) eval ] unit-test
 
 [ f ] [ \ good optimized>> ] unit-test
 [ f ] [ \ bad optimized>> ] unit-test
@@ -67,7 +67,7 @@ M: integer method-redefine-generic-2 3 + ;
 
 [ t ] [ \ good compiled-usage assoc-empty? ] unit-test
 
-[ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test
+[ ] [ "IN: compiler.tests : good ( -- ) ;" (( -- )) eval ] unit-test
 
 [ t ] [ \ good optimized>> ] unit-test
 [ t ] [ \ bad optimized>> ] 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/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

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

basis/compiler/tree/builder/builder.factor

@@ -58,3 +58,6 @@ TUPLE: do-not-compile word ;
             } cleave
         ] maybe-cannot-infer
     ] with-tree-builder ;
+
+: contains-breakpoints? ( word -- ? )
+    def>> [ word? ] filter [ "break?" word-prop ] any? ;

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 ]

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

@@ -17,7 +17,7 @@ sequences accessors tools.test kernel math ;
 
 [ 2 ] [ [ 3 [ drop ] [ 2drop 3 ] if ] build-tree count-introductions ] unit-test
 
-: foo ( -- ) swap ; inline recursive
+: foo ( a b -- b a ) swap ; inline recursive
 
 : recursive-inputs ( nodes -- n )
     [ #recursive? ] find nip child>> first in-d>> length ;
@@ -34,18 +34,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/propagation/inlining/inlining.factor

@@ -148,7 +148,11 @@ DEFER: (flat-length)
     ] 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
 

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

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

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

@@ -57,7 +57,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/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/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/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 _ ]" eval ]
+[ "USING: fry locals.backend ; f '[ load-local _ ]" (( -- quot )) eval ]
 [ error>> >r/r>-in-fry-error? ] must-fail-with
 
 [ { { "a" 1 } { "b" 2 } { "c" 3 } { "d" 4 } } ] [

basis/furnace/sessions/sessions-tests.factor

@@ -22,7 +22,7 @@ M: foo call-responder*
     "x" [ 1+ ] schange
     "x" sget number>string "text/html" <content> ;
 
-: url-responder-mock-test ( -- )
+: url-responder-mock-test ( -- string )
     [
         <request>
             "GET" >>method
@@ -34,7 +34,7 @@ M: foo call-responder*
         [ write-response-body drop ] with-string-writer
     ] with-destructors ;
 
-: sessions-mock-test ( -- )
+: sessions-mock-test ( -- string )
     [
         <request>
             "GET" >>method

basis/hash2/hash2-tests.factor

@@ -4,7 +4,7 @@ IN: hash2.tests
 [ t ] [ 1 2 { 1 2 } 2= ] unit-test
 [ f ] [ 1 3 { 1 2 } 2= ] unit-test
 
-: sample-hash ( -- )
+: sample-hash ( -- hash )
     5 <hash2>
     dup 2 3 "foo" roll set-hash2
     dup 4 2 "bar" roll set-hash2

basis/heaps/heaps-tests.factor

@@ -54,7 +54,7 @@ IN: heaps.tests
 : sort-entries ( entries -- entries' )
     [ [ key>> ] compare ] sort ;
 
-: delete-test ( n -- ? )
+: delete-test ( n -- obj1 obj2 )
     [
         random-alist
         <min-heap> [ heap-push-all ] keep

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

@@ -4,12 +4,12 @@ IN: help.syntax.tests
 
 [
     [ "foobar" ] [
-        "IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" eval
+        "IN: help.syntax.tests USE: help.syntax ABOUT: \"foobar\"" (( -- )) eval
         "help.syntax.tests" vocab vocab-help
     ] unit-test
     
     [ { "foobar" } ] [
-        "IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" eval
+        "IN: help.syntax.tests USE: help.syntax ABOUT: { \"foobar\" }" (( -- )) eval
         "help.syntax.tests" vocab vocab-help
     ] unit-test
     

basis/help/topics/topics-tests.factor

@@ -29,7 +29,7 @@ SYMBOL: foo
     } "\n" join
     [
         "testfile" source-file file set
-        eval
+        (( -- )) eval
     ] with-scope
 ] unit-test
 

basis/listener/listener-tests.factor

@@ -25,7 +25,7 @@ SYNTAX: hello "Hi" print ;
                 "\\ + 1 2 3 4" parse-interactive
                 "cont" get continue-with
             ] ignore-errors
-            "USE: debugger :1" eval
+            "USE: debugger :1" (( -- quot )) eval
         ] callcc1
     ] unit-test
 ] with-file-vocabs
@@ -50,7 +50,7 @@ SYNTAX: hello "Hi" print ;
 
 [
     [ ] [
-        "IN: listener.tests : hello ( -- )\n\"world\" ;" parse-interactive
+        "IN: listener.tests : hello ( -- string )\n\"world\" ;" parse-interactive
         drop
     ] unit-test
 ] with-file-vocabs

basis/locals/locals-tests.factor

@@ -261,7 +261,7 @@ M:: fixnum next-method-test ( a -- b ) a call-next-method 1 + ;
 
 CONSTANT: new-definition "USING: math ;\nIN: locals.tests\n: a-word-with-locals ( -- x ) 2 3 + ;\n"
 
-[ ] [ new-definition eval ] unit-test
+[ ] [ new-definition (( -- )) eval ] unit-test
 
 [ t ] [
     [ \ a-word-with-locals see ] with-string-writer
@@ -461,7 +461,7 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [
     "USING: locals fry math ; 1 '[ [let | A [ 10 ] | A _ + ] ]"
-    eval call
+    (( -- )) eval call
 ] [ error>> >r/r>-in-fry-error? ] must-fail-with
     
 :: (funny-macro-test) ( obj quot -- ? ) obj { quot } 1&& ; inline
@@ -473,10 +473,10 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 [ f ] [ 2 funny-macro-test ] unit-test
 
 ! Some odd parser corner cases
-[ "USE: locals [let" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [let" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
-[ "USE: locals [let |" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [let |" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
-[ "USE: locals [let | a" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [let | a" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
-[ "USE: locals [|" eval ] [ error>> unexpected-eof? ] must-fail-with
+[ "USE: locals [|" (( -- )) eval ] [ error>> unexpected-eof? ] must-fail-with
 
 [ 25 ] [ 5 [| a | { [ a sq ] } cond ] call ] unit-test
 [ 25 ] [ 5 [| | { [| a | a sq ] } ] call first call ] unit-test
@@ -491,19 +491,19 @@ M:: integer lambda-method-forget-test ( a -- b ) ;
 
 [ 3 ] [ 3 [| a | \ a ] call ] unit-test
 
-[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" eval ] must-fail
+[ "USE: locals [| | { [let | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail
 
-[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" eval ] must-fail
+[ "USE: locals [| | { [wlet | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail
 
-[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" eval ] must-fail
+[ "USE: locals [| | { [let* | a [ 0 ] | a ] } ]" (( -- )) eval ] must-fail
 
-[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" eval ] must-fail
+[ "USE: locals [| | [let | a! [ 0 ] | { a! } ] ]" (( -- )) eval ] must-fail
 
-[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" eval ] must-fail
+[ "USE: locals [| | [wlet | a [ 0 ] | { a } ] ]" (( -- )) eval ] must-fail
 
-[ "USE: locals [| | { :> a } ]" eval ] must-fail
+[ "USE: locals [| | { :> a } ]" (( -- )) eval ] must-fail
 
-[ "USE: locals 3 :> a" eval ] must-fail
+[ "USE: locals 3 :> a" (( -- )) eval ] must-fail
 
 [ 3 ] [ 3 [| | :> a a ] call ] unit-test
 

basis/macros/macros-tests.factor

@@ -13,11 +13,11 @@ unit-test
 [ t ] [ \ see-test macro? ] unit-test
 
 [ t ] [
-    "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval
+    "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup (( -- )) eval
     [ \ see-test see ] with-string-writer =
 ] unit-test
 
 [ f ] [ \ see-test macro? ] unit-test
 
-[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval ] unit-test
+[ ] [ "USING: macros stack-checker kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" (( -- )) eval ] unit-test
 

basis/math/intervals/intervals-tests.factor

@@ -255,11 +255,11 @@ IN: math.intervals.tests
     0 pick interval-contains? over first \ recip eq? and [
         2drop t
     ] [
-        [ [ random-element ] dip first execute ] 2keep
+        [ [ random-element ] dip first execute( a -- b ) ] 2keep
-        second execute interval-contains?
+        second execute( a -- b ) interval-contains?
     ] if ;
 
-[ t ] [ 80000 [ drop unary-test ] all? ] unit-test
+[ t ] [ 80000 iota [ drop unary-test ] all? ] unit-test
 
 : random-binary-op ( -- pair )
     {
@@ -286,11 +286,11 @@ IN: math.intervals.tests
     0 pick interval-contains? over first { / /i mod rem } member? and [
         3drop t
     ] [
-        [ [ [ random-element ] bi@ ] dip first execute ] 3keep
+        [ [ [ random-element ] bi@ ] dip first execute( a b -- c ) ] 3keep
-        second execute interval-contains?
+        second execute( a b -- c ) interval-contains?
     ] if ;
 
-[ t ] [ 80000 [ drop binary-test ] all? ] unit-test
+[ t ] [ 80000 iota [ drop binary-test ] all? ] unit-test
 
 : random-comparison ( -- pair )
     {
@@ -305,7 +305,7 @@ IN: math.intervals.tests
     [ [ [ random-element ] bi@ ] dip first execute ] 3keep
     second execute dup incomparable eq? [ 2drop t ] [ = ] if ;
 
-[ t ] [ 40000 [ drop comparison-test ] all? ] unit-test
+[ t ] [ 40000 iota [ drop comparison-test ] all? ] unit-test
 
 [ t ] [ -10 10 [a,b] 0 100 [a,b] assume> 0 10 (a,b] = ] unit-test
 
@@ -322,7 +322,7 @@ IN: math.intervals.tests
 [ t ] [ -10 10 [a,b] interval-abs 0 10 [a,b] = ] unit-test
 
 ! Test that commutative interval ops really are
-: random-interval-or-empty ( -- )
+: random-interval-or-empty ( -- obj )
     10 random 0 = [ empty-interval ] [ random-interval ] if ;
 
 : random-commutative-op ( -- op )
@@ -333,7 +333,7 @@ IN: math.intervals.tests
     } random ;
 
 [ t ] [
-    80000 [
+    80000 iota [
         drop
         random-interval-or-empty random-interval-or-empty
         random-commutative-op

basis/memoize/memoize-tests.factor

@@ -9,7 +9,7 @@ MEMO: fib ( m -- n )
 
 [ 89 ] [ 10 fib ] unit-test
 
-[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" eval ] must-fail
+[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" (( -- )) eval ] must-fail
 
 MEMO: see-test ( a -- b ) reverse ;
 
@@ -17,7 +17,7 @@ MEMO: see-test ( a -- b ) reverse ;
 [ [ \ see-test see ] with-string-writer ]
 unit-test
 
-[ ] [ "IN: memoize.tests : fib ( -- ) ;" eval ] unit-test
+[ ] [ "IN: memoize.tests : fib ( -- ) ;" (( -- )) eval ] unit-test
 
 [ "IN: memoize.tests\n: fib ( -- ) ;\n" ] [ [ \ fib see ] with-string-writer ] unit-test
 

basis/mirrors/mirrors-tests.factor

@@ -56,6 +56,6 @@ TUPLE: color
 ! Test reshaping with a mirror
 1 2 3 color boa <mirror> "mirror" set
 
-[ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" eval ] unit-test
+[ ] [ "IN: mirrors.tests USE: math TUPLE: color { green integer } { red integer } { blue integer } ;" (( -- )) eval ] unit-test
 
 [ 1 ] [ "red" "mirror" get at ] unit-test

basis/opengl/textures/textures.factor

@@ -128,7 +128,9 @@ M: single-texture dispose*
     [ display-list>> [ delete-dlist ] when* ] bi ;
 
 M: single-texture draw-scaled-texture
-    dup texture>> [ draw-textured-rect ] [ 2drop ] if ;
+    2dup dim>> = [ nip draw-texture ] [
+        dup texture>> [ draw-textured-rect ] [ 2drop ] if
+    ] if ;
 
 TUPLE: multi-texture grid display-list loc disposed ;
 
@@ -166,6 +168,8 @@ TUPLE: multi-texture grid display-list loc disposed ;
         f multi-texture boa
     ] with-destructors ;
 
+M: multi-texture draw-scaled-texture nip draw-texture ;
+
 M: multi-texture dispose* grid>> [ [ dispose ] each ] each ;
 
 CONSTANT: max-texture-size { 512 512 }

basis/peg/ebnf/ebnf-tests.factor

@@ -444,12 +444,12 @@ foo=<foreign any-char> 'd'
   "ad" parser4
 ] unit-test
 
-{ t } [
+{ } [
- "USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n'  => [[ drop \"\n\" ]] EBNF]" eval drop t
+ "USING: kernel peg.ebnf ; \"a\\n\" [EBNF foo='a' '\n'  => [[ drop \"\n\" ]] EBNF] drop" (( -- )) eval 
 ] unit-test
 
 [
-  "USING: peg.ebnf ; <EBNF foo='a' foo='b' EBNF>" eval drop
+  "USING: peg.ebnf ; <EBNF foo='a' foo='b' EBNF>" (( -- )) eval drop
 ] must-fail
 
 { t } [
@@ -521,12 +521,12 @@ Tok                = Spaces (Number | Special )
   "\\" [EBNF foo="\\" EBNF]
 ] unit-test
 
-[ "USE: peg.ebnf [EBNF EBNF]" eval ] must-fail
+[ "USE: peg.ebnf [EBNF EBNF]" (( -- )) eval ] must-fail
 
 [ <" USE: peg.ebnf [EBNF
     lol = a
     lol = b
-  EBNF] "> eval
+  EBNF] "> (( -- )) eval
 ] [
     error>> [ redefined-rule? ] [ name>> "lol" = ] bi and
 ] must-fail-with

basis/persistent/hashtables/hashtables-tests.factor

@@ -83,7 +83,7 @@ M: hash-0-b hashcode* 2drop 0 ;
 : random-string ( -- str )
     1000000 random ; ! [ CHAR: a CHAR: z [a,b] random ] "" replicate-as ;
 
-: random-assocs ( -- hash phash )
+: random-assocs ( n -- hash phash )
     [ random-string ] replicate
     [ H{ } clone [ '[ swap _ set-at ] each-index ] keep ]
     [ PH{ } clone swap [ spin new-at ] each-index ]
@@ -92,7 +92,7 @@ M: hash-0-b hashcode* 2drop 0 ;
 : ok? ( assoc1 assoc2 -- ? )
     [ assoc= ] [ [ assoc-size ] bi@ = ] 2bi and ;
 
-: test-persistent-hashtables-1 ( n -- )
+: test-persistent-hashtables-1 ( n -- ? )
     random-assocs ok? ;
 
 [ t ] [ 10 test-persistent-hashtables-1 ] unit-test
@@ -106,7 +106,7 @@ M: hash-0-b hashcode* 2drop 0 ;
 [ t ] [ 10000 test-persistent-hashtables-1 ] unit-test
 [ t ] [ 50000 test-persistent-hashtables-1 ] unit-test
 
-: test-persistent-hashtables-2 ( n -- )
+: test-persistent-hashtables-2 ( n -- ? )
     random-assocs
     dup keys [
         [ nip over delete-at ] [ swap pluck-at nip ] 3bi

basis/prettyprint/prettyprint-tests.factor

@@ -90,7 +90,7 @@ unit-test
     [ \ blah see ] with-string-writer "\n" ?tail drop 6 tail*
 ] unit-test
 
-: check-see ( expect name -- )
+: check-see ( expect name -- ? )
     [
         use [ clone ] change
 
@@ -105,6 +105,7 @@ unit-test
 GENERIC: method-layout ( a -- b )
 
 M: complex method-layout
+    drop
     "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
     ;
 
@@ -116,8 +117,9 @@ M: object method-layout ;
 
 [
     {
-        "USING: math prettyprint.tests ;"
+        "USING: kernel math prettyprint.tests ;"
         "M: complex method-layout"
+        "    drop"
         "    \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\""
         "    ;"
         ""
@@ -180,15 +182,15 @@ DEFER: parse-error-file
     "string-layout-test" string-layout check-see
 ] unit-test
 
-: narrow-test ( -- str )
+: narrow-test ( -- array )
     {
         "USING: arrays combinators continuations kernel sequences ;"
         "IN: prettyprint.tests"
-        ": narrow-layout ( obj -- )"
+        ": narrow-layout ( obj1 obj2 -- obj3 )"
         "    {"
         "        { [ dup continuation? ] [ append ] }"
         "        { [ dup not ] [ drop reverse ] }"
-        "        { [ dup pair? ] [ delete ] }"
+        "        { [ dup pair? ] [ [ delete ] keep ] }"
         "    } cond ;"
     } ;
 
@@ -196,7 +198,7 @@ DEFER: parse-error-file
     "narrow-layout" narrow-test check-see
 ] unit-test
 
-: another-narrow-test ( -- str )
+: another-narrow-test ( -- array )
     {
         "IN: prettyprint.tests"
         ": another-narrow-layout ( -- obj )"
@@ -252,18 +254,14 @@ M: class-see-layout class-see-layout ;
 ! Regression
 [ t ] [
     "IN: prettyprint.tests\nGENERIC: generic-decl-test ( a -- b ) flushable\n"
-    dup eval
+    dup (( -- )) eval
     "generic-decl-test" "prettyprint.tests" lookup
     [ see ] with-string-writer =
 ] unit-test
 
-[ [ + ] ] [
+[ [ + ] ] [ [ \ + (step-into-execute) ] (remove-breakpoints) ] unit-test
-    [ \ + (step-into-execute) ] (remove-breakpoints)
-] unit-test
 
-[ [ (step-into-execute) ] ] [
+[ [ (step-into-execute) ] ] [ [ (step-into-execute) ] (remove-breakpoints) ] unit-test
-    [ (step-into-execute) ] (remove-breakpoints)
-] unit-test
  
 [ [ 2 2 + . ] ] [
     [ 2 2 \ + (step-into-execute) . ] (remove-breakpoints)

basis/random/mersenne-twister/mersenne-twister-tests.factor

@@ -11,7 +11,7 @@ IN: random.mersenne-twister.tests
     100 [ 100 random ] replicate ;
 
 : test-rng ( seed quot -- )
-    [  <mersenne-twister> ] dip with-random ;
+    [  <mersenne-twister> ] dip with-random ; inline
 
 [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test
 

basis/regexp/parser/parser-tests.factor

@@ -4,7 +4,7 @@ IN: regexp.parser.tests
 : regexp-parses ( string -- )
     [ [ ] ] dip '[ _ parse-regexp drop ] unit-test ;
 
-: regexp-fails ( string -- )
+: regexp-fails ( string -- regexp )
     '[ _ parse-regexp ] must-fail ;
 
 {

basis/regexp/regexp-tests.factor

@@ -262,11 +262,11 @@ IN: regexp-tests
 ! Comment inside a regular expression
 [ t ] [ "ac" "a(?#boo)c" <regexp> matches? ] unit-test
 
-[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" eval ] unit-test
+[ ] [ "USING: regexp kernel ; R' -{3}[+]{1,6}(?:!!)?\\s' drop" (( -- )) eval ] unit-test
 
-[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" eval ] unit-test
+[ ] [ "USING: regexp kernel ; R' (ftp|http|https)://(\\w+:?\\w*@)?(\\S+)(:[0-9]+)?(/|/([\\w#!:.?+=&%@!\\-/]))?' drop" (( -- )) eval ] unit-test
 
-[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" eval ] unit-test
+[ ] [ "USING: regexp kernel ; R' \\*[^\s*][^*]*\\*' drop" (( -- )) eval ] unit-test
 
 [ "ab" ] [ "ab" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test
 [ "abc" ] [ "abc" "(a|ab)(bc)?" <regexp> first-match >string ] unit-test

basis/stack-checker/stack-checker-tests.factor

@@ -524,7 +524,7 @@ ERROR: custom-error ;
 
 { 2 1 } [ [ + ] inference-invalidation-b ] must-infer-as
 
-[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- a b ) 1 2 ;" eval ] unit-test
+[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- a b ) 1 2 ;" (( -- )) eval ] unit-test
 
 [ 3 ] [ inference-invalidation-c ] unit-test
 
@@ -536,7 +536,7 @@ M: object inference-invalidation-d inference-invalidation-c 2drop ;
 
 \ inference-invalidation-d must-infer
 
-[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- ) ;" eval ] unit-test
+[ ] [ "IN: stack-checker.tests : inference-invalidation-a ( -- ) ;" (( -- )) eval ] unit-test
 
 [ [ inference-invalidation-d ] infer ] must-fail
 

basis/threads/threads-tests.factor

@@ -31,7 +31,7 @@ yield
 
 [ [ 3 throw ] "A" suspend ] [ 3 = ] must-fail-with
 
-:: spawn-namespace-test ( -- )
+:: spawn-namespace-test ( -- ? )
     [let | p [ <promise> ] g [ gensym ] |
         [
             g "x" set

basis/tools/annotations/annotations-tests.factor

@@ -18,7 +18,7 @@ M: integer some-generic 1+ ;
 
 [ 4 ] [ 3 some-generic ] unit-test
 
-[ ] [ "IN: tools.annotations.tests USE: math M: integer some-generic 1- ;" eval ] unit-test
+[ ] [ "IN: tools.annotations.tests USE: math M: integer some-generic 1- ;" (( -- )) eval ] unit-test
 
 [ 2 ] [ 3 some-generic ] unit-test
 
@@ -33,7 +33,7 @@ M: object another-generic ;
 
 \ another-generic watch
 
-[ ] [ "IN: tools.annotations.tests GENERIC: another-generic ( a -- b )" eval ] unit-test
+[ ] [ "IN: tools.annotations.tests GENERIC: another-generic ( a -- b )" (( -- )) eval ] unit-test
 
 [ ] [ \ another-generic reset ] unit-test
 

basis/tools/annotations/annotations.factor

@@ -3,7 +3,7 @@
 USING: accessors kernel math sorting words parser io summary
 quotations sequences prettyprint continuations effects
 definitions compiler.units namespaces assocs tools.walker
-tools.time generic inspector fry ;
+tools.time generic inspector fry tools.continuations ;
 IN: tools.annotations
 
 GENERIC: reset ( word -- )

basis/tools/continuations/continuations.factor

@@ -12,7 +12,6 @@ IN: tools.continuations
 : after-break ( object -- )
     {
         { [ dup continuation? ] [ (continue) ] }
-        { [ dup quotation? ] [ call ] }
         { [ dup not ] [ "Single stepping abandoned" rethrow ] }
     } cond ;
 
@@ -22,15 +21,15 @@ SYMBOL: break-hook
 
 : break ( -- )
     continuation callstack >>call
-    break-hook get call
+    break-hook get call( continuation -- continuation' )
     after-break ;
 
 \ break t "break?" set-word-prop
 
-<PRIVATE
-
 GENERIC: add-breakpoint ( quot -- quot' )
 
+<PRIVATE
+
 M: callable add-breakpoint
     dup [ break ] head? [ \ break prefix ] unless ;
 
@@ -69,6 +68,18 @@ M: object add-breakpoint ;
 : (step-into-call-next-method) ( method -- )
     next-method-quot (step-into-quot) ;
 
+<< {
+    (step-into-quot)
+    (step-into-dip)
+    (step-into-2dip)
+    (step-into-3dip)
+    (step-into-if)
+    (step-into-dispatch)
+    (step-into-execute)
+    (step-into-continuation)
+    (step-into-call-next-method)
+} [ t "no-compile" set-word-prop ] each >>
+
 : change-frame ( continuation quot -- continuation' )
     #! Applies quot to innermost call frame of the
     #! continuation.
@@ -113,14 +124,14 @@ PRIVATE>
 } [ "step-into" set-word-prop ] assoc-each
 
 ! Never step into these words
+: don't-step-into ( word -- )
+    dup [ execute break ] curry "step-into" set-word-prop ;
+
 {
     >n ndrop >c c>
     continue continue-with
     stop suspend (spawn)
-} [
+} [ don't-step-into ] each
-    dup [ execute break ] curry
-    "step-into" set-word-prop
-] each
 
 \ break [ break ] "step-into" set-word-prop
 

basis/tools/deploy/shaker/shaker.factor

@@ -374,9 +374,9 @@ SYMBOL: deploy-vocab
             [:c]
             [print-error]
             '[
-                [ _ execute ] [
+                [ _ execute( obj -- ) ] [
-                    _ execute nl
+                    _ execute( obj -- ) nl
-                    _ execute
+                    _ execute( obj -- )
                 ] recover
             ] %
         ] if

basis/tools/trace/trace-tests.factor

@@ -0,0 +1,4 @@
+IN: tools.trace.tests
+USING: tools.trace tools.test sequences ;
+
+[ { 3 2 1 } ] [ { 1 2 3 } [ reverse ] trace ] unit-test

basis/tools/trace/trace.factor

@@ -1,21 +1,21 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: concurrency.promises models tools.continuations kernel
-sequences concurrency.messaging locals continuations
+sequences concurrency.messaging locals continuations threads
-threads namespaces namespaces.private make assocs accessors
+namespaces namespaces.private make assocs accessors io strings
-io strings prettyprint math words effects summary io.styles
+prettyprint math math.parser words effects summary io.styles classes
-classes ;
+generic.math combinators.short-circuit ;
 IN: tools.trace
 
 : callstack-depth ( callstack -- n )
-    callstack>array length ;
+    callstack>array length 2/ ;
 
 SYMBOL: end
 
 SYMBOL: exclude-vocabs
 SYMBOL: include-vocabs
 
-exclude-vocabs { "kernel" "math" "accessors" } swap set-global
+exclude-vocabs { "math" "accessors" } swap set-global
 
 : include? ( vocab -- ? )
     include-vocabs get dup [ member? ] [ 2drop t ] if ;
@@ -24,11 +24,22 @@ exclude-vocabs { "kernel" "math" "accessors" } swap set-global
     exclude-vocabs get dup [ member? ] [ 2drop f ] if ;
 
 : into? ( obj -- ? )
-    dup word? [
+    {
-        dup predicate? [ drop f ] [
+        [ word? ]
-            vocabulary>> [ include? ] [ exclude? not ] bi and
+        [ predicate? not ]
-        ] if
+        [ math-generic? not ]
-    ] [ drop t ] if ;
+        [
+            {
+                [ inline? ]
+                [
+                    {
+                        [ vocabulary>> include? ]
+                        [ vocabulary>> exclude? not ]
+                    } 1&&
+                ]
+            } 1||
+        ]
+    } 1&& ;
 
 TUPLE: trace-step word inputs ;
 
@@ -49,18 +60,24 @@ M: trace-step summary
         nip short.
     ] if ;
 
+: print-depth ( continuation -- )
+    call>> callstack-depth
+    [ CHAR: \s <string> write ]
+    [ number>string write ": " write ] bi ;
+
 : trace-step ( continuation -- continuation' )
     dup continuation-current end eq? [
-        [ call>> callstack-depth 2/ CHAR: \s <string> write ]
+        [ print-depth ]
         [ print-step ]
         [
             dup continuation-current into?
             [ continuation-step-into ] [ continuation-step ] if
-        ]
+        ] tri
-        tri
     ] unless ;
 
 : trace ( quot -- data )
     [ [ trace-step ] break-hook ] dip
     [ break ] [ end drop ] surround
     with-variable ;
+
+<< \ trace t "no-compile" set-word-prop >>

basis/tools/walker/debug/debug.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: concurrency.promises models tools.walker kernel
+USING: concurrency.promises models tools.walker tools.continuations
-sequences concurrency.messaging locals continuations
+kernel sequences concurrency.messaging locals continuations threads
-threads namespaces namespaces.private assocs accessors ;
+namespaces namespaces.private assocs accessors ;
 IN: tools.walker.debug
 
 :: test-walker ( quot -- data )

basis/tools/walker/walker-tests.factor

@@ -1,7 +1,8 @@
 USING: tools.walker io io.streams.string kernel math
 math.private namespaces prettyprint sequences tools.test
 continuations math.parser threads arrays tools.walker.debug
-generic.standard sequences.private kernel.private ;
+generic.standard sequences.private kernel.private
+tools.continuations accessors words ;
 IN: tools.walker.tests
 
 [ { } ] [
@@ -112,3 +113,22 @@ IN: tools.walker.tests
 [ { } ] [
     [ "a" "b" set "c" "d" set [ ] test-walker ] with-scope
 ] unit-test
+
+: breakpoint-test ( -- x ) break 1 2 + ;
+
+\ breakpoint-test don't-step-into
+
+[ f ] [ \ breakpoint-test optimized>> ] unit-test
+
+[ { 3 } ] [ [ breakpoint-test ] test-walker ] unit-test
+
+GENERIC: method-breakpoint-test ( x -- y )
+
+TUPLE: method-breakpoint-tuple ;
+
+M: method-breakpoint-tuple method-breakpoint-test break drop 1 2 + ;
+
+\ method-breakpoint-test don't-step-into
+
+[ { 3 } ]
+[ [ T{ method-breakpoint-tuple } method-breakpoint-test ] test-walker ] unit-test

basis/tools/walker/walker.factor

@@ -5,7 +5,7 @@ sequences math namespaces.private continuations.private
 concurrency.messaging quotations kernel.private words
 sequences.private assocs models models.arrow arrays accessors
 generic generic.standard definitions make sbufs
-tools.continuations ;
+tools.continuations parser ;
 IN: tools.walker
 
 SYMBOL: show-walker-hook ! ( status continuation thread -- )
@@ -35,6 +35,8 @@ DEFER: start-walker-thread
 : walk ( quot -- quot' )
     \ break prefix [ break rethrow ] recover ;
 
+<< \ walk t "no-compile" set-word-prop >>
+
 break-hook [
     [
         get-walker-thread
@@ -43,18 +45,6 @@ break-hook [
     ]
 ] initialize
 
-<< {
-    (step-into-quot)
-    (step-into-dip)
-    (step-into-2dip)
-    (step-into-3dip)
-    (step-into-if)
-    (step-into-dispatch)
-    (step-into-execute)
-    (step-into-continuation)
-    (step-into-call-next-method)
-} [ t "no-compile" set-word-prop ] each >>
-
 ! Messages sent to walker thread
 SYMBOL: step
 SYMBOL: step-out
@@ -171,4 +161,4 @@ SYMBOL: +stopped+
 ! For convenience
 IN: syntax
 
-: B ( -- ) break ;
+SYNTAX: B \ break parsed ;

basis/ui/tools/walker/walker-docs.factor

@@ -1,6 +1,6 @@
 IN: ui.tools.walker
 USING: help.markup help.syntax ui.commands ui.operations
-ui.render tools.walker sequences ;
+ui.render tools.walker sequences tools.continuations ;
 
 ARTICLE: "ui-walker-step" "Stepping through code"
 "If the current position points to a word, the various stepping commands behave as follows:"

core/classes/classes-tests.factor

@@ -29,10 +29,10 @@ M: method-forget-class method-forget-test ;
 ] unit-test
 
 ! Minor leak
-[ ] [ "IN: classes.tests TUPLE: forget-me ;" eval ] unit-test
+[ ] [ "IN: classes.tests TUPLE: forget-me ;" (( -- )) eval ] unit-test
 [ ] [ f \ word set-global ] unit-test
-[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" eval ] unit-test
+[ ] [ "IN: classes.tests USE: kernel USE: classes.algebra forget-me tuple class<= drop" (( -- )) eval ] unit-test
-[ ] [ "IN: classes.tests FORGET: forget-me" eval ] unit-test
+[ ] [ "IN: classes.tests FORGET: forget-me" (( -- )) eval ] unit-test
 [ 0 ] [
     [ word? ] instances
     [ [ name>> "forget-me" = ] [ vocabulary>> "classes.tests" = ] bi and ] count

core/classes/mixin/mixin-tests.factor

@@ -42,7 +42,7 @@ INSTANCE: integer mx1
 [ t ] [ mx1 integer class<= ] unit-test
 [ t ] [ mx1 number class<= ] unit-test
 
-"IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" eval
+"IN: classes.mixin.tests USE: arrays INSTANCE: array mx1" (( -- )) eval
 
 [ t ] [ array mx1 class<= ] unit-test
 [ f ] [ mx1 number class<= ] unit-test

core/classes/tuple/parser/parser-tests.factor

@@ -50,20 +50,20 @@ TUPLE: test-8 { b integer read-only } ;
 
 DEFER: foo
 
-[ "IN: classes.tuple.parser.tests TUPLE: foo < test-1 < ;" eval ]
+[ "IN: classes.tuple.parser.tests TUPLE: foo < test-1 < ;" (( -- )) eval ]
 [ error>> invalid-slot-name? ]
 must-fail-with
 
-[ "IN: classes.tuple.parser.tests TUPLE: foo :" eval ]
+[ "IN: classes.tuple.parser.tests TUPLE: foo :" (( -- )) eval ]
 [ error>> invalid-slot-name? ]
 must-fail-with
 
-[ "IN: classes.tuple.parser.tests TUPLE: foo" eval ]
+[ "IN: classes.tuple.parser.tests TUPLE: foo" (( -- )) eval ]
 [ error>> unexpected-eof? ]
 must-fail-with
 
 2 [
-    [ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { slot dll } ;" eval ]
+    [ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { slot dll } ;" (( -- )) eval ]
     [ error>> no-initial-value? ]
     must-fail-with
 
@@ -71,14 +71,14 @@ must-fail-with
 ] times
 
 2 [
-    [ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" eval ]
+    [ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" (( -- )) eval ]
     [ error>> bad-initial-value? ]
     must-fail-with
 
     [ f ] [ \ foo tuple-class? ] unit-test
 ] times
 
-[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo slot { slot array } ;" eval ]
+[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo slot { slot array } ;" (( -- )) eval ]
 [ error>> duplicate-slot-names? ]
 must-fail-with
 
@@ -107,7 +107,7 @@ TUPLE: parsing-corner-case x ;
         "    f"
         "    3"
         "}"
-    } "\n" join eval
+    } "\n" join (( -- tuple )) eval
 ] unit-test
 
 [ T{ parsing-corner-case f 3 } ] [
@@ -116,7 +116,7 @@ TUPLE: parsing-corner-case x ;
         "T{ parsing-corner-case"
         "    { x 3 }"
         "}"
-    } "\n" join eval
+    } "\n" join (( -- tuple )) eval
 ] unit-test
 
 [ T{ parsing-corner-case f 3 } ] [
@@ -125,7 +125,7 @@ TUPLE: parsing-corner-case x ;
         "T{ parsing-corner-case {"
         "    x 3 }"
         "}"
-    } "\n" join eval
+    } "\n" join (( -- tuple )) eval
 ] unit-test
 
 
@@ -133,12 +133,12 @@ TUPLE: parsing-corner-case x ;
     {
         "USE: classes.tuple.parser.tests T{ parsing-corner-case"
         "    { x 3 }"
-    } "\n" join eval
+    } "\n" join (( -- tuple )) eval
 ] [ error>> unexpected-eof? ] must-fail-with
 
 [
     {
         "USE: classes.tuple.parser.tests T{ parsing-corner-case {"
         "    x 3 }"
-    } "\n" join eval
+    } "\n" join (( -- tuple )) eval
 ] [ error>> unexpected-eof? ] must-fail-with

core/classes/tuple/tuple-tests.factor

@@ -27,7 +27,7 @@ C: <redefinition-test> redefinition-test
 
 [ t ] [ "redefinition-test" get redefinition-test? ] unit-test
 
-"IN: classes.tuple.tests TUPLE: redefinition-test ;" eval
+"IN: classes.tuple.tests TUPLE: redefinition-test ;" (( -- )) eval
 
 [ t ] [ "redefinition-test" get redefinition-test? ] unit-test
 
@@ -39,7 +39,7 @@ C: <point> point
 [ ] [ 100 200 <point> "p" set ] unit-test
 
 ! Use eval to sequence parsing explicitly
-[ ] [ "IN: classes.tuple.tests TUPLE: point x y z ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: point x y z ;" (( -- )) eval ] unit-test
 
 [ 100 ] [ "p" get x>> ] unit-test
 [ 200 ] [ "p" get y>> ] unit-test
@@ -51,7 +51,7 @@ C: <point> point
 
 [ 300 ] [ "p" get "z>>" "accessors" lookup execute ] unit-test
 
-[ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: point z y ;" (( -- )) eval ] unit-test
 
 [ 2 ] [ "p" get tuple-size ] unit-test
 
@@ -89,7 +89,7 @@ C: <empty> empty
 [ t length ] [ object>> t eq? ] must-fail-with
 
 [ "<constructor-test>" ]
-[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word name>> ] unit-test
+[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" (( -- )) eval word name>> ] unit-test
 
 TUPLE: size-test a b c d ;
 
@@ -102,7 +102,7 @@ GENERIC: <yo-momma> ( a -- b )
 
 TUPLE: yo-momma ;
 
-[ ] [ "IN: classes.tuple.tests C: <yo-momma> yo-momma" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests C: <yo-momma> yo-momma" (( -- )) eval ] unit-test
 
 [ f ] [ \ <yo-momma> generic? ] unit-test
 
@@ -204,7 +204,7 @@ C: <erg's-reshape-problem> erg's-reshape-problem
 : cons-test-1 ( -- tuple ) \ erg's-reshape-problem new ;
 : cons-test-2 ( a b c d -- tuple ) \ erg's-reshape-problem boa ;
 
-[ ] [ "IN: classes.tuple.tests TUPLE: erg's-reshape-problem a b c d e f ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: erg's-reshape-problem a b c d e f ;" (( -- )) eval ] unit-test
 
 [ ] [ 1 2 3 4 5 6 cons-test-2 "a" set ] unit-test
 
@@ -281,13 +281,13 @@ test-server-slot-values
 ] unit-test
 
 [
-    "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" eval
+    "IN: classes.tuple.tests TUPLE: bad-superclass < word ;" (( -- )) eval
 ] must-fail
 
 ! Dynamically changing inheritance hierarchy
 TUPLE: electronic-device ;
 
-[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram ;" (( -- )) eval ] unit-test
 
 [ f ] [ electronic-device laptop class<= ] unit-test
 [ t ] [ server electronic-device class<= ] unit-test
@@ -303,17 +303,17 @@ TUPLE: electronic-device ;
 [ f ] [ "server" get laptop? ] unit-test
 [ t ] [ "server" get server? ] unit-test
 
-[ ] [ "IN: classes.tuple.tests TUPLE: computer cpu ram ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: computer cpu ram ;" (( -- )) eval ] unit-test
 
 [ f ] [ "laptop" get electronic-device? ] unit-test
 [ t ] [ "laptop" get computer? ] unit-test
 
-[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: computer < electronic-device cpu ram disk ;" (( -- )) eval ] unit-test
 
 test-laptop-slot-values
 test-server-slot-values
 
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ;" (( -- )) eval ] unit-test
 
 test-laptop-slot-values
 test-server-slot-values
@@ -326,7 +326,7 @@ TUPLE: make-me-some-accessors voltage grounded? ;
 [ ] [ "laptop" get 220 >>voltage drop ] unit-test
 [ ] [ "server" get 110 >>voltage drop ] unit-test
 
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage grounded? ;" (( -- )) eval ] unit-test
 
 test-laptop-slot-values
 test-server-slot-values
@@ -334,7 +334,7 @@ test-server-slot-values
 [ 220 ] [ "laptop" get voltage>> ] unit-test
 [ 110 ] [ "server" get voltage>> ] unit-test
 
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device grounded? voltage ;" (( -- )) eval ] unit-test
 
 test-laptop-slot-values
 test-server-slot-values
@@ -343,7 +343,7 @@ test-server-slot-values
 [ 110 ] [ "server" get voltage>> ] unit-test
 
 ! Reshaping superclass and subclass simultaneously
-[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: electronic-device voltage ; TUPLE: computer < electronic-device cpu ram ;" (( -- )) eval ] unit-test
 
 test-laptop-slot-values
 test-server-slot-values
@@ -364,11 +364,11 @@ C: <test2> test2
 
 test-a/b
 
-[ ] [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: test1 a x ; TUPLE: test2 < test1 b y ;" (( -- )) eval ] unit-test
 
 test-a/b
 
-[ ] [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: test1 a ; TUPLE: test2 < test1 b ;" (( -- )) eval ] unit-test
 
 test-a/b
 
@@ -393,19 +393,19 @@ T{ move-up-2 f "a" "b" "c" } "move-up" set
 
 test-move-up
 
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a b c ; TUPLE: move-up-2 < move-up-1 ;" (( -- )) eval ] unit-test
 
 test-move-up
 
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 a c ; TUPLE: move-up-2 < move-up-1 b ;" (( -- )) eval ] unit-test
 
 test-move-up
 
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 c ; TUPLE: move-up-2 < move-up-1 b a ;" (( -- )) eval ] unit-test
 
 test-move-up
 
-[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: move-up-1 ; TUPLE: move-up-2 < move-up-1 a b c ;" (( -- )) eval ] unit-test
 
 ! Constructors must be recompiled when changing superclass
 TUPLE: constructor-update-1 xxx ;
@@ -416,7 +416,7 @@ C: <constructor-update-2> constructor-update-2
 
 { 3 1 } [ <constructor-update-2> ] must-infer-as
 
-[ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: constructor-update-1 xxx ttt www ;" (( -- )) eval ] unit-test
 
 { 5 1 } [ <constructor-update-2> ] must-infer-as
 
@@ -431,7 +431,7 @@ UNION: redefinition-problem' redefinition-problem integer ;
 
 TUPLE: redefinition-problem-2 ;
 
-"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" eval
+"IN: classes.tuple.tests TUPLE: redefinition-problem < redefinition-problem-2 ;" (( -- )) eval
 
 [ t ] [ 3 redefinition-problem'? ] unit-test
 
@@ -472,7 +472,7 @@ USE: vocabs
     ] with-compilation-unit
 ] unit-test
 
-[ "USE: words T{ word }" eval ]
+[ "USE: words T{ word }" (( -- )) eval ]
 [ error>> T{ no-method f word new } = ]
 must-fail-with
 
@@ -485,7 +485,7 @@ must-fail-with
 
 [ t ] [ "forget-accessors-test" "classes.tuple.tests" lookup class? ] unit-test
 
-: accessor-exists? ( class name -- ? )
+: accessor-exists? ( name -- ? )
     [ "forget-accessors-test" "classes.tuple.tests" lookup ] dip
     ">>" append "accessors" lookup method >boolean ;
 
@@ -520,13 +520,13 @@ TUPLE: another-forget-accessors-test ;
 [ f ] [
     t parser-notes? [
         [
-            "IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" eval
+            "IN: classes.tuple.tests TUPLE: shadow-1 a b ; TUPLE: shadow-2 < shadow-1 a b ;" (( -- )) eval
         ] with-string-writer empty?
     ] with-variable
 ] unit-test
 
 ! Missing error check
-[ "IN: classes.tuple.tests USE: words TUPLE: wrong-superclass < word ;" eval ] must-fail
+[ "IN: classes.tuple.tests USE: words TUPLE: wrong-superclass < word ;" (( -- )) eval ] must-fail
 
 ! Class forget messyness
 TUPLE: subclass-forget-test ;
@@ -535,7 +535,7 @@ TUPLE: subclass-forget-test-1 < subclass-forget-test ;
 TUPLE: subclass-forget-test-2 < subclass-forget-test ;
 TUPLE: subclass-forget-test-3 < subclass-forget-test-2 ;
 
-[ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" (( -- )) eval ] unit-test
 
 [ { subclass-forget-test-2 } ]
 [ subclass-forget-test-2 class-usages ]
@@ -549,7 +549,7 @@ unit-test
 [ f ] [ subclass-forget-test-2 tuple-class? ] unit-test
 [ subclass-forget-test-3 new ] must-fail
 
-[ "IN: classes.tuple.tests TUPLE: subclass-forget-test-4 < subclass-forget-test-2 ;" eval ] must-fail
+[ "IN: classes.tuple.tests TUPLE: subclass-forget-test-4 < subclass-forget-test-2 ;" (( -- )) eval ] must-fail
 
 ! More
 DEFER: subclass-reset-test
@@ -562,11 +562,11 @@ GENERIC: break-me ( obj -- )
 [ ] [ [ M\ integer break-me forget ] with-compilation-unit ] unit-test
 
 [ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test ;" <string-reader> "subclass-reset-test" parse-stream drop ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-1 < subclass-reset-test ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-1 < subclass-reset-test ;" (( -- )) eval ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-2 < subclass-reset-test ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-2 < subclass-reset-test ;" (( -- )) eval ] unit-test
-[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-3 < subclass-reset-test-2 ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-3 < subclass-reset-test-2 ;" (( -- )) eval ] unit-test
 
-[ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" (( -- )) eval ] unit-test
 
 [ ] [ "IN: classes.tuple.tests : subclass-reset-test ( -- ) ;" <string-reader> "subclass-reset-test" parse-stream drop ] unit-test
 
@@ -576,7 +576,7 @@ GENERIC: break-me ( obj -- )
 
 [ t ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test
 
-[ ] [ "IN: classes.tuple.tests USE: math USE: kernel M: integer break-me drop ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests USE: math USE: kernel M: integer break-me drop ;" (( -- )) eval ] unit-test
 
 [ f ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test
 
@@ -632,7 +632,7 @@ TUPLE: reshape-test x ;
 
 T{ reshape-test f "hi" } "tuple" set
 
-[ ] [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: reshape-test { x read-only } ;" (( -- )) eval ] unit-test
 
 [ f ] [ \ reshape-test \ (>>x) method ] unit-test
 
@@ -640,11 +640,11 @@ T{ reshape-test f "hi" } "tuple" set
 
 [ "hi" ] [ "tuple" get x>> ] unit-test
 
-[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x integer read-only } ;" (( -- )) eval ] unit-test
 
 [ 0 ] [ "tuple" get x>> ] unit-test
 
-[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests USE: math TUPLE: reshape-test { x fixnum initial: 4 read-only } ;" (( -- )) eval ] unit-test
 
 [ 0 ] [ "tuple" get x>> ] unit-test
 
@@ -660,20 +660,20 @@ ERROR: error-class-test a b c ;
 [ "( a b c -- * )" ] [ \ error-class-test stack-effect effect>string ] unit-test
 [ f ] [ \ error-class-test "inline" word-prop ] unit-test
 
-[ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" eval ]
+[ "IN: classes.tuple.tests ERROR: error-x ; : error-x 3 ;" (( -- )) eval ]
 [ error>> error>> redefine-error? ] must-fail-with
 
 DEFER: error-y
 
 [ ] [ [ \ error-y dup class? [ forget-class ] [ drop ] if ] with-compilation-unit ] unit-test
 
-[ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests GENERIC: error-y ( a -- b )" (( -- )) eval ] unit-test
 
 [ f ] [ \ error-y tuple-class? ] unit-test
 
 [ t ] [ \ error-y generic? ] unit-test
 
-[ ] [ "IN: classes.tuple.tests ERROR: error-y ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests ERROR: error-y ;" (( -- )) eval ] unit-test
 
 [ t ] [ \ error-y tuple-class? ] unit-test
 
@@ -694,7 +694,7 @@ DEFER: error-y
 ] unit-test
 
 [ ] [
-    "IN: sequences TUPLE: reversed { seq read-only } ;" eval
+    "IN: sequences TUPLE: reversed { seq read-only } ;" (( -- )) eval
 ] unit-test
 
 TUPLE: bogus-hashcode-1 x ;
@@ -735,14 +735,14 @@ SLOT: kex
 
 DEFER: redefine-tuple-twice
 
-[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" (( -- )) eval ] unit-test
 
 [ t ] [ \ redefine-tuple-twice symbol? ] unit-test
 
-[ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests DEFER: redefine-tuple-twice" (( -- )) eval ] unit-test
 
 [ t ] [ \ redefine-tuple-twice deferred? ] unit-test
 
-[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval ] unit-test
+[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" (( -- )) eval ] unit-test
 
 [ t ] [ \ redefine-tuple-twice symbol? ] unit-test

core/classes/union/union-tests.factor

@@ -26,13 +26,13 @@ M: union-1 generic-update-test drop "union-1" ;
 [ t ] [ union-1 number class<= ] unit-test
 [ "union-1" ] [ 1.0 generic-update-test ] unit-test
 
-"IN: classes.union.tests USE: math USE: arrays UNION: union-1 rational array ;" eval
+"IN: classes.union.tests USE: math USE: arrays UNION: union-1 rational array ;" (( -- )) eval
 
 [ t ] [ bignum union-1 class<= ] unit-test
 [ f ] [ union-1 number class<= ] unit-test
 [ "union-1" ] [ { 1.0 } generic-update-test ] unit-test
 
-"IN: classes.union.tests USE: math PREDICATE: union-1 < integer even? ;" eval
+"IN: classes.union.tests USE: math PREDICATE: union-1 < integer even? ;" (( -- )) eval
 
 [ f ] [ union-1 union-class? ] unit-test
 [ t ] [ union-1 predicate-class? ] unit-test
@@ -58,7 +58,7 @@ UNION: redefine-bug-2 redefine-bug-1 quotation ;
 [ t ] [ fixnum redefine-bug-2 class<= ] unit-test
 [ t ] [ quotation redefine-bug-2 class<= ] unit-test
 
-[ ] [ "IN: classes.union.tests USE: math UNION: redefine-bug-1 bignum ;" eval ] unit-test
+[ ] [ "IN: classes.union.tests USE: math UNION: redefine-bug-1 bignum ;" (( -- )) eval ] unit-test
 
 [ t ] [ bignum redefine-bug-1 class<= ] unit-test
 [ f ] [ fixnum redefine-bug-2 class<= ] unit-test

core/combinators/combinators-tests.factor

@@ -357,7 +357,7 @@ DEFER: corner-case-1
 
 [ 4 ] [ 2 2 [ + ] curry 1array case ] unit-test
 
-: test-case-8 ( n -- )
+: test-case-8 ( n -- string )
     {
         { 1 [ "foo" ] }
     } case ;

core/compiler/units/units-tests.factor

@@ -56,6 +56,6 @@ observer add-definition-observer
 
 DEFER: nesting-test
 
-[ ] [ "IN: compiler.units.tests << : nesting-test ( -- ) ; >>" eval ] unit-test
+[ ] [ "IN: compiler.units.tests << : nesting-test ( -- ) ; >>" (( -- )) eval ] unit-test
 
 observer remove-definition-observer

core/continuations/continuations-tests.factor

@@ -3,7 +3,7 @@ continuations debugger parser memory arrays words
 kernel.private accessors eval ;
 IN: continuations.tests
 
-: (callcc1-test) ( -- )
+: (callcc1-test) ( n obj -- n' obj )
     [ 1- dup ] dip ?push
     over 0 = [ "test-cc" get continue-with ] when
     (callcc1-test) ;
@@ -59,7 +59,7 @@ IN: continuations.tests
 ! : callstack-overflow callstack-overflow f ;
 ! [ callstack-overflow ] must-fail
 
-: don't-compile-me ( -- ) { } [ ] each ;
+: don't-compile-me ( n -- ) { } [ ] each ;
 
 : foo ( -- ) callstack "c" set 3 don't-compile-me ;
 : bar ( -- a b ) 1 foo 2 ;

core/continuations/continuations.factor

@@ -74,14 +74,14 @@ C: <continuation> continuation
 <PRIVATE
 
 : (continue) ( continuation -- * )
+    [
         >continuation<
         set-catchstack
         set-namestack
         set-retainstack
         [ set-datastack ] dip
-    set-callstack ;
+        set-callstack
-
+    ] (( continuation -- * )) call-effect-unsafe ;
-\ (continue) t "no-compile" set-word-prop
 
 PRIVATE>
 

core/generic/generic-tests.factor

@@ -65,11 +65,11 @@ M: number union-containment drop 2 ;
 [ 2 ] [ 1.0 union-containment ] unit-test
 
 ! Testing recovery from bad method definitions
-"IN: generic.tests GENERIC: unhappy ( x -- x )" eval
+"IN: generic.tests GENERIC: unhappy ( x -- x )" (( -- )) eval
 [
-    "IN: generic.tests M: dictionary unhappy ;" eval
+    "IN: generic.tests M: dictionary unhappy ;" (( -- )) eval
 ] must-fail
-[ ] [ "IN: generic.tests GENERIC: unhappy ( x -- x )" eval ] unit-test
+[ ] [ "IN: generic.tests GENERIC: unhappy ( x -- x )" (( -- )) eval ] unit-test
 
 GENERIC# complex-combination 1 ( a b -- c )
 M: string complex-combination drop ;
@@ -177,7 +177,7 @@ M: f generic-forget-test-3 ;
 
 [ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
 
-[ ] [ "IN: generic.tests M: f generic-forget-test-3 ;" eval ] unit-test
+[ ] [ "IN: generic.tests M: f generic-forget-test-3 ;" (( -- )) eval ] unit-test
 
 [ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
 
@@ -193,7 +193,7 @@ M: integer a-generic a-word ;
 
 [ t ] [ "m" get \ a-word usage memq? ] unit-test
 
-[ ] [ "IN: generic.tests : a-generic ( -- ) ;" eval ] unit-test
+[ ] [ "IN: generic.tests : a-generic ( -- ) ;" (( -- )) eval ] unit-test
 
 [ f ] [ "m" get \ a-word usage memq? ] unit-test
 
@@ -207,25 +207,25 @@ M: integer a-generic a-word ;
     M: boii jeah ;
     GENERIC: jeah* ( a -- b )
     M: boii jeah* jeah ;
-    "> eval
+    "> (( -- )) eval
 
     <"
     IN: compiler.tests
     FORGET: boii
-    "> eval
+    "> (( -- )) eval
     
     <"
     IN: compiler.tests
     TUPLE: boii ;
     M: boii jeah ;
-    "> eval
+    "> (( -- )) eval
 ] unit-test
 
 ! call-next-method cache test
 GENERIC: c-n-m-cache ( a -- b )
 
 ! Force it to be unoptimized
-M: fixnum c-n-m-cache { } [ ] like call call-next-method ;
+M: fixnum c-n-m-cache { } [ ] like call( -- ) call-next-method ;
 M: integer c-n-m-cache 1 + ;
 M: number c-n-m-cache ;
 

core/generic/standard/standard-tests.factor

@@ -66,7 +66,7 @@ M: circle area radius>> sq pi * ;
 
 GENERIC: perimiter ( shape -- n )
 
-: rectangle-perimiter ( n -- n ) + 2 * ;
+: rectangle-perimiter ( l w -- n ) + 2 * ;
 
 M: rectangle perimiter
     [ width>> ] [ height>> ] bi

core/kernel/kernel-tests.factor

@@ -27,7 +27,7 @@ IN: kernel.tests
 
 [ ] [ :c ] unit-test
 
-: (overflow-d-alt) ( -- ) 3 ;
+: (overflow-d-alt) ( -- n ) 3 ;
 
 : overflow-d-alt ( -- ) (overflow-d-alt) overflow-d-alt ;
 
@@ -107,7 +107,7 @@ IN: kernel.tests
 ! Regression
 : (loop) ( a b c d -- )
     [ pick ] dip swap [ pick ] dip swap
-    < [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline
+    < [ [ 1+ ] 3dip (loop) ] [ 2drop 2drop ] if ; inline recursive
 
 : loop ( obj obj -- )
     H{ } values swap [ dup length swap ] dip 0 -roll (loop) ;

core/memory/memory-tests.factor

@@ -15,7 +15,7 @@ IN: memory.tests
 [ [ ] instances ] must-infer
 
 ! Code GC wasn't kicking in when needed
-: leak-step ( -- ) 800000 f <array> 1quotation call drop ;
+: leak-step ( -- ) 800000 f <array> 1quotation call( -- obj ) drop ;
 
 : leak-loop ( -- ) 100 [ leak-step ] times ;
 

core/parser/parser-tests.factor

@@ -10,43 +10,43 @@ IN: parser.tests
 
 [
     [ 1 [ 2 [ 3 ] 4 ] 5 ]
-    [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ]
+    [ "1\n[\n2\n[\n3\n]\n4\n]\n5" (( -- a b c )) eval ]
     unit-test
 
     [ t t f f ]
-    [ "t t f f" eval ]
+    [ "t t f f" (( -- ? ? ? ? )) eval ]
     unit-test
 
     [ "hello world" ]
-    [ "\"hello world\"" eval ]
+    [ "\"hello world\"" (( -- string )) eval ]
     unit-test
 
     [ "\n\r\t\\" ]
-    [ "\"\\n\\r\\t\\\\\"" eval ]
+    [ "\"\\n\\r\\t\\\\\"" (( -- string )) eval ]
     unit-test
 
     [ "hello world" ]
     [
         "IN: parser.tests : hello ( -- str ) \"hello world\" ;"
-        eval "USE: parser.tests hello" eval
+        (( -- )) eval "USE: parser.tests hello" (( -- string )) eval
     ] unit-test
 
     [ ]
-    [ "! This is a comment, people." eval ]
+    [ "! This is a comment, people." (( -- )) eval ]
     unit-test
 
     ! Test escapes
 
     [ " " ]
-    [ "\"\\u000020\"" eval ]
+    [ "\"\\u000020\"" (( -- string )) eval ]
     unit-test
 
     [ "'" ]
-    [ "\"\\u000027\"" eval ]
+    [ "\"\\u000027\"" (( -- string )) eval ]
     unit-test
 
     ! Test EOL comments in multiline strings.
-    [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" eval ] unit-test
+    [ "Hello" ] [ "#! This calls until-eol.\n\"Hello\"" (( -- string )) eval ] unit-test
 
     [ word ] [ \ f class ] unit-test
 
@@ -68,7 +68,7 @@ IN: parser.tests
     [ \ baz "declared-effect" word-prop terminated?>> ]
     unit-test
 
-    [ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" eval ] unit-test
+    [ ] [ "IN: parser.tests USE: math : effect-parsing-test ( a b -- d ) - ;" (( -- )) eval ] unit-test
 
     [ t ] [
         "effect-parsing-test" "parser.tests" lookup
@@ -79,14 +79,14 @@ IN: parser.tests
     [ \ effect-parsing-test "declared-effect" word-prop ] unit-test
 
     ! Funny bug
-    [ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." eval ] unit-test
+    [ 2 ] [ "IN: parser.tests : \0. ( -- x ) 2 ; \0." (( -- n )) eval ] unit-test
 
-    [ "IN: parser.tests : missing-- ( a b ) ;" eval ] must-fail
+    [ "IN: parser.tests : missing-- ( a b ) ;" (( -- )) eval ] must-fail
 
     ! These should throw errors
-    [ "HEX: zzz" eval ] must-fail
+    [ "HEX: zzz" (( -- obj )) eval ] must-fail
-    [ "OCT: 999" eval ] must-fail
+    [ "OCT: 999" (( -- obj )) eval ] must-fail
-    [ "BIN: --0" eval ] must-fail
+    [ "BIN: --0" (( -- obj )) eval ] must-fail
 
     ! Another funny bug
     [ t ] [
@@ -102,14 +102,14 @@ IN: parser.tests
     ] unit-test
     DEFER: foo
 
-    "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" eval
+    "IN: parser.tests USING: math prettyprint ; SYNTAX: foo 2 2 + . ;" (( -- )) eval
 
-    [ ] [ "USE: parser.tests foo" eval ] unit-test
+    [ ] [ "USE: parser.tests foo" (( -- )) eval ] unit-test
 
-    "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" eval
+    "IN: parser.tests USING: math prettyprint ; : foo ( -- ) 2 2 + . ;" (( -- )) eval
 
     [ t ] [
-        "USE: parser.tests \\ foo" eval
+        "USE: parser.tests \\ foo" (( -- word )) eval
         "foo" "parser.tests" lookup eq?
     ] unit-test
 
@@ -269,12 +269,12 @@ IN: parser.tests
     ] unit-test
 
     [ ] [
-        "IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- ) <bogus-error> ;"
+        "IN: parser.tests : <bogus-error> ( -- ) ; : bogus ( -- error ) <bogus-error> ;"
         <string-reader> "bogus-error" parse-stream drop
     ] unit-test
 
     [ ] [
-        "IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- ) <bogus-error> ;"
+        "IN: parser.tests TUPLE: bogus-error ; C: <bogus-error> bogus-error : bogus ( -- error ) <bogus-error> ;"
         <string-reader> "bogus-error" parse-stream drop
     ] unit-test
 
@@ -339,16 +339,16 @@ IN: parser.tests
     ] [ error>> error>> error>> redefine-error? ] must-fail-with
 
     [ ] [
-        "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" eval
+        "IN: parser.tests : foo ( x y -- z ) 1 2 ; : bar ( a -- b ) ;" (( -- )) eval
     ] unit-test
 
     [
-        "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" eval
+        "IN: parser.tests : foo ( x y -- z) 1 2 ; : bar ( a -- b ) ;" (( -- )) eval
     ] must-fail
 ] with-file-vocabs
 
 [ ] [
-    "IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" eval
+    "IN: parser.tests USE: kernel PREDICATE: foo < object ( x -- y ) ;" (( -- )) eval
 ] unit-test
 
 [ t ] [
@@ -422,31 +422,31 @@ IN: parser.tests
 ] unit-test
 
 [
-    "USE: this-better-not-exist" eval
+    "USE: this-better-not-exist" (( -- )) eval
 ] must-fail
 
-[ ": foo ;" eval ] [ error>> error>> no-current-vocab? ] must-fail-with
+[ ": foo ;" (( -- )) eval ] [ error>> error>> no-current-vocab? ] must-fail-with
 
-[ 92 ] [ "CHAR: \\" eval ] unit-test
+[ 92 ] [ "CHAR: \\" (( -- n )) eval ] unit-test
-[ 92 ] [ "CHAR: \\\\" eval ] unit-test
+[ 92 ] [ "CHAR: \\\\" (( -- n )) eval ] unit-test
 
 [ ] [
     {
         "IN: parser.tests"
-        "USING: math arrays ;"
+        "USING: math arrays kernel ;"
-        "GENERIC: change-combination ( a -- b )"
+        "GENERIC: change-combination ( obj a -- b )"
-        "M: integer change-combination 1 ;"
+        "M: integer change-combination 2drop 1 ;"
-        "M: array change-combination 2 ;"
+        "M: array change-combination 2drop 2 ;"
     } "\n" join <string-reader> "change-combination-test" parse-stream drop
 ] unit-test
 
 [ ] [
     {
         "IN: parser.tests"
-        "USING: math arrays ;"
+        "USING: math arrays kernel ;"
-        "GENERIC# change-combination 1 ( a -- b )"
+        "GENERIC# change-combination 1 ( obj a -- b )"
-        "M: integer change-combination 1 ;"
+        "M: integer change-combination 2drop 1 ;"
-        "M: array change-combination 2 ;"
+        "M: array change-combination 2drop 2 ;"
     } "\n" join <string-reader> "change-combination-test" parse-stream drop
 ] unit-test
 
@@ -463,7 +463,7 @@ IN: parser.tests
 ] unit-test
 
 [ [ ] ] [
-    "IN: parser.tests : staging-problem-test-1 ( -- ) 1 ; : staging-problem-test-2 ( -- ) staging-problem-test-1 ;"
+    "IN: parser.tests : staging-problem-test-1 ( -- a ) 1 ; : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
     <string-reader> "staging-problem-test" parse-stream
 ] unit-test
 
@@ -472,7 +472,7 @@ IN: parser.tests
 [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
 
 [ [ ] ] [
-    "IN: parser.tests << : staging-problem-test-1 ( -- ) 1 ; >> : staging-problem-test-2 ( -- ) staging-problem-test-1 ;"
+    "IN: parser.tests << : staging-problem-test-1 ( -- a ) 1 ; >> : staging-problem-test-2 ( -- a ) staging-problem-test-1 ;"
     <string-reader> "staging-problem-test" parse-stream
 ] unit-test
 
@@ -480,10 +480,10 @@ IN: parser.tests
 
 [ t ] [ "staging-problem-test-2" "parser.tests" lookup >boolean ] unit-test
 
-[ "DEFER: blahy" eval ] [ error>> error>> no-current-vocab? ] must-fail-with
+[ "DEFER: blahy" (( -- )) eval ] [ error>> error>> no-current-vocab? ] must-fail-with
 
 [
-    "IN: parser.tests SYNTAX: blahy ; FORGET: blahy" eval
+    "IN: parser.tests SYNTAX: blahy ; FORGET: blahy" (( -- )) eval
 ] [
     error>> staging-violation?
 ] must-fail-with
@@ -491,12 +491,12 @@ IN: parser.tests
 ! Bogus error message
 DEFER: blahy
 
-[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" eval ]
+[ "IN: parser.tests USE: kernel TUPLE: blahy < tuple ; : blahy ( -- ) ; TUPLE: blahy < tuple ; : blahy ( -- ) ;" (( -- )) eval ]
 [ error>> error>> def>> \ blahy eq? ] must-fail-with
 
 [ ] [ f lexer set f file set "Hello world" note. ] unit-test
 
-[ "CHAR: \\u9999999999999" eval ] must-fail
+[ "CHAR: \\u9999999999999" (( -- n )) eval ] must-fail
 
 SYMBOLS: a b c ;
 
@@ -506,15 +506,15 @@ SYMBOLS: a b c ;
 
 DEFER: blah
 
-[ ] [ "IN: parser.tests GENERIC: blah ( -- )" eval ] unit-test
+[ ] [ "IN: parser.tests GENERIC: blah ( -- )" (( -- )) eval ] unit-test
-[ ] [ "IN: parser.tests SYMBOLS: blah ;" eval ] unit-test
+[ ] [ "IN: parser.tests SYMBOLS: blah ;" (( -- )) eval ] unit-test
 
 [ f ] [ \ blah generic? ] unit-test
 [ t ] [ \ blah symbol? ] unit-test
 
 DEFER: blah1
 
-[ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" eval ]
+[ "IN: parser.tests SINGLETONS: blah1 blah1 blah1 ;" (( -- )) eval ]
 [ error>> error>> def>> \ blah1 eq? ]
 must-fail-with
 
@@ -545,10 +545,10 @@ EXCLUDE: qualified.tests.bar => x ;
 [ 3 ] [ x ] unit-test
 [ 4 ] [ y ] unit-test
 
-[ "IN: qualified.tests FROM: qualified.tests => doesnotexist ;" eval ]
+[ "IN: qualified.tests FROM: qualified.tests => doesnotexist ;" (( -- )) eval ]
 [ error>> no-word-error? ] must-fail-with
 
-[ "IN: qualified.tests RENAME: doesnotexist qualified.tests => blahx" eval ]
+[ "IN: qualified.tests RENAME: doesnotexist qualified.tests => blahx" (( -- )) eval ]
 [ error>> no-word-error? ] must-fail-with
 
 ! Two similar bugs

core/slots/slots-tests.factor

@@ -25,12 +25,12 @@ TUPLE: hello length ;
 [ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test
 
 ! See if declarations are cleared on redefinition
-[ ] [ "IN: slots.tests TUPLE: r/w-test { foo read-only } ;" eval ] unit-test
+[ ] [ "IN: slots.tests TUPLE: r/w-test { foo read-only } ;" (( -- )) eval ] unit-test
 
 [ t ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
 [ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test
 
-[ ] [ "IN: slots.tests TUPLE: r/w-test foo ;" eval ] unit-test
+[ ] [ "IN: slots.tests TUPLE: r/w-test foo ;" (( -- )) eval ] unit-test
 
 [ f ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
 [ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test

core/vocabs/loader/loader-tests.factor

@@ -143,7 +143,7 @@ IN: vocabs.loader.tests
 forget-junk
 
 [ { } ] [
-    "IN: xabbabbja" eval "xabbabbja" vocab-files
+    "IN: xabbabbja" (( -- )) eval "xabbabbja" vocab-files
 ] unit-test
 
 [ "xabbabbja" forget-vocab ] with-compilation-unit

core/words/alias/alias-tests.factor

@@ -2,5 +2,5 @@ USING: math eval tools.test effects ;
 IN: words.alias.tests
 
 ALIAS: foo +
-[ ] [ "IN: words.alias.tests CONSTANT: foo 5" eval ] unit-test
+[ ] [ "IN: words.alias.tests CONSTANT: foo 5" (( -- )) eval ] unit-test
 [ (( -- value )) ] [ \ foo stack-effect ] unit-test

core/words/words-tests.factor

@@ -6,7 +6,7 @@ IN: words.tests
 
 [ 4 ] [
     [
-        "poo" "words.tests" create [ 2 2 + ] define
+        "poo" "words.tests" create [ 2 2 + ] (( -- n )) define-declared
     ] with-compilation-unit
     "poo" "words.tests" lookup execute
 ] unit-test
@@ -51,7 +51,7 @@ SYMBOL: a-symbol
 ! See if redefining a generic as a colon def clears some
 ! word props.
 GENERIC: testing ( a -- b )
-"IN: words.tests : testing ( -- ) ;" eval
+"IN: words.tests : testing ( -- ) ;" (( -- )) eval
 
 [ f ] [ \ testing generic? ] unit-test
 
@@ -88,7 +88,7 @@ DEFER: calls-a-gensym
     [
         \ calls-a-gensym
         gensym dup "x" set 1quotation
-        define
+        (( x -- x )) define-declared
     ] with-compilation-unit
 ] unit-test
 
@@ -116,10 +116,10 @@ DEFER: x
 [ ] [ "no-loc" "words.tests" create drop ] unit-test
 [ f ] [ "no-loc" "words.tests" lookup where ] unit-test
 
-[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" eval ] unit-test
+[ ] [ "IN: words.tests : no-loc-2 ( -- ) ;" (( -- )) eval ] unit-test
 [ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test
 
-[ ] [ "IN: words.tests : test-last ( -- ) ;" eval ] unit-test
+[ ] [ "IN: words.tests : test-last ( -- ) ;" (( -- )) eval ] unit-test
 [ "test-last" ] [ word name>> ] unit-test
 
 ! regression
@@ -146,15 +146,15 @@ SYMBOL: quot-uses-b
     [ forget ] with-compilation-unit
 ] when*
 
-[ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" eval ]
+[ "IN: words.tests : undef-test ( -- ) ; << undef-test >>" (( -- )) eval ]
 [ error>> undefined? ] must-fail-with
 
 [ ] [
-    "IN: words.tests GENERIC: symbol-generic ( -- )" eval
+    "IN: words.tests GENERIC: symbol-generic ( -- )" (( -- )) eval
 ] unit-test
 
 [ ] [
-    "IN: words.tests SYMBOL: symbol-generic" eval
+    "IN: words.tests SYMBOL: symbol-generic" (( -- )) eval
 ] unit-test
 
 [ t ] [ "symbol-generic" "words.tests" lookup symbol? ] unit-test
@@ -174,14 +174,14 @@ SYMBOL: quot-uses-b
 [ f ] [ "symbol-generic" "words.tests" lookup generic? ] unit-test
 
 ! Regressions
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" eval ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; foldable" (( -- )) eval ] unit-test
 [ t ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" (( -- )) eval ] unit-test
 [ f ] [ "decl-forget-test" "words.tests" lookup "foldable" word-prop ] unit-test
 
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" eval ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ( -- ) ; flushable" (( -- )) eval ] unit-test
 [ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
-[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" eval ] unit-test
+[ ] [ "IN: words.tests : decl-forget-test ( -- ) ;" (( -- )) eval ] unit-test
 [ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test
 
 [ { } ]

extra/advice/advice.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 James Cash
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences fry words assocs linked-assocs tools.annotations
-coroutines lexer parser quotations arrays namespaces continuations ;
+coroutines lexer parser quotations arrays namespaces continuations
+summary ;
 IN: advice
 
 SYMBOLS: before after around advised in-advice? ;
@@ -45,8 +46,13 @@ PRIVATE>
 : remove-advice ( name word loc --  )
     word-prop delete-at ;
 
+ERROR: ad-do-it-error ;
+
+M: ad-do-it-error summary
+    drop "ad-do-it should only be called inside 'around' advice" ;
+
 : ad-do-it ( input -- result )
-    in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ;
+    in-advice? get [ ad-do-it-error ] unless coyield ;
     
 : make-advised ( word -- )
     [ dup '[ [ _ ] dip over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]

extra/coroutines/coroutines.factor

@@ -19,9 +19,10 @@ TUPLE: coroutine resumecc exitcc originalcc ;
 : coresume ( v co -- result )
   [ 
     >>exitcc
-    resumecc>> call
+    resumecc>> call( -- )
     #! At this point, the coroutine quotation must have terminated
-    #! normally (without calling coyield, coreset, or coterminate). This shouldn't happen.
+    #! normally (without calling coyield, coreset, or coterminate).
+    #! This shouldn't happen.
     f over
   ] callcc1 2nip ;
 

extra/lint/lint-tests.factor

@@ -2,7 +2,7 @@ USING: io lint kernel math tools.test ;
 IN: lint.tests
 
 ! Don't write code like this
-: lint1 ( -- ) [ "hi" print ] [ ] if ; ! when
+: lint1 ( obj -- ) [ "hi" print ] [ ] if ; ! when
 
 [ { { lint1 { [ [ ] if ] } } } ] [ \ lint1 lint-word ] unit-test
 

extra/mason/test/test.factor

@@ -25,8 +25,8 @@ M: method-body word-vocabulary "method-generic" word-prop word-vocabulary ;
 
 : do-compile-errors ( -- )
     compiler-errors get values
-    compiler-error-messages-file
     compiler-errors-file
+    compiler-error-messages-file
     do-step ;
 
 : do-tests ( -- )

extra/math/numerical-integration/numerical-integration.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel sequences namespaces make math math.ranges
+USING: kernel math math.ranges math.vectors namespaces
-math.vectors vectors ;
+sequences ;
 IN: math.numerical-integration
 
 SYMBOL: num-steps
@@ -15,7 +15,7 @@ SYMBOL: num-steps
     length 2 / 2 - { 2 4 } <repetition> concat
     { 1 4 } { 1 } surround ;
 
-: integrate-simpson ( from to f -- x )
+: integrate-simpson ( from to quot -- x )
     [ setup-simpson-range dup ] dip 
     map dup generate-simpson-weights
-    v. swap [ third ] keep first - 6 / * ;
+    v. swap [ third ] keep first - 6 / * ; inline

extra/partial-continuations/partial-continuations-tests.factor

@@ -7,7 +7,7 @@ SYMBOL: sum
 : range ( r from to -- n )
     over - 1 + rot [ 
         -rot [ over + pick call drop ] each 2drop f  
-    ] bshift 2nip ;
+    ] bshift 2nip ; inline
 
 [ 55 ] [
     0 sum set 

unmaintained/graph-theory/graph-theory.factor

@@ -1,8 +1,7 @@
 ! Copyright (C) 2008 William Schlieper <schlieper@unc.edu>
 ! See http://factorcode.org/license.txt for BSD license.
-
+USING: kernel combinators fry continuations sequences arrays
-USING: kernel combinators fry continuations sequences arrays vectors assocs hashtables heaps namespaces ;
+vectors assocs hashtables heaps namespaces ;
-
 IN: graph-theory
 
 MIXIN: graph
@@ -35,7 +34,7 @@ M: graph num-vertices
     vertices length ;
 
 M: graph num-edges
-   [ vertices ] [ '[ _ adjlist length ] map sum ] bi ;
+   [ vertices ] [ '[ _ adjlist length ] sigma ] bi ;
 
 M: graph adjlist
     [ vertices ] [ swapd '[ _ swap _ adj? ] filter ] bi ;
@@ -88,5 +87,5 @@ PRIVATE>
 
 : topological-sort ( graph -- seq/f )
     dup dag?
-    [ V{ } swap [ drop ] [ prefix ] [ ] full-depth-first drop ]
+    [ V{ } clone swap [ drop ] [ prefix ] [ ] full-depth-first drop ]
     [ drop f ] if ;