diff --git a/CHANGES.html b/CHANGES.html
index 72c326ec29..0153492169 100644
--- a/CHANGES.html
+++ b/CHANGES.html
@@ -32,7 +32,15 @@
The matrices library has been greatly simplified. Matrices are now represented as vectors of vectors, and matrix words have been moved to the math
vocabulary.
More descriptive "out of bounds" errors.
New make-hash ( quot -- namespace )
combinator executes quotation in a new namespace, which is then pushed on the stack.
-The <namespace>
word is gone. It would create a hashtable with a default capacity. Now, just write {{ }} clone
.
+The <namespace>
word is gone. It would create a hashtable with a default capacity. Now, just write {{ }} clone
.
+Sequence construction words changed:
+
+make-list ==> [ ] make
+make-vector ==> { } make
+make-string ==> "" make
+make-rstring ==> "" make reverse
+make-sbuf ==> SBUF" " make
+
diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index c57fdf8988..5a84c7dc9b 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -1,6 +1,6 @@
- reader syntax for arrays, byte arrays, displaced aliens
-- fix infer hang
- out of memory error when printing global namespace
+- decompile is broken
+ ui:
diff --git a/library/inference/call-optimizers.factor b/library/inference/call-optimizers.factor
index 02d12c9ab0..3d116a5d6f 100644
--- a/library/inference/call-optimizers.factor
+++ b/library/inference/call-optimizers.factor
@@ -34,11 +34,7 @@ sequences vectors words ;
: partial-eval ( #call -- node )
dup literal-in-d over node-param
[ with-datastack ] [
- [
- 3drop t
- ] [
- inline-literals
- ] ifte
+ [ 3drop t ] [ inline-literals ] ifte
] catch ;
: flip-branches ( #ifte -- )
diff --git a/library/inference/dataflow.factor b/library/inference/dataflow.factor
index d708abaae1..da77a27337 100644
--- a/library/inference/dataflow.factor
+++ b/library/inference/dataflow.factor
@@ -164,10 +164,18 @@ SYMBOL: current-node
: last-node ( node -- last )
dup node-successor [ last-node ] [ ] ?ifte ;
+: penultimate-node ( node -- penultimate )
+ dup node-successor dup [
+ dup node-successor
+ [ nip penultimate-node ] [ drop ] ifte
+ ] [
+ 2drop f
+ ] ifte ;
+
: drop-inputs ( node -- #drop )
node-in-d clone in-d-node <#drop> ;
-: each-node ( node quot -- )
+: each-node ( node quot -- | quot: node -- )
over [
[ call ] 2keep swap
[ node-children [ swap each-node ] each-with ] 2keep
@@ -179,6 +187,26 @@ SYMBOL: current-node
: each-node-with ( obj node quot -- | quot: obj node -- )
swap [ with ] each-node 2drop ; inline
+: all-nodes? ( node quot -- ? | quot: node -- ? )
+ over [
+ [ call ] 2keep rot [
+ [
+ swap node-children [ swap all-nodes? ] all-with?
+ ] 2keep rot [
+ >r node-successor r> all-nodes?
+ ] [
+ 2drop f
+ ] ifte
+ ] [
+ 2drop f
+ ] ifte
+ ] [
+ 2drop t
+ ] ifte ; inline
+
+: all-nodes-with? ( obj node quot -- ? | quot: obj node -- ? )
+ swap [ with rot ] all-nodes? 2nip ; inline
+
SYMBOL: substituted
DEFER: subst-value
diff --git a/library/inference/kill-literals.factor b/library/inference/kill-literals.factor
index 53509c8f73..61a0b1dcf7 100644
--- a/library/inference/kill-literals.factor
+++ b/library/inference/kill-literals.factor
@@ -9,28 +9,13 @@ GENERIC: literals* ( node -- )
: literals ( node -- seq )
[ [ literals* ] each-node ] { } make ;
-GENERIC: can-kill* ( literal node -- ? )
-
-: can-kill? ( literal node -- ? )
- #! Return false if the literal appears in any node in the
- #! list.
- dup [
- 2dup can-kill* [
- 2dup node-children [ can-kill? ] all-with? [
- node-successor can-kill?
- ] [
- 2drop f
- ] ifte
- ] [
- 2drop f
- ] ifte
- ] [
- 2drop t
- ] ifte ;
+GENERIC: can-kill? ( literal node -- ? )
: kill-set ( node -- list )
#! Push a list of literals that may be killed in the IR.
- dup literals [ swap can-kill? ] subset-with ;
+ dup literals [
+ swap [ can-kill? ] all-nodes-with?
+ ] subset-with ;
: remove-values ( values node -- )
2dup [ node-in-d seq-diff ] keep set-node-in-d
@@ -48,19 +33,19 @@ M: node kill-node* ( literals node -- ) 2drop ;
! Generic nodes
M: node literals* ( node -- ) drop ;
-M: node can-kill* ( literal node -- ? ) uses-value? not ;
+M: node can-kill? ( literal node -- ? ) uses-value? not ;
! #push
M: #push literals* ( node -- )
node-out-d % ;
-M: #push can-kill* ( literal node -- ? ) 2drop t ;
+M: #push can-kill? ( literal node -- ? ) 2drop t ;
M: #push kill-node* ( literals node -- )
[ node-out-d seq-diff ] keep set-node-out-d ;
! #drop
-M: #drop can-kill* ( literal node -- ? ) 2drop t ;
+M: #drop can-kill? ( literal node -- ? ) 2drop t ;
! #call
: (kill-shuffle) ( word -- map )
@@ -84,8 +69,8 @@ M: #drop can-kill* ( literal node -- ? ) 2drop t ;
[[ r> {{ }} ]]
}} hash ;
-M: #call can-kill* ( literal node -- ? )
- dup node-param (kill-shuffle) >r delegate can-kill* r> or ;
+M: #call can-kill? ( literal node -- ? )
+ dup node-param (kill-shuffle) >r delegate can-kill? r> or ;
: kill-mask ( killing node -- mask )
dup node-param \ r> = [ node-in-r ] [ node-in-d ] ifte
@@ -106,13 +91,13 @@ M: #call kill-node* ( literals node -- )
[ kill-shuffle ] [ 2drop ] ifte ;
! #call-label
-M: #call-label can-kill* ( literal node -- ? ) 2drop t ;
+M: #call-label can-kill? ( literal node -- ? ) 2drop t ;
! #values
-M: #values can-kill* ( literal node -- ? ) 2drop t ;
+M: #values can-kill? ( literal node -- ? ) 2drop t ;
! #merge
-M: #merge can-kill* ( literal node -- ? ) 2drop t ;
+M: #merge can-kill? ( literal node -- ? ) 2drop t ;
! #entry
-M: #entry can-kill* ( literal node -- ? ) 2drop t ;
+M: #entry can-kill? ( literal node -- ? ) 2drop t ;
diff --git a/library/inference/optimizer.factor b/library/inference/optimizer.factor
index b9250aee84..d0f250103f 100644
--- a/library/inference/optimizer.factor
+++ b/library/inference/optimizer.factor
@@ -80,3 +80,22 @@ M: #values optimize-node* ( node -- node/t )
! #return
M: #return optimize-node* ( node -- node/t )
optimize-fold ;
+
+! #label
+GENERIC: calls-label? ( label node -- ? )
+
+M: node calls-label? 2drop f ;
+
+M: #call-label calls-label? node-param eq? ;
+
+M: #label optimize-node* ( node -- node/t )
+ dup node-param over node-children first calls-label? [
+ drop t
+ ] [
+ dup node-children first dup node-successor [
+ dup penultimate-node rot
+ node-successor swap set-node-successor
+ ] [
+ drop node-successor
+ ] ifte
+ ] ifte ;
diff --git a/library/inference/words.factor b/library/inference/words.factor
index 1365cf7458..8182918f29 100644
--- a/library/inference/words.factor
+++ b/library/inference/words.factor
@@ -25,9 +25,6 @@ hashtables parser prettyprint ;
" was already attempted, and failed" append3
inference-error ;
-: recursive? ( word -- ? )
- f swap dup word-def [ = or ] tree-each-with ;
-
: with-block ( word [[ label quot ]] quot -- block-node )
#! Execute a quotation with the word on the stack, and add
#! its dataflow contribution to a new #label node in the IR.
@@ -40,16 +37,6 @@ hashtables parser prettyprint ;
#entry node, word-def infer-quot #return node,
] with-block ;
-: inline-compound ( word -- )
- #! Infer the stack effect of a compound word in the current
- #! inferencer instance. If the word in question is recursive
- #! we infer its stack effect inside a new block.
- dup recursive? [
- inline-block node,
- ] [
- word-def infer-quot
- ] ifte ;
-
: infer-compound ( word base-case -- effect )
#! Infer a word's stack effect in a separate inferencer
#! instance.
@@ -137,11 +124,8 @@ M: compound apply-object ( word -- )
dup recursive-state get assoc [
recursive-word
] [
- dup "inline" word-prop [
- inline-compound
- ] [
- apply-default
- ] ifte
+ dup "inline" word-prop
+ [ inline-block node, ] [ apply-default ] ifte
] ifte* ;
: infer-shuffle ( word -- )
diff --git a/library/test/inference.factor b/library/test/inference.factor
index 401d826da9..ae2928cdc3 100644
--- a/library/test/inference.factor
+++ b/library/test/inference.factor
@@ -151,7 +151,7 @@ M: real iterate drop ;
DEFER: agent
: smith 1 + agent ; inline
-: agent dup 0 = [ [ swap call ] 2keep [ smith ] 2keep ] when ; inline
+: agent dup 0 = [ [ swap call ] 2keep smith ] when ; inline
[ [ [ ] [ object object ] ] ]
[ [ [ drop ] 0 agent ] infer ] unit-test