Massive focused action #1
parent
85cdb1b767
commit
b3f3068bdc
|
@ -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
|
||||||
|
|
|
@ -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>>
|
||||||
|
|
|
@ -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 -- )
|
||||||
|
|
|
@ -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
|
||||||
[
|
[
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
Loading…
Reference in New Issue