Don't keep compiled-effect around anymore
parent
b06903b0ef
commit
65a53e1fa5
|
@ -16,7 +16,7 @@ M: callable test-cfg
|
|||
build-tree optimize-tree gensym build-cfg ;
|
||||
|
||||
M: word test-cfg
|
||||
[ build-tree-from-word nip optimize-tree ] keep build-cfg ;
|
||||
[ build-tree-from-word optimize-tree ] keep build-cfg ;
|
||||
|
||||
SYMBOL: allocate-registers?
|
||||
|
||||
|
|
|
@ -1,46 +1,47 @@
|
|||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel namespaces arrays sequences io
|
||||
words fry continuations vocabs assocs dlists definitions math
|
||||
graphs generic combinators deques search-deques io
|
||||
stack-checker stack-checker.state stack-checker.inlining
|
||||
compiler.errors compiler.units compiler.tree.builder
|
||||
compiler.tree.optimizer compiler.cfg.builder
|
||||
compiler.cfg.optimizer compiler.cfg.linearization
|
||||
compiler.cfg.two-operand compiler.cfg.linear-scan
|
||||
compiler.cfg.stack-frame compiler.codegen compiler.utilities ;
|
||||
USING: accessors kernel namespaces arrays sequences io words fry
|
||||
continuations vocabs assocs dlists definitions math graphs
|
||||
generic combinators deques search-deques io stack-checker
|
||||
stack-checker.state stack-checker.inlining
|
||||
combinators.short-circuit compiler.errors compiler.units
|
||||
compiler.tree.builder compiler.tree.optimizer
|
||||
compiler.cfg.builder compiler.cfg.optimizer
|
||||
compiler.cfg.linearization compiler.cfg.two-operand
|
||||
compiler.cfg.linear-scan compiler.cfg.stack-frame
|
||||
compiler.codegen compiler.utilities ;
|
||||
IN: compiler
|
||||
|
||||
SYMBOL: compile-queue
|
||||
SYMBOL: compiled
|
||||
|
||||
: queue-compile ( word -- )
|
||||
: queue-compile? ( word -- ? )
|
||||
{
|
||||
{ [ dup "forgotten" word-prop ] [ ] }
|
||||
{ [ dup compiled get key? ] [ ] }
|
||||
{ [ dup inlined-block? ] [ ] }
|
||||
{ [ dup primitive? ] [ ] }
|
||||
[ dup compile-queue get push-front ]
|
||||
} cond drop ;
|
||||
[ "forgotten" word-prop ]
|
||||
[ compiled get key? ]
|
||||
[ inlined-block? ]
|
||||
[ primitive? ]
|
||||
} 1|| not ;
|
||||
|
||||
: queue-compile ( word -- )
|
||||
dup queue-compile? [ compile-queue get push-front ] [ drop ] if ;
|
||||
|
||||
: maybe-compile ( word -- )
|
||||
dup optimized>> [ drop ] [ queue-compile ] if ;
|
||||
|
||||
SYMBOL: +failed+
|
||||
SYMBOLS: +optimized+ +unoptimized+ ;
|
||||
|
||||
: ripple-up ( words -- )
|
||||
dup "compiled-effect" word-prop +failed+ eq?
|
||||
dup "compiled-status" word-prop +unoptimized+ eq?
|
||||
[ usage [ word? ] filter ] [ compiled-usage keys ] if
|
||||
[ queue-compile ] each ;
|
||||
|
||||
: ripple-up? ( word effect -- ? )
|
||||
#! If the word has previously been compiled and had a
|
||||
#! different stack effect, we have to recompile any callers.
|
||||
swap "compiled-effect" word-prop [ = not ] keep and ;
|
||||
: ripple-up? ( word status -- ? )
|
||||
swap "compiled-status" word-prop [ = not ] keep and ;
|
||||
|
||||
: save-effect ( word effect -- )
|
||||
: save-compiled-status ( word status -- )
|
||||
[ dupd ripple-up? [ ripple-up ] [ drop ] if ]
|
||||
[ "compiled-effect" set-word-prop ]
|
||||
[ "compiled-status" set-word-prop ]
|
||||
2bi ;
|
||||
|
||||
: start ( word -- )
|
||||
|
@ -49,18 +50,18 @@ SYMBOL: +failed+
|
|||
H{ } clone generic-dependencies set
|
||||
f swap compiler-error ;
|
||||
|
||||
: fail ( word error -- )
|
||||
: fail ( word error -- * )
|
||||
[ swap compiler-error ]
|
||||
[
|
||||
drop
|
||||
[ compiled-unxref ]
|
||||
[ f swap compiled get set-at ]
|
||||
[ +failed+ save-effect ]
|
||||
[ +unoptimized+ save-compiled-status ]
|
||||
tri
|
||||
] 2bi
|
||||
return ;
|
||||
|
||||
: frontend ( word -- effect nodes )
|
||||
: frontend ( word -- nodes )
|
||||
[ build-tree-from-word ] [ fail ] recover optimize-tree ;
|
||||
|
||||
! Only switch this off for debugging.
|
||||
|
@ -84,8 +85,8 @@ t compile-dependencies? set-global
|
|||
save-asm
|
||||
] each ;
|
||||
|
||||
: finish ( effect word -- )
|
||||
[ swap save-effect ]
|
||||
: finish ( word -- )
|
||||
[ +optimized+ save-compiled-status ]
|
||||
[ compiled-unxref ]
|
||||
[
|
||||
dup crossref?
|
||||
|
@ -112,6 +113,9 @@ t compile-dependencies? set-global
|
|||
: decompile ( word -- )
|
||||
f 2array 1array modify-code-heap ;
|
||||
|
||||
: compile-call ( quot -- )
|
||||
[ dup infer define-temp ] with-compilation-unit execute ;
|
||||
|
||||
: optimized-recompile-hook ( words -- alist )
|
||||
[
|
||||
<hashed-dlist> compile-queue set
|
||||
|
|
|
@ -303,7 +303,7 @@ HINTS: recursive-inline-hang-3 array ;
|
|||
: member-test ( obj -- ? ) { + - * / /i } member? ;
|
||||
|
||||
\ member-test must-infer
|
||||
[ ] [ \ member-test build-tree-from-word optimize-tree 2drop ] unit-test
|
||||
[ ] [ \ member-test build-tree-from-word optimize-tree drop ] unit-test
|
||||
[ t ] [ \ + member-test ] unit-test
|
||||
[ f ] [ \ append member-test ] unit-test
|
||||
|
||||
|
|
|
@ -8,4 +8,4 @@ compiler.tree ;
|
|||
|
||||
: inline-recursive ( -- ) inline-recursive ; inline recursive
|
||||
|
||||
[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? nip ] unit-test
|
||||
[ t ] [ \ inline-recursive build-tree-from-word [ #recursive? ] any? ] unit-test
|
||||
|
|
|
@ -12,18 +12,18 @@ IN: compiler.tree.builder
|
|||
|
||||
: with-tree-builder ( quot -- nodes )
|
||||
'[ V{ } clone stack-visitor set @ ]
|
||||
with-infer ; inline
|
||||
with-infer nip ; inline
|
||||
|
||||
: build-tree ( quot -- nodes )
|
||||
#! Not safe to call from inference transforms.
|
||||
[ f initial-recursive-state infer-quot ] with-tree-builder nip ;
|
||||
[ f initial-recursive-state infer-quot ] with-tree-builder ;
|
||||
|
||||
: build-tree-with ( in-stack quot -- nodes out-stack )
|
||||
#! Not safe to call from inference transforms.
|
||||
[
|
||||
[ >vector \ meta-d set ]
|
||||
[ f initial-recursive-state infer-quot ] bi*
|
||||
] with-tree-builder nip
|
||||
] with-tree-builder
|
||||
unclip-last in-d>> ;
|
||||
|
||||
: build-sub-tree ( #call quot -- nodes )
|
||||
|
@ -45,7 +45,7 @@ IN: compiler.tree.builder
|
|||
: check-no-compile ( word -- )
|
||||
dup "no-compile" word-prop [ cannot-infer-effect ] [ drop ] if ;
|
||||
|
||||
: build-tree-from-word ( word -- effect nodes )
|
||||
: build-tree-from-word ( word -- nodes )
|
||||
[
|
||||
[
|
||||
{
|
||||
|
|
|
@ -144,7 +144,7 @@ SYMBOL: node-count
|
|||
|
||||
: make-report ( word/quot -- assoc )
|
||||
[
|
||||
dup word? [ build-tree-from-word nip ] [ build-tree ] if
|
||||
dup word? [ build-tree-from-word ] [ build-tree ] if
|
||||
optimize-tree
|
||||
|
||||
H{ } clone words-called set
|
||||
|
|
Loading…
Reference in New Issue