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
|
2007-12-24 19:40:09 -05:00
|
|
|
generator debugger math.parser prettyprint words words.private
|
|
|
|
continuations vocabs assocs alien.compiler dlists optimizer
|
2007-12-30 15:05:33 -05:00
|
|
|
definitions math compiler.errors threads ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: compiler
|
|
|
|
|
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 -- )
|
2007-12-30 15:05:33 -05:00
|
|
|
yield
|
2007-12-24 21:41:46 -05:00
|
|
|
[
|
|
|
|
dup word-dataflow optimize >r over dup r> generate
|
|
|
|
] [
|
2007-12-28 21:45:16 -05:00
|
|
|
dup inference-error? [ rethrow ] unless
|
2007-12-28 22:51:36 -05:00
|
|
|
over compiler-error f over compiled get set-at f
|
2007-12-24 21:41:46 -05:00
|
|
|
] recover
|
2007-12-26 21:37:18 -05:00
|
|
|
2drop ;
|
|
|
|
! 2dup ripple-up save-effect ;
|
2007-12-24 21:41:46 -05:00
|
|
|
|
|
|
|
: delete-any ( assoc -- element )
|
|
|
|
[ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ;
|
|
|
|
|
|
|
|
: compile-loop ( assoc -- )
|
|
|
|
dup assoc-empty?
|
|
|
|
[ drop ] [ dup delete-any (compile) compile-loop ] if ;
|
2007-12-17 16:29:54 -05:00
|
|
|
|
2007-12-26 20:21:46 -05:00
|
|
|
: recompile ( words -- )
|
2007-12-17 16:29:54 -05:00
|
|
|
[
|
2007-12-24 21:41:46 -05:00
|
|
|
H{ } clone compile-queue set
|
|
|
|
H{ } clone compiled set
|
2007-12-21 21:18:24 -05:00
|
|
|
[ queue-compile ] each
|
2007-12-24 21:41:46 -05:00
|
|
|
compile-queue get compile-loop
|
|
|
|
compiled get >alist modify-code-heap
|
2007-12-17 16:29:54 -05:00
|
|
|
] with-scope ; inline
|
|
|
|
|
2007-12-26 20:21:46 -05:00
|
|
|
: compile ( words -- )
|
|
|
|
[ compiled? not ] subset recompile ;
|
|
|
|
|
2007-12-27 17:26:39 -05:00
|
|
|
: compile-call ( quot -- )
|
2007-12-24 21:41:46 -05:00
|
|
|
H{ } clone changed-words [
|
2007-12-26 20:21:46 -05:00
|
|
|
define-temp dup 1array recompile
|
2007-12-27 17:26:39 -05:00
|
|
|
] with-variable execute ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2007-12-27 17:26:39 -05:00
|
|
|
: recompile-all ( -- )
|
2007-12-28 22:51:36 -05:00
|
|
|
[ all-words recompile ] with-compiler-errors ;
|
2007-12-27 17:26:39 -05:00
|
|
|
|
|
|
|
: decompile ( word -- )
|
|
|
|
f 2array 1array modify-code-heap ;
|