basis/compiler/compiler.factor

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