Debugging compiler

diff --git a/basis/compiler/tests/optimizer.factor b/basis/compiler/tests/optimizer.factor
index 9f9a6e8e923ea9f11b02d841a1100aba026c49e6..fd18dcafce7c2632f959c8afaeb602d16ad532a6 100755 (executable)
--- a/basis/compiler/tests/optimizer.factor
+++ b/basis/compiler/tests/optimizer.factor
@@ -3,7 +3,7 @@ stack-checker kernel kernel.private math prettyprint sequences
 sbufs strings tools.test vectors words sequences.private
 quotations classes classes.algebra classes.tuple.private
 continuations growable namespaces hints alien.accessors
-compiler.tree.builder compiler.tree.optimizer ;
+compiler.tree.builder compiler.tree.optimizer sequences.deep ;
 IN: optimizer.tests
 
 GENERIC: xyz ( obj -- obj )
@@ -353,3 +353,8 @@ TUPLE: some-tuple x ;
 [ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-8 1+ ] compile-call ] unit-test
 [ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-signed-cell 1+ ] compile-call ] unit-test
 [ 1 ] [ B{ 0 0 0 0 0 0 0 0 } [ 0 alien-unsigned-cell 1+ ] compile-call ] unit-test
+
+: deep-find-test ( seq -- ? ) [ 5 = ] deep-find ;
+
+[ 5 ] [ { 1 2 { 3 { 4 5 } } } deep-find-test ] unit-test
+[ f ] [ { 1 2 { 3 { 4 } } } deep-find-test ] unit-test

diff --git a/basis/compiler/tests/redefine4.factor b/basis/compiler/tests/redefine4.factor
index 2c667eaceb1b789b76504418177d7e43ce6e2d6b..2f21777801b44fd30e816a95bb7d39bd815cab8e 100644 (file)
--- a/basis/compiler/tests/redefine4.factor
+++ b/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\" print 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

diff --git a/basis/compiler/tree/cleanup/cleanup.factor b/basis/compiler/tree/cleanup/cleanup.factor
index 9feb931c039811b5f74a7f3d89f34387df2679b7..49832bcac0b22603819425d1ae6fe494bb7e458a 100644 (file)
--- a/basis/compiler/tree/cleanup/cleanup.factor
+++ b/basis/compiler/tree/cleanup/cleanup.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences sequences.deep combinators fry
-classes.algebra namespaces assocs math math.private
-math.partial-dispatch classes.tuple classes.tuple.private
+classes.algebra namespaces assocs words math math.private
+math.partial-dispatch classes classes.tuple classes.tuple.private
 definitions stack-checker.state stack-checker.branches
 compiler.tree
 compiler.tree.intrinsics

diff --git a/basis/compiler/tree/dead-code/dead-code-tests.factor b/basis/compiler/tree/dead-code/dead-code-tests.factor
index 4c04ec39177b60f1f5bafd14c07129046b3ba66e..338f397f66047192b366c79b2b4bd2a0af1883b3 100644 (file)
--- a/basis/compiler/tree/dead-code/dead-code-tests.factor
+++ b/basis/compiler/tree/dead-code/dead-code-tests.factor
@@ -182,3 +182,8 @@ IN: compiler.tree.dead-code.tests
 [ [ drop ] ] [ [ { integer } declare f <array> drop ] optimize-quot ] unit-test
 
 [ [ f <array> drop ] ] [ [ f <array> drop ] optimize-quot ] unit-test
+
+: call-recursive-dce-7 ( obj -- elt ? )
+    dup 5 = [ t ] [ dup [ call-recursive-dce-7 ] [ drop f f ] if ] if ; inline recursive
+
+[ ] [ [ call-recursive-dce-7 ] optimize-quot drop ] unit-test

diff --git a/basis/compiler/tree/dead-code/recursive/recursive.factor b/basis/compiler/tree/dead-code/recursive/recursive.factor
index 4c6b4114300eeb97bac616c57b5d7c11e971136b..03d4e919eed20d799c997c788a94bc478bb5475c 100644 (file)
--- a/basis/compiler/tree/dead-code/recursive/recursive.factor
+++ b/basis/compiler/tree/dead-code/recursive/recursive.factor
@@ -13,11 +13,8 @@ M: #enter-recursive compute-live-values*
     #! corresponding inputs to the #call-recursive are live also.
     [ out-d>> ] [ recursive-phi-in ] bi look-at-phi ;
 
