Add some utility words to stack-checker.dependencies in preparation for a refactoring

release
Slava Pestov 2010-01-29 22:29:55 +13:00
parent 26f311279c
commit c058343167
10 changed files with 23 additions and 14 deletions

View File

@ -38,9 +38,9 @@ SYMBOL: compiled
: recompile-callers? ( word -- ? ) : recompile-callers? ( word -- ? )
changed-effects get key? ; changed-effects get key? ;
: recompile-callers ( words -- ) : recompile-callers ( word -- )
#! If a word's stack effect changed, recompile all words that #! If a word's stack effect changed, recompile all words
#! have compiled calls to it. #! that have compiled calls to it.
dup recompile-callers? dup recompile-callers?
[ compiled-usage keys [ queue-compile ] each ] [ drop ] if ; [ compiled-usage keys [ queue-compile ] each ] [ drop ] if ;

View File

@ -60,7 +60,7 @@ GENERIC: cleanup* ( node -- node/nodes )
: record-folding ( #call -- ) : record-folding ( #call -- )
dup word>> predicate? dup word>> predicate?
[ record-predicate-folding ] [ record-predicate-folding ]
[ word>> inlined-dependency depends-on ] [ word>> depends-on-definition ]
if ; if ;
: cleanup-folding ( #call -- nodes ) : cleanup-folding ( #call -- nodes )
@ -77,7 +77,7 @@ GENERIC: cleanup* ( node -- node/nodes )
: record-inlining ( #call -- ) : record-inlining ( #call -- )
dup method>> dup method>>
[ add-method-dependency ] [ add-method-dependency ]
[ word>> inlined-dependency depends-on ] if ; [ word>> depends-on-definition ] if ;
: cleanup-inlining ( #call -- nodes ) : cleanup-inlining ( #call -- nodes )
[ record-inlining ] [ body>> cleanup ] bi ; [ record-inlining ] [ body>> cleanup ] bi ;

View File

@ -318,7 +318,7 @@ generic-comparison-ops [
dup literal>> class? dup literal>> class?
[ [
literal>> literal>>
[ conditional-dependency depends-on ] [ depends-on-conditionally ]
[ predicate-output-infos ] [ predicate-output-infos ]
bi bi
] [ 2drop object-info ] if ] [ 2drop object-info ] if

View File

@ -36,7 +36,7 @@ M: #declare propagate-before
#! classes mentioned in the declaration are redefined, since #! classes mentioned in the declaration are redefined, since
#! now we're making assumptions but their definitions. #! now we're making assumptions but their definitions.
declaration>> [ declaration>> [
[ conditional-dependency depends-on ] [ depends-on-conditionally ]
[ <class-info> swap refine-value-info ] [ <class-info> swap refine-value-info ]
bi bi
] assoc-each ; ] assoc-each ;
@ -111,7 +111,7 @@ M: #declare propagate-before
#! class definition itself. #! class definition itself.
[ in-d>> first value-info ] [ in-d>> first value-info ]
[ "predicating" word-prop ] bi* [ "predicating" word-prop ] bi*
[ nip conditional-dependency depends-on ] [ nip depends-on-conditionally ]
[ predicate-output-infos 1array ] 2bi ; [ predicate-output-infos 1array ] 2bi ;
: default-output-value-infos ( #call word -- infos ) : default-output-value-infos ( #call word -- infos )

View File

@ -163,7 +163,7 @@ ERROR: bad-partial-eval quot word ;
: inline-new ( class -- quot/f ) : inline-new ( class -- quot/f )
dup tuple-class? [ dup tuple-class? [
dup conditional-dependency depends-on dup depends-on-conditionally
[ all-slots [ initial>> literalize ] map ] [ all-slots [ initial>> literalize ] map ]
[ tuple-layout '[ _ <tuple-boa> ] ] [ tuple-layout '[ _ <tuple-boa> ] ]
bi append >quotation bi append >quotation
@ -293,6 +293,6 @@ CONSTANT: lookup-table-at-max 256
! calls when a C type is redefined ! calls when a C type is redefined
\ heap-size [ \ heap-size [
dup word? [ dup word? [
[ inlined-dependency depends-on ] [ heap-size '[ _ ] ] bi [ depends-on-definition ] [ heap-size '[ _ ] ] bi
] [ drop f ] if ] [ drop f ] if
] 1 define-partial-eval ] 1 define-partial-eval

View File

@ -74,7 +74,7 @@ GENERIC: apply-object ( obj -- )
M: wrapper apply-object M: wrapper apply-object
wrapped>> wrapped>>
[ dup word? [ called-dependency depends-on ] [ drop ] if ] [ dup word? [ depends-on-effect ] [ drop ] if ]
[ push-literal ] [ push-literal ]
bi ; bi ;

View File

@ -26,6 +26,15 @@ SYMBOLS: inlined-dependency conditional-dependency flushed-dependency called-dep
] [ 3drop ] if ] [ 3drop ] if
] if ; ] if ;
: depends-on-effect ( word -- )
called-dependency depends-on ;
: depends-on-definition ( word -- )
inlined-dependency depends-on ;
: depends-on-conditionally ( word -- )
conditional-dependency depends-on ;
! Generic words that the current quotation depends on ! Generic words that the current quotation depends on
SYMBOL: generic-dependencies SYMBOL: generic-dependencies

View File

@ -140,7 +140,7 @@ SYMBOL: enter-out
: inline-word ( word -- ) : inline-word ( word -- )
commit-literals commit-literals
[ inlined-dependency depends-on ] [ depends-on-definition ]
[ [
dup inline-recursive-label [ dup inline-recursive-label [
call-recursive-inline-word call-recursive-inline-word

View File

@ -273,7 +273,7 @@ M: bad-executable summary
\ clear t "no-compile" set-word-prop \ clear t "no-compile" set-word-prop
: non-inline-word ( word -- ) : non-inline-word ( word -- )
dup called-dependency depends-on dup depends-on-effect
{ {
{ [ dup "shuffle" word-prop ] [ infer-shuffle-word ] } { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
{ [ dup "special" word-prop ] [ infer-special ] } { [ dup "special" word-prop ] [ infer-special ] }

View File

@ -140,7 +140,7 @@ IN: stack-checker.transforms
! Constructors ! Constructors
\ boa [ \ boa [
dup tuple-class? [ dup tuple-class? [
dup conditional-dependency depends-on dup depends-on-conditionally
[ "boa-check" word-prop [ ] or ] [ "boa-check" word-prop [ ] or ]
[ tuple-layout '[ _ <tuple-boa> ] ] [ tuple-layout '[ _ <tuple-boa> ] ]
bi append bi append