basis/compiler/compiler.factor

   1 ! Copyright (C) 2004, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel namespaces arrays sequences io inference.backend
   4 inference.state generator debugger words compiler.units
   5 continuations vocabs assocs alien.compiler dlists optimizer
   6 definitions math compiler.errors threads graphs generic
   7 inference combinators dequeues search-dequeues ;
   8 IN: compiler
   9
  10 SYMBOL: +failed+
  11
  12 : ripple-up ( words -- )
  13     dup "compiled-effect" word-prop +failed+ eq?
  14     [ usage [ word? ] filter ] [ compiled-usage keys ] if
  15     [ queue-compile ] each ;
  16
  17 : ripple-up? ( word effect -- ? )
  18     #! If the word has previously been compiled and had a
  19     #! different stack effect, we have to recompile any callers.
  20     swap "compiled-effect" word-prop [ = not ] keep and ;
  21
  22 : save-effect ( word effect -- )
  23     [ dupd ripple-up? [ ripple-up ] [ drop ] if ]
  24     [ "compiled-effect" set-word-prop ]
  25     2bi ;
  26
  27 : compile-begins ( word -- )
  28     f swap compiler-error ;
  29
  30 : compile-failed ( word error -- )
  31     [ swap compiler-error ]
  32     [
  33         drop
  34         [ compiled-unxref ]
  35         [ f swap compiled get set-at ]
  36         [ +failed+ save-effect ]
  37         tri
  38     ] 2bi ;
  39
  40 : compile-succeeded ( effect word -- )
  41     [ swap save-effect ]
  42     [ compiled-unxref ]
  43     [
  44         dup crossref?
  45         [ dependencies get compiled-xref ] [ drop ] if
  46     ] tri ;
  47
  48 : (compile) ( word -- )
  49     [
  50         H{ } clone dependencies set
  51
  52         {
  53             [ compile-begins ]
  54             [
  55                 [ word-dataflow ] [ compile-failed return ] recover
  56                 optimize
  57             ]
  58             [ dup generate ]
  59             [ compile-succeeded ]
  60         } cleave
  61     ] curry with-return ;
  62
  63 : compile-loop ( dequeue -- )
  64     [ (compile) yield ] slurp-dequeue ;
  65
  66 : decompile ( word -- )
  67     f 2array 1array t modify-code-heap ;
  68
  69 : optimized-recompile-hook ( words -- alist )
  70     [
  71         <hashed-dlist> compile-queue set
  72         H{ } clone compiled set
  73         [ queue-compile ] each
  74         compile-queue get compile-loop
  75         compiled get >alist
  76     ] with-scope ;
  77
  78 : enable-compiler ( -- )
  79     [ optimized-recompile-hook ] recompile-hook set-global ;
  80
  81 : disable-compiler ( -- )
  82     [ default-recompile-hook ] recompile-hook set-global ;
  83
  84 : recompile-all ( -- )
  85     forget-errors all-words compile ;