<li>The matrices library has been greatly simplified. Matrices are now represented as vectors of vectors, and matrix words have been moved to the <code>math</code> vocabulary.</li>
<li>More descriptive "out of bounds" errors.</li>
<li>New <code>make-hash ( quot -- namespace )</code> combinator executes quotation in a new namespace, which is then pushed on the stack.</li>
-<li>The <code><namespace></code> word is gone. It would create a hashtable with a default capacity. Now, just write <code>{{ }} clone</code>.
+<li>The <code><namespace></code> word is gone. It would create a hashtable with a default capacity. Now, just write <code>{{ }} clone</code>.</li>
+<li>Sequence construction words changed:
+<pre>
+make-list ==> [ ] make
+make-vector ==> { } make
+make-string ==> "" make
+make-rstring ==> "" make reverse
+make-sbuf ==> SBUF" " make
+</pre></li>
</ul>
</li>
- reader syntax for arrays, byte arrays, displaced aliens\r
-- fix infer hang\r
- out of memory error when printing global namespace\r
+- decompile is broken\r
\r
+ ui:\r
\r
: 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 -- )
: 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
: 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
: 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
! 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 )
[[ 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
[ 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 ;
! #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 ;
" 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.
#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.
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 -- )
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