diff --git a/core/compiler/tests/simple.factor b/core/compiler/tests/simple.factor
index dce2ec562a..bc9c56864c 100755
--- a/core/compiler/tests/simple.factor
+++ b/core/compiler/tests/simple.factor
@@ -1,6 +1,6 @@
USING: compiler.units tools.test kernel kernel.private
sequences.private math.private math combinators strings
-alien arrays memory ;
+alien arrays memory vocabs parser ;
IN: compiler.tests
! Test empty word
@@ -230,3 +230,11 @@ M: f single-combination-test-2 single-combination-test-4 ;
! Regression
[ 100 ] [ [ 100 [ [ ] times ] keep ] compile-call ] unit-test
+
+! Regression
+10 [
+ [ "compiler.tests.foo" forget-vocab ] with-compilation-unit
+ [ t ] [
+ "USING: prettyprint words ; IN: compiler.tests.foo : (recursive) ( -- ) (recursive) (recursive) ; inline : recursive ( -- ) (recursive) ; \\ (recursive) compiled?" eval
+ ] unit-test
+] times
diff --git a/core/cpu/x86/allot/allot.factor b/core/cpu/x86/allot/allot.factor
index bfcede7ef7..63870f94cd 100755
--- a/core/cpu/x86/allot/allot.factor
+++ b/core/cpu/x86/allot/allot.factor
@@ -29,7 +29,7 @@ IN: cpu.x86.allot
allot-reg POP
allot-reg cell [+] swap 8 align ADD ;
-M: x86.32 %gc ( -- )
+M: x86 %gc ( -- )
"end" define-label
temp-reg-1 load-zone-ptr
temp-reg-2 temp-reg-1 cell [+] MOV
diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor
index c2629f107f..2bc260593c 100755
--- a/core/inference/class/class.factor
+++ b/core/inference/class/class.factor
@@ -325,16 +325,15 @@ M: #call-label infer-classes-before ( #call-label -- )
[ set-value-class* ] 2each ;
M: #return infer-classes-around
+ dup call-next-method
nested-labels get length 0 > [
dup param>> nested-labels get peek param>> eq? [
[ ] [ node-input-classes ] [ in-d>> [ value-class* ] map ] tri
- classes= [
- drop
- ] [
+ classes= not [
fixed-point? off
[ in-d>> value-classes get extract-keys ] keep
set-node-classes
- ] if
+ ] [ drop ] if
] [ drop ] if
] [ drop ] if ;
@@ -369,5 +368,5 @@ M: object infer-classes-around
: infer-classes/node ( node existing -- )
#! Infer classes, using the existing node's class info as a
#! starting point.
- [ node-classes ] [ node-literals ] [ node-intervals ] tri
+ [ classes>> ] [ literals>> ] [ intervals>> ] tri
infer-classes-with ;
diff --git a/core/optimizer/backend/backend.factor b/core/optimizer/backend/backend.factor
index 3237f095bf..9630f9dc70 100755
--- a/core/optimizer/backend/backend.factor
+++ b/core/optimizer/backend/backend.factor
@@ -3,7 +3,7 @@
USING: arrays generic assocs inference inference.class
inference.dataflow inference.backend inference.state io kernel
math namespaces sequences vectors words quotations hashtables
-combinators classes optimizer.def-use ;
+combinators classes optimizer.def-use accessors ;
IN: optimizer.backend
SYMBOL: class-substitutions
@@ -16,37 +16,32 @@ SYMBOL: optimizer-changed
GENERIC: optimize-node* ( node -- node/t changed? )
-: ?union ( assoc/f assoc -- hash )
- over [ assoc-union ] [ nip ] if ;
+: ?union ( assoc assoc/f -- assoc' )
+ dup assoc-empty? [ drop ] [ swap assoc-union ] if ;
-: add-node-literals ( assoc node -- )
- over assoc-empty? [
+: add-node-literals ( node assoc -- )
+ [ ?union ] curry change-literals drop ;
+
+: add-node-classes ( node assoc -- )
+ [ ?union ] curry change-classes drop ;
+
+: substitute-values ( node assoc -- )
+ dup assoc-empty? [
2drop
] [
- [ node-literals ?union ] keep set-node-literals
- ] if ;
-
-: add-node-classes ( assoc node -- )
- over assoc-empty? [
- 2drop
- ] [
- [ node-classes ?union ] keep set-node-classes
- ] if ;
-
-: substitute-values ( assoc node -- )
- over assoc-empty? [
- 2drop
- ] [
- 2dup node-in-d swap substitute-here
- 2dup node-in-r swap substitute-here
- 2dup node-out-d swap substitute-here
- node-out-r swap substitute-here
+ {
+ [ >r in-d>> r> substitute-here ]
+ [ >r in-r>> r> substitute-here ]
+ [ >r out-d>> r> substitute-here ]
+ [ >r out-r>> r> substitute-here ]
+ } 2cleave
] if ;
: perform-substitutions ( node -- )
- class-substitutions get over add-node-classes
- literal-substitutions get over add-node-literals
- value-substitutions get swap substitute-values ;
+ [ class-substitutions get add-node-classes ]
+ [ literal-substitutions get add-node-literals ]
+ [ value-substitutions get substitute-values ]
+ tri ;
DEFER: optimize-nodes
@@ -90,18 +85,21 @@ M: node optimize-node* drop t f ;
#! Not very efficient.
dupd union* update ;
-: compute-value-substitutions ( #return/#values #call/#merge -- assoc )
- node-out-d swap node-in-d 2array unify-lengths flip
+: compute-value-substitutions ( #call/#merge #return/#values -- assoc )
+ [ out-d>> ] [ in-d>> ] bi* 2array unify-lengths flip
[ = not ] assoc-subset >hashtable ;
: cleanup-inlining ( #return/#values -- newnode changed? )
- dup node-successor dup [
- class-substitutions get pick node-classes update
- literal-substitutions get pick node-literals update
- tuck compute-value-substitutions value-substitutions get swap update*
- node-successor t
+ dup node-successor [
+ [ node-successor ] keep
+ {
+ [ nip classes>> class-substitutions get swap update ]
+ [ nip literals>> literal-substitutions get swap update ]
+ [ compute-value-substitutions value-substitutions get swap update* ]
+ [ drop node-successor ]
+ } 2cleave t
] [
- 2drop t f
+ drop t f
] if ;
! #return
diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor
index 63a63a2f92..14dcd62c61 100755
--- a/core/optimizer/optimizer-tests.factor
+++ b/core/optimizer/optimizer-tests.factor
@@ -291,7 +291,6 @@ TUPLE: silly-tuple a b ;
[ 1 2 3 ] [ lift-loop-tail-test-2 ] unit-test
-! Make sure we don't lose
GENERIC: generic-inline-test ( x -- y )
M: integer generic-inline-test ;
@@ -308,6 +307,7 @@ M: integer generic-inline-test ;
generic-inline-test
generic-inline-test ;
+! Inlining all of the above should only take two passes
[ { t f } ] [
\ generic-inline-test-1 word-def dataflow
[ optimize-1 , optimize-1 , drop ] { } make