Remove "compiled-status" word prop and simplify associated machinery
parent
b1d0066baa
commit
a9b4a724a4
|
@ -28,23 +28,14 @@ SYMBOL: compiled
|
|||
: maybe-compile ( word -- )
|
||||
dup optimized>> [ drop ] [ queue-compile ] if ;
|
||||
|
||||
SYMBOLS: +optimized+ +unoptimized+ ;
|
||||
: recompile-callers? ( word -- ? )
|
||||
changed-effects get key? ;
|
||||
|
||||
: ripple-up ( words -- )
|
||||
dup "compiled-status" word-prop +unoptimized+ eq?
|
||||
[ usage [ word? ] filter ] [ compiled-usage keys ] if
|
||||
[ queue-compile ] each ;
|
||||
|
||||
: ripple-up? ( status word -- ? )
|
||||
[
|
||||
[ nip changed-effects get key? ]
|
||||
[ "compiled-status" word-prop eq? not ] 2bi or
|
||||
] keep "compiled-status" word-prop and ;
|
||||
|
||||
: save-compiled-status ( word status -- )
|
||||
[ over ripple-up? [ ripple-up ] [ drop ] if ]
|
||||
[ "compiled-status" set-word-prop ]
|
||||
2bi ;
|
||||
: recompile-callers ( words -- )
|
||||
dup recompile-callers? [
|
||||
[ usage [ word? ] filter ] [ compiled-usage keys ] bi
|
||||
[ [ queue-compile ] each ] bi@
|
||||
] [ drop ] if ;
|
||||
|
||||
: start ( word -- )
|
||||
"trace-compilation" get [ dup name>> print flush ] when
|
||||
|
@ -55,20 +46,19 @@ SYMBOLS: +optimized+ +unoptimized+ ;
|
|||
: ignore-error? ( word error -- ? )
|
||||
[
|
||||
{
|
||||
[ inline? ]
|
||||
[ macro? ]
|
||||
[ "no-compile" word-prop ]
|
||||
[ inline? ]
|
||||
[ "special" word-prop ]
|
||||
[ "no-compile" word-prop ]
|
||||
} 1||
|
||||
] [ error-type +compiler-warning+ eq? ] bi* and ;
|
||||
|
||||
: (fail) ( word compiled -- * )
|
||||
swap
|
||||
[ recompile-callers ]
|
||||
[ compiled-unxref ]
|
||||
[ compiled get set-at ]
|
||||
[ +unoptimized+ save-compiled-status ]
|
||||
tri
|
||||
return ;
|
||||
tri return ;
|
||||
|
||||
: not-compiled-def ( word error -- def )
|
||||
'[ _ _ not-compiled ] [ ] like ;
|
||||
|
@ -106,11 +96,10 @@ t compile-dependencies? set-global
|
|||
] each ;
|
||||
|
||||
: finish ( word -- )
|
||||
[ +optimized+ save-compiled-status ]
|
||||
[ recompile-callers ]
|
||||
[ compiled-unxref ]
|
||||
[
|
||||
dup crossref?
|
||||
[
|
||||
dup crossref? [
|
||||
dependencies get
|
||||
generic-dependencies get
|
||||
compiled-xref
|
||||
|
|
|
@ -12,10 +12,11 @@ IN: macros
|
|||
PRIVATE>
|
||||
|
||||
: define-macro ( word definition effect -- )
|
||||
real-macro-effect
|
||||
[ [ memoize-quot [ call ] append ] keep define-declared ]
|
||||
[ drop "macro" set-word-prop ]
|
||||
3bi ;
|
||||
real-macro-effect {
|
||||
[ [ memoize-quot [ call ] append ] keep define-declared ]
|
||||
[ drop "macro" set-word-prop ]
|
||||
[ 2drop changed-effect ]
|
||||
} 3cleave ;
|
||||
|
||||
SYNTAX: MACRO: (:) define-macro ;
|
||||
|
||||
|
|
|
@ -99,7 +99,6 @@ IN: tools.deploy.shaker
|
|||
"boa-check"
|
||||
"coercer"
|
||||
"combination"
|
||||
"compiled-status"
|
||||
"compiled-generic-uses"
|
||||
"compiled-uses"
|
||||
"constraints"
|
||||
|
|
|
@ -19,9 +19,6 @@ SYMBOL: changed-definitions
|
|||
|
||||
SYMBOL: changed-effects
|
||||
|
||||
: changed-effect ( word -- )
|
||||
dup changed-effects get set-in-unit ;
|
||||
|
||||
SYMBOL: changed-generics
|
||||
|
||||
SYMBOL: outdated-generics
|
||||
|
|
|
@ -138,12 +138,15 @@ M: word subwords drop f ;
|
|||
>>def
|
||||
dup crossref? [ dup xref ] when drop ;
|
||||
|
||||
: changed-effect ( word -- )
|
||||
[ dup changed-effects get set-in-unit ]
|
||||
[ dup primitive? [ drop ] [ changed-definition ] if ] bi ;
|
||||
|
||||
: set-stack-effect ( effect word -- )
|
||||
2dup "declared-effect" word-prop = [ 2drop ] [
|
||||
swap
|
||||
[ drop changed-effect ]
|
||||
[ "declared-effect" set-word-prop ]
|
||||
[ drop dup primitive? [ drop ] [ changed-definition ] if ]
|
||||
[ nip changed-effect ]
|
||||
[ nip subwords [ changed-effect ] each ]
|
||||
[ swap "declared-effect" set-word-prop ]
|
||||
2tri
|
||||
] if ;
|
||||
|
||||
|
@ -151,7 +154,11 @@ M: word subwords drop f ;
|
|||
[ nip swap set-stack-effect ] [ drop define ] 3bi ;
|
||||
|
||||
: make-inline ( word -- )
|
||||
t "inline" set-word-prop ;
|
||||
dup inline? [ drop ] [
|
||||
[ t "inline" set-word-prop ]
|
||||
[ changed-effect ]
|
||||
bi
|
||||
] if ;
|
||||
|
||||
: make-recursive ( word -- )
|
||||
t "recursive" set-word-prop ;
|
||||
|
|
Loading…
Reference in New Issue