Massive focused action #1

db4
Slava Pestov 2008-08-30 00:09:45 -05:00
parent 85cdb1b767
commit b3f3068bdc
5 changed files with 4 additions and 24 deletions

View File

@ -33,7 +33,6 @@ H{ } clone sub-primitives set
! Bring up a bare cross-compiling vocabulary. ! Bring up a bare cross-compiling vocabulary.
"syntax" vocab vocab-words bootstrap-syntax set "syntax" vocab vocab-words bootstrap-syntax set
H{ } clone dictionary set H{ } clone dictionary set
H{ } clone new-classes set
H{ } clone changed-definitions set H{ } clone changed-definitions set
H{ } clone forgotten-definitions set H{ } clone forgotten-definitions set
H{ } clone root-cache set H{ } clone root-cache set

View File

@ -119,7 +119,7 @@ M: sequence implementors [ implementors ] gather ;
: (define-class) ( word props -- ) : (define-class) ( word props -- )
>r >r
dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless dup class? [ implementors-map+ ] unless
dup reset-class dup reset-class
dup deferred? [ dup define-symbol ] when dup deferred? [ dup define-symbol ] when
dup props>> dup props>>

View File

@ -39,11 +39,6 @@ TUPLE: check-mixin-class mixin ;
[ [ members swap bootstrap-word ] dip call ] [ drop ] 2bi [ [ members swap bootstrap-word ] dip call ] [ drop ] 2bi
swap redefine-mixin-class ; inline swap redefine-mixin-class ; inline
: update-classes/new ( mixin -- )
class-usages
[ [ update-class ] each ]
[ implementors [ make-generic ] each ] bi ;
: add-mixin-instance ( class mixin -- ) : add-mixin-instance ( class mixin -- )
#! Note: we call update-classes on the new member, not the #! Note: we call update-classes on the new member, not the
#! mixin. This ensures that we only have to update the #! mixin. This ensures that we only have to update the
@ -53,12 +48,9 @@ TUPLE: check-mixin-class mixin ;
#! updated by transitivity; the mixins usages appear in #! updated by transitivity; the mixins usages appear in
#! class-usages of the member, now that it's been added. #! class-usages of the member, now that it's been added.
[ 2drop ] [ [ 2drop ] [
[ [ suffix ] change-mixin-class ] 2keep [ [ suffix ] change-mixin-class ]
tuck [ new-class? ] either? [ [ drop update-classes ]
update-classes/new 2bi
] [
update-classes
] if
] if-mixin-member? ; ] if-mixin-member? ;
: remove-mixin-instance ( class mixin -- ) : remove-mixin-instance ( class mixin -- )

View File

@ -94,7 +94,6 @@ SYMBOL: update-tuples-hook
[ [
H{ } clone changed-definitions set H{ } clone changed-definitions set
H{ } clone outdated-tuples set H{ } clone outdated-tuples set
H{ } clone new-classes set
[ finish-compilation-unit ] [ ] cleanup [ finish-compilation-unit ] [ ] cleanup
] with-scope ; inline ] with-scope ; inline
@ -103,7 +102,6 @@ SYMBOL: update-tuples-hook
H{ } clone changed-definitions set H{ } clone changed-definitions set
H{ } clone forgotten-definitions set H{ } clone forgotten-definitions set
H{ } clone outdated-tuples set H{ } clone outdated-tuples set
H{ } clone new-classes set
<definitions> new-definitions set <definitions> new-definitions set
<definitions> old-definitions set <definitions> old-definitions set
[ [

View File

@ -28,15 +28,6 @@ SYMBOL: +called+
swap changed-definitions get swap changed-definitions get
[ set-at ] [ no-compilation-unit ] if* ; [ set-at ] [ no-compilation-unit ] if* ;
SYMBOL: new-classes
: new-class ( word -- )
dup new-classes get
[ set-at ] [ no-compilation-unit ] if* ;
: new-class? ( word -- ? )
new-classes get key? ;
GENERIC: where ( defspec -- loc ) GENERIC: where ( defspec -- loc )
M: object where drop f ; M: object where drop f ;