2008-01-01 14:54:14 -05:00
|
|
|
! Copyright (C) 2004, 2008 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: kernel namespaces arrays sequences io inference.backend
|
2008-01-01 14:54:14 -05:00
|
|
|
inference.state generator debugger math.parser prettyprint words
|
2008-01-09 04:52:08 -05:00
|
|
|
compiler.units continuations vocabs assocs alien.compiler dlists
|
2008-01-01 14:54:14 -05:00
|
|
|
optimizer definitions math compiler.errors threads graphs
|
|
|
|
generic ;
|
2007-09-20 18:09:08 -04:00
|
|
|
IN: compiler
|
|
|
|
|
2008-01-01 14:54:14 -05:00
|
|
|
: compiled-usages ( words -- seq )
|
2008-01-12 04:25:16 -05:00
|
|
|
[ [ dup ] H{ } map>assoc dup ] keep [
|
|
|
|
compiled-usage [ nip +inlined+ eq? ] assoc-subset update
|
|
|
|
] with each keys ;
|
2008-01-01 14:54:14 -05:00
|
|
|
|
|
|
|
: ripple-up ( word -- )
|
2008-01-12 04:25:16 -05:00
|
|
|
compiled-usage [ drop queue-compile ] assoc-each ;
|
2007-12-19 20:55:40 -05:00
|
|
|
|
|
|
|
: save-effect ( word effect -- )
|
2008-01-01 14:54:14 -05:00
|
|
|
over "compiled-uses" word-prop [
|
|
|
|
2dup swap "compiled-effect" word-prop =
|
|
|
|
[ over ripple-up ] unless
|
|
|
|
] when
|
2007-12-19 20:55:40 -05:00
|
|
|
"compiled-effect" set-word-prop ;
|
|
|
|
|
2008-01-01 14:54:14 -05:00
|
|
|
: finish-compile ( word effect dependencies -- )
|
2008-01-09 04:52:08 -05:00
|
|
|
>r dupd save-effect r>
|
|
|
|
f pick compiler-error
|
|
|
|
over compiled-unxref
|
2008-01-24 02:20:05 -05:00
|
|
|
over word-vocabulary [ compiled-xref ] [ 2drop ] if ;
|
2008-01-01 14:54:14 -05:00
|
|
|
|
|
|
|
: compile-succeeded ( word -- effect dependencies )
|
2007-12-24 21:41:46 -05:00
|
|
|
[
|
2008-01-01 14:54:14 -05:00
|
|
|
dup word-dataflow >r swap dup r> optimize generate
|
|
|
|
] computing-dependencies ;
|
|
|
|
|
|
|
|
: compile-failed ( word error -- )
|
|
|
|
f pick compiled get set-at
|
|
|
|
swap compiler-error ;
|
|
|
|
|
|
|
|
: (compile) ( word -- )
|
|
|
|
[ dup compile-succeeded finish-compile ]
|
|
|
|
[ dupd compile-failed f save-effect ]
|
|
|
|
recover ;
|
2007-12-24 21:41:46 -05:00
|
|
|
|
|
|
|
: compile-loop ( assoc -- )
|
2007-12-30 16:09:21 -05:00
|
|
|
dup assoc-empty? [ drop ] [
|
|
|
|
dup delete-any (compile)
|
|
|
|
yield
|
|
|
|
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 -- )
|
2008-01-01 14:54:14 -05:00
|
|
|
H{ } clone changed-words
|
|
|
|
[ define-temp dup 1array compile ] 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 ;
|