core/compiler/compiler.factor

   1 ! Copyright (C) 2004, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: compiler
   4 USING: errors generic hashtables inference io kernel math
   5 namespaces optimizer parser prettyprint sequences test threads
   6 words ;
   7
   8 SYMBOL: print-warnings
   9
  10 t print-warnings set-global
  11
  12 SYMBOL: batch-errors
  13
  14 GENERIC: batch-begins ( batch-errors -- )
  15
  16 M: f batch-begins drop ;
  17
  18 GENERIC: compile-begins ( word batch-errors -- )
  19
  20 M: f compile-begins drop "Compiling " write . flush ;
  21
  22 GENERIC: compile-error ( error batch-errors -- )
  23
  24 M: f compile-error
  25     drop
  26     dup inference-error-major? print-warnings get or
  27     [ dup error. flush ] when drop ;
  28
  29 GENERIC: batch-ends ( batch-errors -- )
  30
  31 M: f batch-ends drop ;
  32
  33 : word-dataflow ( word -- dataflow )
  34     [
  35         dup "no-effect" word-prop [ no-effect ] when
  36         dup dup add-recursive-state
  37         [ specialized-def (dataflow) ] keep
  38         finish-word 2drop
  39     ] with-infer ;
  40
  41 : (compile) ( word -- )
  42     dup compiling? not over compound? and [
  43         dup batch-errors get compile-begins
  44         dup word-dataflow optimize generate
  45     ] [
  46         drop
  47     ] if ;
  48
  49 : compile ( word -- )
  50     [ (compile) ] with-compiler ;
  51
  52 : try-compile ( word -- )
  53     [ compile ]
  54     [ batch-errors get compile-error update-xt ] recover ;
  55
  56 : compile-batch ( seq -- )
  57     batch-errors get batch-begins
  58     dup
  59     [ f "no-effect" set-word-prop ] each
  60     [ try-compile ] each
  61     batch-errors get batch-ends ;
  62
  63 : compile-vocabs ( seq -- )
  64     [ words ] map concat compile-batch ;
  65
  66 : compile-all ( -- )
  67     vocabs compile-vocabs changed-words get clear-hash ;
  68
  69 : compile-quot ( quot -- word )
  70     define-temp dup compile ;
  71
  72 : compile-1 ( quot -- ) compile-quot execute ;
  73
  74 : recompile ( -- )
  75     changed-words get [
  76         dup hash-keys compile-batch clear-hash
  77     ] when* ;