factor/core/compiler/units/units.factor

166 lines
4.8 KiB
Factor
Raw Normal View History

! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel continuations assocs namespaces
2008-08-30 03:31:27 -04:00
sequences words vocabs definitions hashtables init sets
math.order classes.algebra ;
IN: compiler.units
SYMBOL: old-definitions
SYMBOL: new-definitions
TUPLE: redefine-error def ;
: redefine-error ( definition -- )
\ redefine-error boa
{ { "Continue" t } } throw-restarts drop ;
: add-once ( key assoc -- )
2008-05-25 20:44:37 -04:00
2dup key? [ over redefine-error ] when conjoin ;
: (remember-definition) ( definition loc assoc -- )
>r over set-where r> add-once ;
: remember-definition ( definition loc -- )
new-definitions get first (remember-definition) ;
: remember-class ( class loc -- )
over new-definitions get first key? [ dup redefine-error ] when
new-definitions get second (remember-definition) ;
: forward-reference? ( word -- ? )
dup old-definitions get assoc-stack
[ new-definitions get assoc-stack not ]
[ drop f ] if ;
SYMBOL: recompile-hook
: <definitions> ( -- pair ) { H{ } H{ } } [ clone ] map ;
SYMBOL: definition-observers
GENERIC: definitions-changed ( assoc obj -- )
2008-02-25 20:37:43 -05:00
[ V{ } clone definition-observers set-global ]
"compiler.units" add-init-hook
: add-definition-observer ( obj -- )
2008-02-25 20:37:43 -05:00
definition-observers get push ;
: remove-definition-observer ( obj -- )
definition-observers get delete ;
: notify-definition-observers ( assoc -- )
definition-observers get
2008-01-09 17:36:30 -05:00
[ definitions-changed ] with each ;
: changed-vocabs ( assoc -- vocabs )
[ drop word? ] assoc-filter
[ drop vocabulary>> dup [ vocab ] when dup ] assoc-map ;
2008-04-05 08:00:09 -04:00
: updated-definitions ( -- assoc )
H{ } clone
dup forgotten-definitions get update
dup new-definitions get first update
dup new-definitions get second update
2008-04-05 08:00:09 -04:00
dup changed-definitions get update
dup dup changed-vocabs update ;
: compile ( words -- )
recompile-hook get call
dup [ drop crossref? ] assoc-contains?
modify-code-heap ;
SYMBOL: outdated-tuples
SYMBOL: update-tuples-hook
2008-08-30 03:31:27 -04:00
: strongest-dependency ( how1 how2 -- how )
[ called-dependency or ] bi@
2dup [ method-dependency? ] both?
[ [ class>> ] bi@ class-or <method-dependency> ] [ max ] if ;
: weakest-dependency ( how1 how2 -- how )
[ inlined-dependency or ] bi@
2dup [ method-dependency? ] both?
[ [ class>> ] bi@ class-and <method-dependency> ] [ min ] if ;
: relevant-dependency? ( how to -- ? )
#! Note that an intersection check alone is not enough,
#! since we're also interested in empty mixins.
2dup [ method-dependency? ] both? [
[ class>> ] bi@
[ classes-intersect? ] [ class<= ] 2bi or
] [ after=? ] if ;
: compiled-usage ( word -- assoc )
compiled-crossref get at ;
: (compiled-usages) ( word dependency -- assoc )
#! If the word is not flushable anymore, we have to recompile
#! all words which flushable away a call (presumably when the
#! word was still flushable). If the word is flushable, we
#! don't have to recompile words that folded this away.
[ drop compiled-usage ]
[
swap "flushable" word-prop inlined-dependency flushed-dependency ?
weakest-dependency
] 2bi
[ relevant-dependency? nip ] curry assoc-filter ;
: compiled-usages ( assoc -- seq )
clone [
dup [
[ (compiled-usages) ] dip swap update
] curry assoc-each
] keep keys ;
2008-02-25 04:38:37 -05:00
: call-recompile-hook ( -- )
changed-definitions get [ drop word? ] assoc-filter
2008-02-25 04:38:37 -05:00
compiled-usages recompile-hook get call ;
: call-update-tuples-hook ( -- )
update-tuples-hook get call ;
2008-02-25 04:38:37 -05:00
2008-06-11 03:58:38 -04:00
: unxref-forgotten-definitions ( -- )
forgotten-definitions get
keys [ word? ] filter
[ delete-compiled-xref ] each ;
: finish-compilation-unit ( -- )
2008-02-25 04:38:37 -05:00
call-recompile-hook
call-update-tuples-hook
2008-06-11 03:58:38 -04:00
unxref-forgotten-definitions
dup [ drop crossref? ] assoc-contains? modify-code-heap ;
2008-05-28 20:34:18 -04:00
: with-nested-compilation-unit ( quot -- )
[
H{ } clone changed-definitions set
H{ } clone outdated-tuples set
2008-08-30 03:32:17 -04:00
H{ } clone new-classes set
2008-05-28 20:34:18 -04:00
[ finish-compilation-unit ] [ ] cleanup
] with-scope ; inline
: with-compilation-unit ( quot -- )
[
2008-04-05 08:00:09 -04:00
H{ } clone changed-definitions set
H{ } clone forgotten-definitions set
H{ } clone outdated-tuples set
2008-08-30 03:32:17 -04:00
H{ } clone new-classes set
<definitions> new-definitions set
<definitions> old-definitions set
2008-05-28 20:34:18 -04:00
[
finish-compilation-unit
updated-definitions
notify-definition-observers
] [ ] cleanup
] with-scope ; inline
: compile-call ( quot -- )
[ define-temp ] with-compilation-unit execute ;
: default-recompile-hook ( words -- alist )
[ f ] { } map>assoc ;
2008-02-17 19:38:29 -05:00
recompile-hook global
2008-02-17 19:38:29 -05:00
[ [ default-recompile-hook ] or ]
change-at