basis/compiler/compiler.factor

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