183 lines
5.5 KiB
Factor
183 lines
5.5 KiB
Factor
! Copyright (C) 2004, 2010 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: accessors assocs classes classes.algebra combinators
|
|
combinators.short-circuit compiler.cfg compiler.cfg.builder
|
|
compiler.cfg.builder.alien compiler.cfg.finalization
|
|
compiler.cfg.optimizer compiler.codegen compiler.crossref
|
|
compiler.errors compiler.tree.builder compiler.tree.optimizer
|
|
compiler.units compiler.utilities continuations definitions fry
|
|
generic generic.single io kernel macros make namespaces
|
|
sequences sets stack-checker.dependencies stack-checker.errors
|
|
stack-checker.inlining vocabs.loader words ;
|
|
IN: compiler
|
|
|
|
SYMBOL: compiled
|
|
|
|
: compile? ( word -- ? )
|
|
! Don't attempt to compile certain words.
|
|
{
|
|
[ "forgotten" word-prop ]
|
|
[ inlined-block? ]
|
|
} 1|| not ;
|
|
|
|
: compiler-message ( string -- )
|
|
"trace-compilation" get [ [ print flush ] with-global ] [ drop ] if ;
|
|
|
|
: start-compilation ( word -- )
|
|
dup name>> compiler-message
|
|
H{ } clone dependencies namespaces:set
|
|
H{ } clone generic-dependencies namespaces:set
|
|
HS{ } clone conditional-dependencies namespaces:set
|
|
clear-compiler-error ;
|
|
|
|
GENERIC: no-compile? ( word -- ? )
|
|
|
|
M: method no-compile? "method-generic" word-prop no-compile? ;
|
|
|
|
M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
|
|
|
|
M: word no-compile?
|
|
{ [ macro? ] [ "special" word-prop ] [ "no-compile" word-prop ] } 1|| ;
|
|
|
|
GENERIC: combinator? ( word -- ? )
|
|
|
|
M: method combinator? "method-generic" word-prop combinator? ;
|
|
|
|
M: predicate-engine-word combinator? "owner-generic" word-prop combinator? ;
|
|
|
|
M: word combinator? inline? ;
|
|
|
|
: ignore-error? ( word error -- ? )
|
|
! Ignore some errors on inline combinators, macros, and special
|
|
! words such as 'call'.
|
|
{
|
|
[ drop no-compile? ]
|
|
[ [ combinator? ] [ unknown-macro-input? ] bi* and ]
|
|
} 2|| ;
|
|
|
|
: finish-compilation ( word -- )
|
|
! Recompile callers if the word's stack effect changed, then
|
|
! save the word's dependencies so that if they change, the
|
|
! word can get recompiled too.
|
|
[ compiled-unxref ]
|
|
[
|
|
dup crossref? [
|
|
[ dependencies get generic-dependencies get compiled-xref ]
|
|
[ conditional-dependencies get set-dependency-checks ]
|
|
bi
|
|
] [ drop ] if
|
|
] bi ;
|
|
|
|
: deoptimize-with ( word def -- * )
|
|
! If the word failed to infer, compile it with the
|
|
! non-optimizing compiler.
|
|
swap [ finish-compilation ] [ compiled get set-at ] bi return ;
|
|
|
|
: not-compiled-def ( word error -- def )
|
|
'[ _ _ not-compiled ] [ ] like ;
|
|
|
|
: deoptimize* ( word -- * )
|
|
dup def>> deoptimize-with ;
|
|
|
|
: ignore-error ( word error -- * )
|
|
drop [ clear-compiler-error ] [ deoptimize* ] bi ;
|
|
|
|
: remember-error ( word error -- * )
|
|
[ swap <compiler-error> save-compiler-error ]
|
|
[ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
|
|
2bi ;
|
|
|
|
: deoptimize ( word error -- * )
|
|
! If the error is ignorable, compile the word with the
|
|
! non-optimizing compiler, using its definition. Otherwise,
|
|
! if the compiler error is not ignorable, use a dummy
|
|
! definition from 'not-compiled-def' which throws an error.
|
|
{
|
|
{ [ dup inference-error? not ] [ rethrow ] }
|
|
{ [ 2dup ignore-error? ] [ ignore-error ] }
|
|
[ remember-error ]
|
|
} cond ;
|
|
|
|
: optimize? ( word -- ? )
|
|
{
|
|
[ single-generic? ]
|
|
[ primitive? ]
|
|
} 1|| not ;
|
|
|
|
: contains-breakpoints? ( -- ? )
|
|
dependencies get keys [ "break?" word-prop ] any? ;
|
|
|
|
: frontend ( word -- tree )
|
|
! If the word contains breakpoints, don't optimize it, since
|
|
! the walker does not support this.
|
|
dup optimize? [
|
|
[ [ build-tree ] [ deoptimize ] recover optimize-tree ] keep
|
|
contains-breakpoints? [ nip deoptimize* ] [ drop ] if
|
|
] [ deoptimize* ] if ;
|
|
|
|
: backend ( tree word -- )
|
|
build-cfg [
|
|
[
|
|
[ optimize-cfg ]
|
|
[ finalize-cfg ]
|
|
[ [ generate ] [ label>> ] bi compiled get set-at ]
|
|
tri
|
|
] with-cfg
|
|
] each ;
|
|
|
|
: compile-word ( word -- )
|
|
! We return early if the word has breakpoints or if it
|
|
! failed to infer.
|
|
'[
|
|
_ {
|
|
[ start-compilation ]
|
|
[ frontend ]
|
|
[ backend ]
|
|
[ finish-compilation ]
|
|
} cleave
|
|
] with-return ;
|
|
|
|
SINGLETON: optimizing-compiler
|
|
|
|
M: optimizing-compiler update-call-sites ( class generic -- words )
|
|
! Words containing call sites with inferred type 'class'
|
|
! which inlined a method on 'generic'
|
|
generic-call-sites-of keys swap '[
|
|
_ 2dup [ classoid? ] both?
|
|
[ classes-intersect? ] [ 2drop f ] if
|
|
] filter ;
|
|
|
|
M: optimizing-compiler recompile ( words -- alist )
|
|
H{ } clone compiled [
|
|
[ compile? ] filter
|
|
[ compile-word yield-hook get call( -- ) ] each
|
|
compiled get >alist
|
|
] with-variable
|
|
"--- compile done" compiler-message ;
|
|
|
|
M: optimizing-compiler to-recompile ( -- words )
|
|
[
|
|
changed-effects get new-words get diff
|
|
outdated-effect-usages %
|
|
|
|
changed-definitions get new-words get diff
|
|
outdated-definition-usages %
|
|
|
|
maybe-changed get new-words get diff
|
|
outdated-conditional-usages %
|
|
|
|
changed-definitions get filter-word-defs dup zip ,
|
|
] { } make assoc-combine keys ;
|
|
|
|
M: optimizing-compiler process-forgotten-words
|
|
[ delete-compiled-xref ] each ;
|
|
|
|
: enable-optimizer ( -- )
|
|
optimizing-compiler compiler-impl set-global ;
|
|
|
|
: disable-optimizer ( -- )
|
|
f compiler-impl set-global ;
|
|
|
|
{ "prettyprint" "compiler" } "compiler.prettyprint" require-when
|
|
{ "threads" "compiler" } "compiler.threads" require-when
|