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