Fixing unit tests

basis/compiler/tree/builder/builder.factor

@@ -39,7 +39,7 @@ IN: compiler.tree.builder
     ] if ;
 
 : check-cannot-infer ( word -- )
-    dup +cannot-infer+ word-prop [ cannot-infer-effect ] [ drop ] if ;
+    dup "cannot-infer" word-prop [ cannot-infer-effect ] [ drop ] if ;
 
 : check-no-compile ( word -- )
     dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ;

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

@@ -24,6 +24,11 @@ IN: compiler.tree.def-use.tests
     compute-def-use
     check-nodes ;
 
+: too-deep ( a b -- c )
+    dup [ drop ] [ 2dup too-deep too-deep drop ] if ; inline recursive
+
+[ ] [ [ too-deep ] build-tree normalize compute-def-use check-nodes ] unit-test
+
 ! compute-def-use checks for SSA violations, so we use that to
 ! ensure we generate some common patterns correctly.
 {

basis/compiler/tree/normalization/normalization.factor

@@ -81,7 +81,7 @@ SYMBOL: rename-map
     [ rename-map get at ] keep or ;
 
 : rename-values ( values -- values' )
-    [ rename-value ] map ;
+    rename-map get '[ [ , at ] keep or ] map ;
 
 GENERIC: rename-node-values* ( node -- node )
 
@@ -126,6 +126,7 @@ SYMBOL: introduction-stack
     introduction-stack [ swap cut* swap ] change ;
 
 : add-renamings ( old new -- )
+    [ rename-values ] dip
     rename-map get '[ , set-at ] 2each ;
 
 M: #introduce normalize*

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

@@ -560,6 +560,11 @@ M: integer infinite-loop infinite-loop ;
 
 [ ] [ [ 0 fold-throw-test ] final-info drop ] unit-test
 
+: too-deep ( a b -- c )
+    dup [ drop ] [ 2dup too-deep too-deep * ] if ; inline recursive
+
+[ ] [ [ too-deep ] final-info drop ] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test

basis/hints/hints-docs.factor

@@ -1,5 +1,5 @@
 IN: hints
-USING: help.markup help.syntax words ;
+USING: help.markup help.syntax words quotations sequences ;
 
 ARTICLE: "hints" "Compiler specialization hints"
 "Specialization hints help the compiler generate efficient code."
@@ -11,7 +11,7 @@ $nl
 "In some cases, specialization will not help at all, and can make generated code slower from the increase in code size. The compiler is capable of inferring enough static type information to generate efficient code in many cases without explicit help from the programmer. Specializers should be used as a last resort, after profiling shows that a critical loop makes a lot of repeated calls to generic words which dispatch on the same class."
 $nl
 "Type hints are declared with a parsing word:"
-{ $subsection POSTPONE: HINT: }
+{ $subsection POSTPONE: HINTS: }
 $nl
 "The specialized version of a word which will be compiled by the compiler can be inspected:"
 { $subsection specialized-def } ;

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

@@ -53,14 +53,14 @@ SYMBOL: 8-bit-encodings
 TUPLE: 8-bit decode encode ;
 
 : encode-8-bit ( char stream assoc -- )
-    swap >r at*
-    [ r> stream-write1 ] [ r> drop encode-error ] if ; inline
+    swapd at*
+    [ swap stream-write1 ] [ nip encode-error ] if ; inline
 
 M: 8-bit encode-char encode>> encode-8-bit ;
 
 : decode-8-bit ( stream array -- char/f )
-    >r stream-read1 dup
-    [ r> nth [ replacement-char ] unless* ] [ r> 2drop f ] if ; inline
+    swap stream-read1 dup
+    [ swap nth [ replacement-char ] unless* ] [ 2drop f ] if ; inline
 
 M: 8-bit decode-char decode>> decode-8-bit ;
 

basis/stack-checker/backend/backend.factor

@@ -9,15 +9,9 @@ stack-checker.visitor stack-checker.errors ;
 IN: stack-checker.backend
 
 ! Word properties we use
-SYMBOL: +inferred-effect+
-SYMBOL: +cannot-infer+
-SYMBOL: +special+
-SYMBOL: +shuffle+
-SYMBOL: +infer+
-
 SYMBOL: visited
 
-: reset-on-redefine { +inferred-effect+ +cannot-infer+ } ; inline
+: reset-on-redefine { "inferred-effect" "cannot-infer" } ; inline
 
 : (redefined) ( word -- )
     dup visited get key? [ drop ] [
@@ -122,7 +116,7 @@ M: object apply-object push-literal ;
     consume-r dup copy-values [ #r>, ] [ nip output-d ] 2bi ;
 
 : undo-infer ( -- )
-    recorded get [ f +inferred-effect+ set-word-prop ] each ;
+    recorded get [ f "inferred-effect" set-word-prop ] each ;
 
 : consume/produce ( effect quot -- )
     #! quot is ( inputs outputs -- )
@@ -168,11 +162,11 @@ M: object apply-object push-literal ;
     current-effect
     [ check-effect ]
     [ drop recorded get push ]
-    [ +inferred-effect+ set-word-prop ]
+    [ "inferred-effect" set-word-prop ]
     2tri ;
 
 : maybe-cannot-infer ( word quot -- )
-    [ ] [ t +cannot-infer+ set-word-prop ] cleanup ; inline
+    [ ] [ t "cannot-infer" set-word-prop ] cleanup ; inline
 
 : infer-word ( word -- effect )
     [
@@ -197,7 +191,7 @@ M: object apply-object push-literal ;
     dup required-stack-effect apply-word/effect ;
 
 : cached-infer ( word -- )
-    dup +inferred-effect+ word-prop apply-word/effect ;
+    dup "inferred-effect" word-prop apply-word/effect ;
 
 : with-infer ( quot -- effect visitor )
     [

basis/stack-checker/known-words/known-words.factor

@@ -43,7 +43,7 @@ IN: stack-checker.known-words
     { over  (( x y   -- x y x       )) }
     { pick  (( x y z -- x y z x     )) }
     { swap  (( x y   -- y x         )) }
-} [ +shuffle+ set-word-prop ] assoc-each
+} [ "shuffle" set-word-prop ] assoc-each
 
 : infer-shuffle ( shuffle -- )
     [ in>> length consume-d ] keep ! inputs shuffle
@@ -52,7 +52,7 @@ IN: stack-checker.known-words
     #shuffle, ;
 
 : infer-shuffle-word ( word -- )
-    +shuffle+ word-prop infer-shuffle ;
+    "shuffle" word-prop infer-shuffle ;
 
 : infer-declare ( -- )
     pop-literal nip
@@ -166,7 +166,7 @@ M: object infer-call*
     >r r> declare call curry compose execute if dispatch
     <tuple-boa> (throw) load-locals get-local drop-locals
     do-primitive alien-invoke alien-indirect alien-callback
-} [ t +special+ set-word-prop ] each
+} [ t "special" set-word-prop ] each
 
 { call execute dispatch load-locals get-local drop-locals }
 [ t "no-compile" set-word-prop ] each
@@ -176,13 +176,13 @@ SYMBOL: +primitive+
 : non-inline-word ( word -- )
     dup +called+ depends-on
     {
-        { [ dup +shuffle+ word-prop ] [ infer-shuffle-word ] }
-        { [ dup +special+ word-prop ] [ infer-special ] }
+        { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
+        { [ dup "special" word-prop ] [ infer-special ] }
         { [ dup +primitive+ word-prop ] [ infer-primitive ] }
         { [ dup +transform-quot+ word-prop ] [ apply-transform ] }
         { [ dup "macro" word-prop ] [ apply-macro ] }
-        { [ dup +cannot-infer+ word-prop ] [ cannot-infer-effect ] }
-        { [ dup +inferred-effect+ word-prop ] [ cached-infer ] }
+        { [ dup "cannot-infer" word-prop ] [ cannot-infer-effect ] }
+        { [ dup "inferred-effect" word-prop ] [ cached-infer ] }
         { [ dup recursive-label ] [ call-recursive-word ] }
         [ dup infer-word apply-word/effect ]
     } cond ;
@@ -598,7 +598,7 @@ SYMBOL: +primitive+
 
 \ (set-os-envs) { array } { } define-primitive
 
-\ do-primitive [ \ do-primitive cannot-infer-effect ] +infer+ set-word-prop
+\ do-primitive [ \ do-primitive cannot-infer-effect ] "infer" set-word-prop
 
 \ dll-valid? { object } { object } define-primitive
 

basis/stack-checker/stack-checker.factor

@@ -18,10 +18,10 @@ M: callable infer ( quot -- effect )
 
 : forget-errors ( -- )
     all-words [
-        dup subwords [ f +cannot-infer+ set-word-prop ] each
-        f +cannot-infer+ set-word-prop
+        dup subwords [ f "cannot-infer" set-word-prop ] each
+        f "cannot-infer" set-word-prop
     ] each ;
 
 : forget-effects ( -- )
     forget-errors
-    all-words [ f +inferred-effect+ set-word-prop ] each ;
+    all-words [ f "inferred-effect" set-word-prop ] each ;

core/classes/algebra/algebra-tests.factor

@@ -3,7 +3,7 @@ kernel math namespaces parser prettyprint sequences strings
 tools.test vectors words quotations classes classes.algebra
 classes.private classes.union classes.mixin classes.predicate
 vectors definitions source-files compiler.units growable
-random inference effects kernel.private sbufs math.order
+random stack-checker effects kernel.private sbufs math.order
 classes.tuple ;
 IN: classes.algebra.tests
 

core/generic/generic-tests.factor

@@ -91,10 +91,7 @@ M: ratio big-generic-test "ratio" ;
 M: string big-generic-test "string" ;
 M: shit big-generic-test "shit" ;
 
-TUPLE: delegating ;
-
 [ T{ shit f } "shit" ] [ T{ shit f } big-generic-test ] unit-test
-[ T{ shit f } "shit" ] [ T{ delegating T{ shit f } } big-generic-test ] unit-test
 
 [ t ] [ \ + math-generic? ] unit-test
 

core/generic/standard/standard-tests.factor

@@ -2,7 +2,7 @@ IN: generic.standard.tests
 USING: tools.test math math.functions math.constants
 generic.standard strings sequences arrays kernel accessors
 words float-arrays byte-arrays bit-arrays parser namespaces
-quotations inference vectors growable hashtables sbufs
+quotations stack-checker vectors growable hashtables sbufs
 prettyprint byte-vectors bit-vectors float-vectors definitions
 generic sets graphs assocs ;
 

core/io/files/files-tests.factor

@@ -1,6 +1,6 @@
 IN: io.files.tests
 USING: tools.test io.files io.files.private io threads kernel
-continuations io.encodings.ascii io.files.unique sequences
+continuations io.encodings.ascii sequences
 strings accessors io.encodings.utf8 math destructors
 namespaces ;
 
@@ -126,6 +126,8 @@ namespaces ;
 
 [ f ] [ "test-blah" temp-file exists? ] unit-test
 
+USE: debugger.threads
+
 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 
 [ ] [ "test-quux.txt" temp-file delete-file ] unit-test
@@ -133,6 +135,7 @@ namespaces ;
 [ ] [ "test-quux.txt" temp-file ascii [ [ yield "Hi" write ] "Test" spawn drop ] with-file-writer ] unit-test
 
 [ ] [ "test-quux.txt" "quux-test.txt" [ temp-file ] bi@ move-file ] unit-test
+
 [ t ] [ "quux-test.txt" temp-file exists? ] unit-test
 
 [ ] [ "quux-test.txt" temp-file delete-file ] unit-test
@@ -221,18 +224,6 @@ namespaces ;
 
 [ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test
 
-
-
-[ 123 ] [
-    "core" ".test" [
-        [
-            ascii [
-                123 CHAR: a <repetition> >string write
-            ] with-file-writer
-        ] keep file-info size>>
-    ] with-unique-file
-] unit-test
-
 [ "/usr/lib" ] [ "/usr" "lib" append-path ] unit-test
 [ "/usr/lib" ] [ "/usr/" "lib" append-path ] unit-test
 [ "/usr/lib" ] [ "/usr" "./lib" append-path ] unit-test

extra/combinators/lib/lib.factor

@@ -3,7 +3,7 @@
 !                          Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel combinators fry namespaces quotations hashtables
-sequences assocs arrays inference effects math math.ranges
+sequences assocs arrays stack-checker effects math math.ranges
 generalizations macros continuations random locals ;
 
 IN: combinators.lib

extra/inverse/inverse.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel words summary slots quotations
-sequences assocs math arrays inference effects generalizations
+sequences assocs math arrays stack-checker effects generalizations
 continuations debugger classes.tuple namespaces vectors
 bit-arrays byte-arrays strings sbufs math.functions macros
 sequences.private combinators mirrors

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

@@ -0,0 +1,11 @@
+IN: io.files.unique.tests
+
+[ 123 ] [
+    "core" ".test" [
+        [
+            ascii [
+                123 CHAR: a <repetition> >string write
+            ] with-file-writer
+        ] keep file-info size>>
+    ] with-unique-file
+] unit-test

extra/mortar/mortar.factor

@@ -48,18 +48,6 @@ if ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-USE: inference.transforms
-
-! : narray ( n -- array ) [ drop ] map reverse ;
-
-: [narray] ( n -- quot ) [ [ drop ] map reverse ] curry ;
-
-: narray ( n -- array ) [narray] call ;
-
-\ narray [ [narray] ] 1 define-transform
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : new ( class -- object )
 get dup >r class-slots length narray r> swap 2array ;
 

extra/pack/pack.factor

@@ -1,7 +1,7 @@
-USING: alien alien.c-types arrays assocs byte-arrays inference
-inference.transforms io io.binary io.streams.string kernel math
-math.parser namespaces parser prettyprint quotations sequences
-strings vectors words macros math.functions math.bitfields.lib ;
+USING: alien alien.c-types arrays assocs byte-arrays io
+io.binary io.streams.string kernel math math.parser namespaces
+parser prettyprint quotations sequences strings vectors words
+macros math.functions math.bitfields.lib ;
 IN: pack
 
 SYMBOL: big-endian

extra/peg/ebnf/ebnf.factor

@@ -4,8 +4,8 @@ USING: kernel compiler.units words arrays strings math.parser sequences
        quotations vectors namespaces math assocs continuations peg
        peg.parsers unicode.categories multiline combinators.lib 
        splitting accessors effects sequences.deep peg.search
-       combinators.short-circuit lexer io.streams.string inference io
-       prettyprint combinators parser ;
+       combinators.short-circuit lexer io.streams.string
+       stack-checker io prettyprint combinators parser ;
 IN: peg.ebnf
 
 : rule ( name word -- parser )

extra/promises/promises.factor

@@ -5,7 +5,7 @@
 ! Updated by Chris Double, September 2006
 
 USING: arrays kernel sequences math vectors arrays namespaces
-quotations parser effects inference words ;
+quotations parser effects stack-checker words ;
 IN: promises
 
 TUPLE: promise quot forced? value ;