steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More redefinition fixes

db4
Slava Pestov 2008-06-11 17:40:33 -05:00
parent 39180371de
commit 80720cea0d
8 changed files with 62 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
core/classes/classes.factor
View File

@ -76,8 +76,8 @@ M: word reset-class drop ;
tri
] { } make ;
: class-usages ( class -- assoc )
[ update-map get at ] closure ;
: class-usages ( class -- seq )
[ update-map get at ] closure keys ;
<PRIVATE
@ -116,13 +116,11 @@ GENERIC: update-class ( class -- )
M: class update-class drop ;
GENERIC: update-methods ( class assoc -- )
GENERIC: update-methods ( class seq -- )
: update-classes ( class -- )
dup class-usages
[ nip keys [ update-class ] each ]
[ update-methods ]
2bi ;
[ nip [ update-class ] each ] [ update-methods ] 2bi ;
: define-class ( word superclass members participants metaclass -- )
#! If it was already a class, update methods after.

2
core/classes/mixin/mixin.factor
View File

@ -39,7 +39,7 @@ TUPLE: check-mixin-class mixin ;
: update-classes/new ( mixin -- )
class-usages
[ keys [ update-class ] each ]
[ [ update-class ] each ]
[ implementors [ make-generic ] each ] bi ;
: add-mixin-instance ( class mixin -- )

34
core/classes/tuple/tuple-tests.factor
View File

@ -109,6 +109,7 @@ TUPLE: yo-momma ;
[
[ t ] [ \ yo-momma class? ] unit-test
[ ] [ \ yo-momma forget ] unit-test
[ ] [ \ <yo-momma> forget ] unit-test
[ f ] [ \ yo-momma update-map get values memq? ] unit-test
[ f ] [ \ yo-momma crossref get at ] unit-test
@ -552,11 +553,11 @@ TUPLE: subclass-forget-test-3 < subclass-forget-test-2 ;
[ ] [ "IN: classes.tuple.tests FORGET: subclass-forget-test" eval ] unit-test
[ H{ { subclass-forget-test-2 subclass-forget-test-2 } } ]
[ { subclass-forget-test-2 } ]
[ subclass-forget-test-2 class-usages ]
unit-test
[ H{ { subclass-forget-test-3 subclass-forget-test-3 } } ]
[ { subclass-forget-test-3 } ]
[ subclass-forget-test-3 class-usages ]
unit-test
@ -565,3 +566,32 @@ unit-test
[ subclass-forget-test-3 new ] must-fail
[ "IN: classes.tuple.tests TUPLE: subclass-forget-test-4 < subclass-forget-test-2 ;" eval ] must-fail
! More
DEFER: subclass-reset-test
DEFER: subclass-reset-test-1
DEFER: subclass-reset-test-2
DEFER: subclass-reset-test-3
GENERIC: break-me ( obj -- )
[ ] [ [ { integer break-me } forget ] with-compilation-unit ] unit-test
[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test ;" <string-reader> "subclass-reset-test" parse-stream drop ] unit-test
[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-1 < subclass-reset-test ;" eval ] unit-test
[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-2 < subclass-reset-test ;" eval ] unit-test
[ ] [ "IN: classes.tuple.tests TUPLE: subclass-reset-test-3 < subclass-reset-test-2 ;" eval ] unit-test
[ ] [ "IN: classes.tuple.tests USE: kernel M: subclass-reset-test-1 break-me drop ;" eval ] unit-test
[ ] [ "IN: classes.tuple.tests : subclass-reset-test ;" <string-reader> "subclass-reset-test" parse-stream drop ] unit-test
[ f ] [ subclass-reset-test-1 tuple-class? ] unit-test
[ f ] [ subclass-reset-test-2 tuple-class? ] unit-test
[ subclass-forget-test-3 new ] must-fail
[ t ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test
[ ] [ "IN: classes.tuple.tests USE: math USE: kernel M: integer break-me drop ;" eval ] unit-test
[ f ] [ \ break-me "methods" word-prop assoc-empty? ] unit-test

2
core/classes/tuple/tuple.factor
View File

@ -166,7 +166,7 @@ M: tuple-class update-class
3tri ;
: subclasses ( class -- classes )
class-usages keys [ tuple-class? ] filter ;
class-usages [ tuple-class? ] filter ;
: each-subclass ( class quot -- )
>r subclasses r> each ; inline

2
core/generator/generator.factor
View File

@ -71,11 +71,13 @@ GENERIC: generate-node ( node -- next )
] with-generator ;
: word-dataflow ( word -- effect dataflow )
[
[
dup "cannot-infer" word-prop [ cannot-infer-effect ] when
dup "no-compile" word-prop [ cannot-infer-effect ] when
dup specialized-def over dup 2array 1array infer-quot
finish-word
] maybe-cannot-infer
] with-infer ;
: intrinsics ( #call -- quot )

24
core/generic/generic.factor
View File

@ -157,31 +157,31 @@ GENERIC: implementors ( class/classes -- seq )
M: class implementors
all-words [ "methods" word-prop key? ] with filter ;
M: assoc implementors
M: sequence implementors
all-words [
"methods" word-prop keys
swap [ key? ] curry contains?
swap [ memq? ] curry contains?
] with filter ;
: forget-methods ( class -- )
[ implementors ] [ [ swap 2array ] curry ] bi map forget-all ;
M: class forget* ( class -- )
[
: forget-class ( class -- )
class-usages [
drop
{
[ "predicate" word-prop [ forget ] each ]
[ forget-methods ]
[ update-map- ]
[ reset-class ]
tri
] assoc-each
]
[ call-next-method ] bi ;
} cleave
] each ;
M: assoc update-methods ( class assoc -- )
M: class forget* ( class -- )
[ forget-class ] [ call-next-method ] bi ;
M: sequence update-methods ( class seq -- )
implementors [
[ update-generic ]
[ make-generic drop ] 2bi
[ update-generic ] [ make-generic drop ] 2bi
] with each ;
: define-generic ( word combination -- )

5
core/inference/backend/backend.factor
View File

@ -421,6 +421,9 @@ TUPLE: missing-effect word ;
[ "inferred-effect" set-word-prop ]
2tri ;
: maybe-cannot-infer ( word quot -- )
[ ] [ t "cannot-infer" set-word-prop ] cleanup ; inline
: infer-word ( word -- effect )
[
[
@ -431,7 +434,7 @@ TUPLE: missing-effect word ;
finish-word
current-effect
] with-scope
] [ ] [ t "cannot-infer" set-word-prop ] cleanup ;
] maybe-cannot-infer ;
: custom-infer ( word -- )
#! Customized inference behavior

3
core/parser/parser.factor
View File

@ -539,8 +539,7 @@ SYMBOL: interactive-vocabs
: reset-removed-classes ( -- )
removed-classes
filter-moved [ class? ] filter
[ [ forget-methods ] [ reset-class ] bi ] each ;
filter-moved [ class? ] filter [ forget-class ] each ;
: fix-class-words ( -- )
#! If a class word had a compound definition which was