An experiment -- instead of decompiling words when a word they call has changed, recompile them

slava 2006-08-10 20:44:00 +00:00
parent 40f06282c2
commit de124cc191
4 changed files with 25 additions and 14 deletions

View File

@ -84,12 +84,3 @@ M: alien-invoke stack-reserve*
: define-c-word ( return library function parameters -- )
[ "()" subseq? not ] subset >r pick r> parse-arglist
(define-c-word) ;
M: compound unxref-word*
dup "infer" word-prop [
dup
{ "infer-effect" "base-case" "no-effect" }
reset-props
dup word-def \ alien-invoke swap member?
[ dup update-xt ] unless
] unless drop ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2004, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
USING: errors hashtables inference io kernel math namespaces
optimizer prettyprint sequences test threads words ;
USING: errors generic hashtables inference io kernel math
namespaces optimizer prettyprint sequences test threads words ;
: (compile) ( word -- )
dup compiling? not over compound? and [
@ -18,7 +18,7 @@ optimizer prettyprint sequences test threads words ;
: compiled ( -- ) "compile" get [ word compile ] when ; parsing
: try-compile ( word -- )
[ compile ] [ error. drop ] recover ;
[ compile ] [ error. update-xt ] recover ;
: compile-vocabs ( vocabs -- )
[ words ] map concat
@ -31,3 +31,17 @@ optimizer prettyprint sequences test threads words ;
define-temp "compile" get [ dup compile ] when ;
: compile-1 ( quot -- ) compile-quot execute ;
: recompile ( -- )
[
recompile-words get hash-keys [ try-compile ] each
recompile-words get clear-hash
] with-class<cache ;
M: compound unxref-word*
dup "infer" word-prop [
drop
] [
dup dup recompile-words get set-hash
{ "infer-effect" "base-case" "no-effect" } reset-props
] if ;

View File

@ -5,6 +5,10 @@ USING: arrays assembler errors generic hashtables kernel
kernel-internals math namespaces prettyprint queues
sequences strings vectors words ;
SYMBOL: recompile-words
H{ } clone recompile-words set-global
DEFER: (compile)
: compiled-offset ( -- n ) building get length code-format * ;
@ -21,6 +25,7 @@ C: label ( -- label ) ;
SYMBOL: compiled-xts
: save-xt ( word xt -- )
over recompile-words get remove-hash
swap compiled-xts get set-hash ;
SYMBOL: literal-table
@ -81,7 +86,8 @@ SYMBOL: label-table
: compiling? ( word -- ? )
#! A word that is compiling or already compiled will not be
#! added to the list of words to be compiled.
dup compiled? swap compiled-xts get hash-member? or ;
dup compiled? over recompile-words get hash-member? not and
swap compiled-xts get hash-member? or ;
: with-compiler ( quot -- )
[

View File

@ -34,7 +34,7 @@ H{ } clone modules set-global
: (require) ( name -- )
dup module [ drop ] [ load-module ] if ;
: require ( name -- ) (require) compile-all ;
: require ( name -- ) (require) recompile ;
: run-resources ( seq -- )
bootstrapping? get