-: return-recursive-phi-in ( #return-recursive -- phi-in )
-    [ label>> calls>> [ in-d>> ] map ] [ in-d>> ] bi suffix ;
-
 M: #return-recursive compute-live-values*
-    [ out-d>> ] [ return-recursive-phi-in ] bi look-at-phi ;
+    [ out-d>> ] [ in-d>> ] bi look-at-mapping ;
 
 M: #call-recursive compute-live-values*
     #! If the output of a #call-recursive is live, then the
@@ -34,15 +31,6 @@ M: #call-recursive compute-live-values*
         drop-values
     ] ;
 
-M: #recursive remove-dead-code* ( node -- nodes )
-    dup [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs
-    {
-        [ [ dup label>> enter-recursive>> ] [ out-d>> ] bi* '[ , >>in-d drop ] bi@ ]
-        [ drop [ (remove-dead-code) ] change-child drop ]
-        [ drop label>> [ filter-live ] change-enter-out drop ]
-        [ swap 2array ]
-    } 2cleave ;
-
 M: #enter-recursive remove-dead-code*
     [ filter-live ] change-out-d ;
 
@@ -73,9 +61,30 @@ M: #call-recursive remove-dead-code*
     [ drop-call-recursive-outputs ]
     tri 3array ;
 
-M: #return-recursive remove-dead-code* ( node -- nodes )
-    dup [ in-d>> ] [ out-d>> ] bi drop-dead-inputs
-    [ drop [ filter-live ] change-out-d drop ]
-    [ out-d>> >>in-d drop ]
-    [ swap 2array ]
-    2tri ;
+:: drop-recursive-inputs ( node -- shuffle )
+    [let* | shuffle [ node [ in-d>> ] [ label>> enter-out>> ] bi drop-dead-inputs ]
+            new-outputs [ shuffle out-d>> ] |
+        node new-outputs
+        [ [ label>> enter-recursive>> ] dip >>in-d drop ] [ >>in-d drop ] 2bi
+        shuffle
+    ] ;
+
+:: drop-recursive-outputs ( node -- shuffle )
+    [let* | return [ node label>> return>> ]
+            new-inputs [ return in-d>> filter-live ]
+            new-outputs [ return [ in-d>> ] [ out-d>> ] bi filter-corresponding ] |
+        return
+        [ new-inputs >>in-d new-outputs >>out-d drop ]
+        [ drop-dead-outputs ]
+        bi
+    ] ;
+
+M:: #recursive remove-dead-code* ( node -- nodes )
+    [let* | drop-inputs [ node drop-recursive-inputs ]
+            drop-outputs [ node drop-recursive-outputs ] |
+         node [ (remove-dead-code) ] change-child drop
+         node label>> [ filter-live ] change-enter-out drop
+         drop-inputs node drop-outputs 3array
+    ] ;
+
+M: #return-recursive remove-dead-code* ;

diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor
index f1be86929573a075588243fbaf3d3b00bd20056b..2bcf91e6ab68f02785848a7793556e2b4f16d57c 100644 (file)
--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/basis/compiler/tree/dead-code/simple/simple.factor
@@ -1,7 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors words assocs sequences arrays namespaces
-fry locals classes.algebra stack-checker.backend
+fry locals definitions classes.algebra
+stack-checker.state
+stack-checker.backend
 compiler.tree
 compiler.tree.propagation.info
 compiler.tree.dead-code.liveness ;
@@ -80,11 +82,10 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
     ] ;
 
 : drop-dead-outputs ( node -- nodes )
-    dup out-d>> drop-dead-values
-    [ in-d>> >>out-d drop ] [ 2array ] 2bi ;
+    dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ;
 
 M: #introduce remove-dead-code* ( #introduce -- nodes )
-    drop-dead-outputs ;
+    dup drop-dead-outputs 2array ;
 
 M: #>r remove-dead-code*
     [ filter-live ] change-out-r
@@ -105,7 +106,9 @@ M: #push remove-dead-code*
     ] [ drop f ] if ;
 
 : remove-flushable-call ( #call -- node )
-    in-d>> #drop remove-dead-code* ;
+    [ word>> +inlined+ depends-on ]
+    [ in-d>> #drop remove-dead-code* ]
+    bi ;
 
 : some-outputs-dead? ( #call -- ? )
     out-d>> [ live-value? not ] contains? ;
@@ -115,7 +118,7 @@ M: #call remove-dead-code*
         remove-flushable-call
     ] [
         dup some-outputs-dead? [
-            drop-dead-outputs
+            dup drop-dead-outputs 2array
         ] when
     ] if ;
 

diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor
index b30800b4457348cc912ab1ec8247eaaa86673905..e01d12ac2383952d0ec8cd0a7285ede3add6cbaa 100644 (file)
--- a/basis/compiler/tree/propagation/inlining/inlining.factor
+++ b/basis/compiler/tree/propagation/inlining/inlining.factor
@@ -125,21 +125,20 @@ SYMBOL: history
 : remember-inlining ( word -- )
     history [ swap suffix ] change ;
 
-: inline-word ( #call word -- )
+: inline-word ( #call word -- ? )
     dup history get memq? [
-        2drop
+        2drop f
     ] [
         [
             dup remember-inlining
             dupd def>> splicing-nodes >>body
             propagate-body
         ] with-scope
+        t
     ] if ;
 
 : inline-method-body ( #call word -- ? )
-    2dup should-inline? [ inline-word t ] [ 2drop f ] if ;
+    2dup should-inline? [ inline-word ] [ 2drop f ] if ;
 
 : always-inline-word? ( word -- ? )
     { curry compose } memq? ;
-
-: always-inline-word ( #call word -- ? ) inline-word t ;

diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor
index 528829ff4d85dd5417b1c97a88902d23efad5557..48a4b478e61f57b1db64c756c7d0ade41b6e5b0e 100644 (file)
--- a/basis/compiler/tree/propagation/simple/simple.factor
+++ b/basis/compiler/tree/propagation/simple/simple.factor
@@ -93,7 +93,7 @@ M: #declare propagate-before
 
 : do-inlining ( #call word -- ? )
     {
-        { [ dup always-inline-word? ] [ always-inline-word ] }
+        { [ dup always-inline-word? ] [ inline-word ] }
         { [ dup standard-generic? ] [ inline-standard-method ] }
         { [ dup math-generic? ] [ inline-math-method ] }
         { [ dup math-partial? ] [ inline-math-partial ] }

diff --git a/basis/stack-checker/inlining/inlining.factor b/basis/stack-checker/inlining/inlining.factor
index e373d36124b389ff42dd8a91803e093014a8a315..6523598cff41e164fe84cbb17264897f496c3a17 100644 (file)
--- a/basis/stack-checker/inlining/inlining.factor
+++ b/basis/stack-checker/inlining/inlining.factor
@@ -67,8 +67,10 @@ SYMBOL: enter-out
     [ entry-stack-height current-stack-height swap - ]
     bi*
     = [ 2drop ] [
-        word>> current-stack-height
-        unbalanced-recursion-error inference-error
+        terminated? get [ 2drop ] [
+            word>> current-stack-height
+            unbalanced-recursion-error inference-error
+        ] if
     ] if ;
 
 : end-recursive-word ( word label -- )
@@ -79,7 +81,7 @@ SYMBOL: enter-out
 : recursive-word-inputs ( label -- n )
     entry-stack-height d-in get + ;
 
-: (inline-recursive-word) ( word -- label in out visitor )
+: (inline-recursive-word) ( word -- label in out visitor terminated? )
     dup prepare-stack
     [
         init-inference
@@ -96,11 +98,13 @@ SYMBOL: enter-out
         dup recursive-word-inputs
         meta-d get
         stack-visitor get
+        terminated? get
     ] with-scope ;
 
 : inline-recursive-word ( word -- )
     (inline-recursive-word)
-    [ consume-d ] [ output-d ] [ ] tri* #recursive, ;
+    [ [ consume-d ] [ output-d ] [ ] tri* #recursive, ] dip
+    [ terminate ] when ;
 
 : check-call-height ( label -- )
     dup entry-stack-height current-stack-height >

diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index b78e1b5729c161d0124d6994c2c4ab94614a21d2..dc049ee1a4a4b74faec7ca783a11e94f612b3bd4 100755 (executable)
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -575,3 +575,8 @@ DEFER: eee'
 : eee' ( ? -- ) >r swap [ ] r> ddd' call ; inline recursive
 
 [ [ eee' ] infer ] [ inference-error? ] must-fail-with
+
+: bogus-error ( x -- )
+    dup "A" throw [ bogus-error ] [ drop ] if ; inline recursive
+
+[ bogus-error ] must-infer

diff --git a/basis/state-parser/state-parser.factor b/basis/state-parser/state-parser.factor
index 2550c992b9832b29e0ada9e315429f06cc94c3b5..ee5a5113bfb1ac0d23b442b9ab9454bc8dec2069 100644 (file)
--- a/basis/state-parser/state-parser.factor
+++ b/basis/state-parser/state-parser.factor
@@ -88,8 +88,7 @@ SYMBOL: prolog-data
 : next* ( -- )\r
     get-char [ (next) record ] when ;\r
 \r
-: skip-until ( quot -- )\r
-    #! quot: ( -- ? )\r
+: skip-until ( quot: ( -- ? ) -- )\r
     get-char [\r
         [ call ] keep swap [ drop ] [\r
             next skip-until\r

diff --git a/core/classes/mixin/mixin-tests.factor b/core/classes/mixin/mixin-tests.factor
index f6ca9184b266b4aca61cfc9c7f02befa8ada2dde..9a372e633ecb8cf5b6b2a4fc22c6bf0c0de4b691 100644 (file)
--- a/core/classes/mixin/mixin-tests.factor
+++ b/core/classes/mixin/mixin-tests.factor
@@ -105,3 +105,7 @@ TUPLE: flat-mx-2-1 ; INSTANCE: flat-mx-2-1 flat-mx-2
 [ ] [ "IN: classes.mixin.tests MIXIN: blah" <string-reader> "mixin-reset-test" parse-stream drop ] unit-test
 
 [ t ] [ "blah" "classes.mixin.tests" lookup mixin-class? ] unit-test
+
+MIXIN: empty-mixin
+
+[ f ] [ "hi" empty-mixin? ] unit-test

diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor
index a08d4ed20c8bd53016c75ed45dc550dfce9927be..56ab6d37f1ba988baaf329f2a563f82188d3d56a 100755 (executable)
--- a/core/classes/mixin/mixin.factor
+++ b/core/classes/mixin/mixin.factor
@@ -20,7 +20,9 @@ M: mixin-class rank-class drop 3 ;
     dup mixin-class? [
         drop
     ] [
-        { } redefine-mixin-class
+        [ { } redefine-mixin-class ]
+        [ update-classes ]
+        bi
     ] if ;
 
 TUPLE: check-mixin-class mixin ;

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index 4ff9d4c6742d58372bb28e6ba24bd884f7a86311..4482eb81315e1cae9a7d0177923b0294011fa7f2 100755 (executable)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -270,6 +270,9 @@ M: tuple-class define-tuple-class
         tri* define-declared
     ] 3tri ;
 
+M: tuple-class update-generic
+    over new-class? [ 2drop ] [ call-next-method ] if ;
+
 M: tuple-class reset-class
     [
         dup "slots" word-prop [

diff --git a/core/generic/generic.factor b/core/generic/generic.factor
index 70d406a39bfba83629123d875aadaf7b05207e30..ff81b5ded3cd9ba5806da43bd324f8cdf3738362 100755 (executable)
--- a/core/generic/generic.factor
+++ b/core/generic/generic.factor
@@ -62,7 +62,9 @@ TUPLE: check-method class generic ;
     [ nip [ classes-intersect? ] [ class<= ] 2bi or ] curry assoc-filter
     values ;
 
-: update-generic ( class generic -- )
+GENERIC# update-generic 1 ( class generic -- )
+
+M: class update-generic
     affected-methods [ +called+ changed-definition ] each ;
 
 : with-methods ( class generic quot -- )

diff --git a/core/parser/parser.factor b/core/parser/parser.factor
index 502d4c1eba3800048b1f5a37a9ea9a3afbc44077..c3742786b29e9460a44db55f6f21d3d5d6ddd5c1 100755 (executable)
--- a/core/parser/parser.factor
+++ b/core/parser/parser.factor
@@ -24,7 +24,7 @@ t parser-notes set-global
 
 : note. ( str -- )
     parser-notes? [
-        file get [ path>> write ] when*
+        file get [ path>> write ":" write ] when* 
         lexer get line>> number>string write ": " write
         "Note: " write dup print
     ] when drop ;