factor/core/compiler/compiler.factor

74 lines
2.0 KiB
Factor
Raw Normal View History

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
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 ;
: 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
"compiled-effect" set-word-prop ;
2008-01-01 14:54:14 -05:00
: finish-compile ( word effect dependencies -- )
>r dupd save-effect r>
f pick compiler-error
over compiled-unxref
over word-vocabulary [ compiled-xref ] [ 2drop ] if ;
2008-01-01 14:54:14 -05:00
: compile-succeeded ( word -- effect dependencies )
[
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 ;
: 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-26 20:21:46 -05:00
: recompile ( words -- )
[
H{ } clone compile-queue set
H{ } clone compiled set
[ queue-compile ] each
compile-queue get compile-loop
compiled get >alist modify-code-heap
] with-scope ; inline
2007-12-26 20:21:46 -05:00
: compile ( words -- )
[ compiled? not ] subset recompile ;
: 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
: recompile-all ( -- )
[ all-words recompile ] with-compiler-errors ;
: decompile ( word -- )
f 2array 1array modify-code-heap ;