basis/compiler/compiler.factor

   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
   7
   8 stack-checker stack-checker.dependencies stack-checker.inlining
   9 stack-checker.errors
  10
  11 compiler.errors compiler.units compiler.utilities
  12
  13 compiler.tree.builder
  14 compiler.tree.optimizer
  15
  16 compiler.crossref
  17
  18 compiler.cfg
  19 compiler.cfg.builder
  20 compiler.cfg.optimizer
  21 compiler.cfg.mr
  22
  23 compiler.codegen ;
  24 IN: compiler
  25
  26 SYMBOL: compile-queue
  27 SYMBOL: compiled
  28
  29 : compile? ( word -- ? )
  30     #! Don't attempt to compile certain words.
  31     {
  32         [ "forgotten" word-prop ]
  33         [ compiled get key? ]
  34         [ inlined-block? ]
  35         [ primitive? ]
  36     } 1|| not ;
  37
  38 : queue-compile ( word -- )
  39     dup compile? [ compile-queue get push-front ] [ drop ] if ;
  40
  41 : recompile-callers? ( word -- ? )
  42     changed-effects get key? ;
  43
  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 ;
  49
  50 : compiler-message ( string -- )
  51     "trace-compilation" get [ global [ print flush ] bind ] [ drop ] if ;
  52
  53 : start ( word -- )
  54     dup name>> compiler-message
  55     H{ } clone dependencies set
  56     H{ } clone generic-dependencies set
  57     clear-compiler-error ;
  58
  59 GENERIC: no-compile? ( word -- ? )
  60
  61 M: method-body no-compile? "method-generic" word-prop no-compile? ;
  62
  63 M: predicate-engine-word no-compile? "owner-generic" word-prop no-compile? ;
  64
  65 M: word no-compile?
  66     { [ macro? ] [ "special" word-prop ] [ "no-compile" word-prop ] } 1|| ;
  67
  68 GENERIC: combinator? ( word -- ? )
  69
  70 M: method-body combinator? "method-generic" word-prop combinator? ;
  71
  72 M: predicate-engine-word combinator? "owner-generic" word-prop combinator? ;
  73
  74 M: word combinator? inline? ;
  75
  76 : ignore-error? ( word error -- ? )
  77     #! Ignore some errors on inline combinators, macros, and special
  78     #! words such as 'call'.
  79     {
  80         [ drop no-compile? ]
  81         [ [ combinator? ] [ unknown-macro-input? ] bi* and ]
  82     } 2|| ;
  83
  84 : finish ( word -- )
  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.
  88     [ recompile-callers ]
  89     [ compiled-unxref ]
  90     [
  91         dup crossref? [
  92             dependencies get
  93             generic-dependencies get
  94             compiled-xref
  95         ] [ drop ] if
  96     ] tri ;
  97
  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 ;
 102
 103 : not-compiled-def ( word error -- def )
 104     '[ _ _ not-compiled ] [ ] like ;
 105
 106 : deoptimize* ( word -- * )
 107     dup def>> deoptimize-with ;
 108
 109 : ignore-error ( word error -- * )
 110     drop [ clear-compiler-error ] [ deoptimize* ] bi ;
 111
 112 : remember-error ( word error -- * )
 113     [ swap <compiler-error> compiler-error ]
 114     [ [ drop ] [ not-compiled-def ] 2bi deoptimize-with ]
 115     2bi ;
 116
 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.
 122     {
 123         { [ dup inference-error? not ] [ rethrow ] }
 124         { [ 2dup ignore-error? ] [ ignore-error ] }
 125         [ remember-error ]
 126     } cond ;
 127
 128 : optimize? ( word -- ? )
 129     single-generic? not ;
 130
 131 : contains-breakpoints? ( -- ? )
 132     dependencies get keys [ "break?" word-prop ] any? ;
 133
 134 : frontend ( word -- tree )
 135     #! If the word contains breakpoints, don't optimize it, since
 136     #! the walker does not support this.
 137     dup optimize? [
 138         [ [ build-tree ] [ deoptimize ] recover optimize-tree ] keep
 139         contains-breakpoints? [ nip deoptimize* ] [ drop ] if
 140     ] [ deoptimize* ] if ;
 141
 142 : compile-dependency ( word -- )
 143     #! If a word calls an unoptimized word, try to compile the callee.
 144     dup optimized? [ drop ] [ queue-compile ] if ;
 145
 146 ! Only switch this off for debugging.
 147 SYMBOL: compile-dependencies?
 148
 149 t compile-dependencies? set-global
 150
 151 : compile-dependencies ( asm -- )
 152     compile-dependencies? get
 153     [ calls>> [ compile-dependency ] each ] [ drop ] if ;
 154
 155 : save-asm ( asm -- )
 156     [ [ code>> ] [ label>> ] bi compiled get set-at ]
 157     [ compile-dependencies ]
 158     bi ;
 159
 160 : backend ( tree word -- )
 161     build-cfg [
 162         [ optimize-cfg build-mr ] with-cfg
 163         generate
 164         save-asm
 165     ] each ;
 166
 167 : compile-word ( word -- )
 168     #! We return early if the word has breakpoints or if it
 169     #! failed to infer.
 170     '[
 171         _ {
 172             [ start ]
 173             [ frontend ]
 174             [ backend ]
 175             [ finish ]
 176         } cleave
 177     ] with-return ;
 178
 179 : compile-loop ( deque -- )
 180     [ compile-word yield-hook get call( -- ) ] slurp-deque ;
 181
 182 : decompile ( word -- )
 183     dup def>> 2array 1array modify-code-heap ;
 184
 185 : compile-call ( quot -- )
 186     [ dup infer define-temp ] with-compilation-unit execute ;
 187
 188 \ compile-call t "no-compile" set-word-prop
 189
 190 SINGLETON: optimizing-compiler
 191
 192 M: optimizing-compiler recompile ( words -- alist )
 193     [
 194         <hashed-dlist> compile-queue set
 195         H{ } clone compiled set
 196         [
 197             [ queue-compile ]
 198             [ subwords [ compile-dependency ] each ] bi
 199         ] each
 200         compile-queue get compile-loop
 201         compiled get >alist
 202     ] with-scope
 203     "--- compile done" compiler-message ;
 204
 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 ;
 209
 210 M: optimizing-compiler process-forgotten-words
 211     [ delete-compiled-xref ] each ;
 212
 213 : with-optimizer ( quot -- )
 214     [ optimizing-compiler compiler-impl ] dip with-variable ; inline
 215
 216 : enable-optimizer ( -- )
 217     optimizing-compiler compiler-impl set-global ;
 218
 219 : disable-optimizer ( -- )
 220     f compiler-impl set-global ;
 221
 222 : recompile-all ( -- )
 223     all-words compile ;