An experiment -- instead of decompiling words when a word they call has changed, recompile them
parent
40f06282c2
commit
de124cc191
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 -- )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue