1 ! Copyright (C) 2004, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel namespaces arrays sequences io words fry
4 continuations vocabs assocs dlists definitions math graphs generic
5 generic.single combinators deques search-deques macros
6 source-files.errors combinators.short-circuit
8 stack-checker stack-checker.dependencies stack-checker.inlining
11 compiler.errors compiler.units compiler.utilities
14 compiler.tree.optimizer
20 compiler.cfg.optimizer
29 : compile? ( word -- ? )
30 #! Don't attempt to compile certain words.
32 [ "forgotten" word-prop ]
38 : queue-compile ( word -- )
39 dup compile? [ compile-queue get push-front ] [ drop ] if ;
41 : recompile-callers? ( word -- ? )
42 changed-effects get key? ;
44 : recompile-callers ( words -- )
45 #! If a word's stack effect changed, recompile all words that
46 #! have compiled calls to it.
47 dup recompile-callers?
48 [ compiled-usage keys [ queue-compile ] each ] [ drop ] if ;
50 : compiler-message ( string -- )
51 "trace-compilation" get [ global [ print flush ] bind ] [ drop ] if ;
54 dup name>> compiler-message
55 H{ } clone dependencies set
56 H{ } clone generic-dependencies set
57 clear-compiler-error ;
59 GENERIC: no-compile? ( word -- ? )
61 M: method-body no-compile? "method-generic" word-prop no-compile? ;
63 M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
66 { [ macro? ] [ "special" word-prop ] [ "no-compile" word-prop ] } 1|| ;
68 GENERIC: combinator? ( word -- ? )
70 M: method-body combinator? "method-generic" word-prop combinator? ;
72 M: predicate-engine-word combinator? "owner-generic" word-prop combinator? ;
74 M: word combinator? inline? ;
76 : ignore-error? ( word error -- ? )
77 #! Ignore some errors on inline combinators, macros, and special
78 #! words such as 'call'.
81 [ [ combinator? ] [ unknown-macro-input? ] bi* and ]
85 #! Recompile callers if the word's stack effect changed, then
86 #! save the word's dependencies so that if they change, the
87 #! word can get recompiled too.
93 generic-dependencies get
98 : deoptimize-with ( word def -- * )
99 #! If the word failed to infer, compile it with the
100 #! non-optimizing compiler.
101 swap [ finish ] [ compiled get set-at ] bi return ;
103 : not-compiled-def ( word error -- def )
104 '[ _ _ not-compiled ] [ ] like ;
106 : deoptimize* ( word -- * )
107 dup def>> deoptimize-with ;
109 : ignore-error ( word error -- * )
110 drop [ clear-compiler-error ] [ deoptimize* ] bi ;
112 : remember-error ( word error -- * )
113 [ swap <compiler-error> compiler-error ]
114 [ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
117 : deoptimize ( word error -- * )
118 #! If the error is ignorable, compile the word with the
119 #! non-optimizing compiler, using its definition. Otherwise,
120 #! if the compiler error is not ignorable, use a dummy
121 #! definition from 'not-compiled-def' which throws an error.
123 { [ dup inference-error? not ] [ rethrow ] }
124 { [ 2dup ignore-error? ] [ ignore-error ] }
128 : optimize? ( word -- ? )
129 single-generic? not ;
131 : contains-breakpoints? ( -- ? )
132 dependencies get keys [ "break?" word-prop ] any? ;
134 : frontend ( word -- tree )
135 #! If the word contains breakpoints, don't optimize it, since
136 #! the walker does not support this.
138 [ [ build-tree ] [ deoptimize ] recover optimize-tree ] keep
139 contains-breakpoints? [ nip deoptimize* ] [ drop ] if
140 ] [ deoptimize* ] if ;
142 : compile-dependency ( word -- )
143 #! If a word calls an unoptimized word, try to compile the callee.
144 dup optimized? [ drop ] [ queue-compile ] if ;
146 ! Only switch this off for debugging.
147 SYMBOL: compile-dependencies?
149 t compile-dependencies? set-global
151 : compile-dependencies ( asm -- )
152 compile-dependencies? get
153 [ calls>> [ compile-dependency ] each ] [ drop ] if ;
155 : save-asm ( asm -- )
156 [ [ code>> ] [ label>> ] bi compiled get set-at ]
157 [ compile-dependencies ]
160 : backend ( tree word -- )
162 [ optimize-cfg build-mr ] with-cfg
167 : compile-word ( word -- )
168 #! We return early if the word has breakpoints or if it
179 : compile-loop ( deque -- )
180 [ compile-word yield-hook get call( -- ) ] slurp-deque ;
182 : decompile ( word -- )
183 dup def>> 2array 1array modify-code-heap ;
185 : compile-call ( quot -- )
186 [ dup infer define-temp ] with-compilation-unit execute ;
188 \ compile-call t "no-compile" set-word-prop
190 SINGLETON: optimizing-compiler
192 M: optimizing-compiler recompile ( words -- alist )
194 <hashed-dlist> compile-queue set
195 H{ } clone compiled set
198 [ subwords [ compile-dependency ] each ] bi
200 compile-queue get compile-loop
203 "--- compile done" compiler-message ;
205 M: optimizing-compiler to-recompile ( -- words )
206 changed-definitions get compiled-usages
207 changed-generics get compiled-generic-usages
208 append assoc-combine keys ;
210 M: optimizing-compiler process-forgotten-words
211 [ delete-compiled-xref ] each ;
213 : with-optimizer ( quot -- )
214 [ optimizing-compiler compiler-impl ] dip with-variable ; inline
216 : enable-optimizer ( -- )
217 optimizing-compiler compiler-impl set-global ;
219 : disable-optimizer ( -- )
220 f compiler-impl set-global ;
222 : recompile-all ( -- )