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