2007-09-20 18:09:08 -04:00
|
|
|
! Copyright (C) 2004, 2007 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: kernel namespaces arrays sequences io inference.backend
|
|
|
|
generator debugger math.parser prettyprint words continuations
|
2007-12-21 21:18:24 -05:00
|
|
|
vocabs assocs alien.compiler dlists optimizer definitions ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: compiler
|
|
|
|
|
2007-12-17 16:29:54 -05:00
|
|
|
SYMBOL: compiler-hook
|
|
|
|
|
|
|
|
: compile-begins ( word -- )
|
|
|
|
compiler-hook get [ call ] when*
|
|
|
|
"quiet" get [ drop ] [ "Compiling " write . flush ] if ;
|
|
|
|
|
2007-12-19 20:55:40 -05:00
|
|
|
: compiled-usage ( word -- seq )
|
|
|
|
#! XXX
|
|
|
|
usage [ word? ] subset ;
|
|
|
|
|
|
|
|
: ripple-up ( word effect -- )
|
|
|
|
over "compiled-effect" word-prop =
|
|
|
|
[ drop ] [
|
|
|
|
compiled-usage
|
|
|
|
[ "was-compiled" word-prop ] subset
|
2007-12-21 21:18:24 -05:00
|
|
|
[ queue-compile ] each
|
2007-12-19 20:55:40 -05:00
|
|
|
] if ;
|
|
|
|
|
|
|
|
: save-effect ( word effect -- )
|
|
|
|
over t "was-compiled" set-word-prop
|
|
|
|
"compiled-effect" set-word-prop ;
|
|
|
|
|
2007-12-17 16:29:54 -05:00
|
|
|
: (compile) ( word -- )
|
|
|
|
dup compiling? not over compound? and [
|
|
|
|
[
|
|
|
|
dup compile-begins
|
2007-12-19 20:55:40 -05:00
|
|
|
dup word-dataflow optimize >r over dup r> generate
|
|
|
|
] [
|
|
|
|
print-error
|
2007-12-21 21:18:24 -05:00
|
|
|
dup f compiled-xts get set-at f
|
2007-12-19 20:55:40 -05:00
|
|
|
] recover
|
|
|
|
2dup ripple-up save-effect
|
2007-12-17 16:29:54 -05:00
|
|
|
] [ drop ] if ;
|
|
|
|
|
2007-12-21 21:18:24 -05:00
|
|
|
: compile ( words -- )
|
2007-12-17 16:29:54 -05:00
|
|
|
[
|
|
|
|
<dlist> compile-queue set
|
|
|
|
H{ } clone compiled-xts set
|
2007-12-21 21:18:24 -05:00
|
|
|
[ queue-compile ] each
|
2007-12-17 16:29:54 -05:00
|
|
|
compile-queue get [ (compile) ] dlist-slurp
|
|
|
|
compiled-xts get finish-compilation-unit
|
|
|
|
] with-scope ; inline
|
|
|
|
|
|
|
|
: compile-quot ( quot -- word )
|
2007-12-21 21:18:24 -05:00
|
|
|
[ gensym dup rot define-compound ] with-compilation-unit ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2007-12-21 21:18:24 -05:00
|
|
|
: compile-call ( quot -- )
|
2007-12-17 16:29:54 -05:00
|
|
|
compile-quot execute ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2007-12-16 18:42:56 -05:00
|
|
|
: compile-all ( -- )
|
2007-12-21 21:18:24 -05:00
|
|
|
all-words compile-batch ;
|