Don't keep compiled-effect around anymore

db4
Slava Pestov 2009-02-23 23:55:16 -06:00
parent b06903b0ef
commit 65a53e1fa5
6 changed files with 41 additions and 37 deletions

View File

@ -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?

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 )
[
[
{

View File

@ -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