Merge branch 'master' of git://factorcode.org/git/factor
commit
d3997fbe08
|
@ -238,3 +238,31 @@ M: sequence generic-forget-test-2 = ;
|
||||||
\ = usage [ word? ] subset
|
\ = usage [ word? ] subset
|
||||||
[ word-name "generic-forget-test-2/sequence" = ] contains?
|
[ word-name "generic-forget-test-2/sequence" = ] contains?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
GENERIC: generic-forget-test-3
|
||||||
|
|
||||||
|
M: f generic-forget-test-3 ;
|
||||||
|
|
||||||
|
[ ] [ \ f \ generic-forget-test-3 method "m" set ] unit-test
|
||||||
|
|
||||||
|
[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
|
||||||
|
|
||||||
|
[ ] [ "IN: generic.tests M: f generic-forget-test-3 ;" eval ] unit-test
|
||||||
|
|
||||||
|
[ ] [ [ "m" get forget ] with-compilation-unit ] unit-test
|
||||||
|
|
||||||
|
[ f ] [ f generic-forget-test-3 ] unit-test
|
||||||
|
|
||||||
|
: a-word ;
|
||||||
|
|
||||||
|
GENERIC: a-generic
|
||||||
|
|
||||||
|
M: integer a-generic a-word ;
|
||||||
|
|
||||||
|
[ ] [ \ integer \ a-generic method "m" set ] unit-test
|
||||||
|
|
||||||
|
[ t ] [ "m" get \ a-word usage memq? ] unit-test
|
||||||
|
|
||||||
|
[ ] [ "IN: generic.tests : a-generic ;" eval ] unit-test
|
||||||
|
|
||||||
|
[ f ] [ "m" get \ a-word usage memq? ] unit-test
|
||||||
|
|
|
@ -104,20 +104,25 @@ M: method-spec definition
|
||||||
first2 method definition ;
|
first2 method definition ;
|
||||||
|
|
||||||
: forget-method ( class generic -- )
|
: forget-method ( class generic -- )
|
||||||
check-method
|
dup generic? [
|
||||||
[ delete-at* ] with-methods
|
[ delete-at* ] with-methods
|
||||||
[ forget-word ] [ drop ] if ;
|
[ forget-word ] [ drop ] if
|
||||||
|
] [
|
||||||
|
2drop
|
||||||
|
] if ;
|
||||||
|
|
||||||
M: method-spec forget*
|
M: method-spec forget*
|
||||||
first2 forget-method ;
|
first2 method forget* ;
|
||||||
|
|
||||||
M: method-body definer
|
M: method-body definer
|
||||||
drop \ M: \ ; ;
|
drop \ M: \ ; ;
|
||||||
|
|
||||||
M: method-body forget*
|
M: method-body forget*
|
||||||
|
dup "forgotten" word-prop [ drop ] [
|
||||||
dup "method-class" word-prop
|
dup "method-class" word-prop
|
||||||
swap "method-generic" word-prop
|
over "method-generic" word-prop forget-method
|
||||||
forget-method ;
|
t "forgotten" set-word-prop
|
||||||
|
] if ;
|
||||||
|
|
||||||
: implementors* ( classes -- words )
|
: implementors* ( classes -- words )
|
||||||
all-words [
|
all-words [
|
||||||
|
@ -149,16 +154,12 @@ M: assoc update-methods ( assoc -- )
|
||||||
make-generic
|
make-generic
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
GENERIC: subwords ( word -- seq )
|
|
||||||
|
|
||||||
M: word subwords drop f ;
|
|
||||||
|
|
||||||
M: generic subwords
|
M: generic subwords
|
||||||
dup "methods" word-prop values
|
dup "methods" word-prop values
|
||||||
swap "default-method" word-prop add ;
|
swap "default-method" word-prop add ;
|
||||||
|
|
||||||
M: generic forget-word
|
M: generic forget-word
|
||||||
dup subwords [ forget-word ] each (forget-word) ;
|
dup subwords [ forget ] each (forget-word) ;
|
||||||
|
|
||||||
: xref-generics ( -- )
|
: xref-generics ( -- )
|
||||||
all-words [ subwords [ xref ] each ] each ;
|
all-words [ subwords [ xref ] each ] each ;
|
||||||
|
|
|
@ -397,35 +397,47 @@ IN: parser.tests
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
[
|
||||||
<string-reader> "redefining-a-class-5" parse-stream drop
|
"redefining-a-class-5" forget-source
|
||||||
|
"redefining-a-class-6" forget-source
|
||||||
|
"redefining-a-class-7" forget-source
|
||||||
|
] with-compilation-unit
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
2 [
|
||||||
|
[ ] [
|
||||||
|
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
||||||
|
<string-reader> "redefining-a-class-5" parse-stream drop
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
"IN: parser.tests M: f foo ;"
|
"IN: parser.tests M: f foo ;"
|
||||||
<string-reader> "redefining-a-class-6" parse-stream drop
|
<string-reader> "redefining-a-class-6" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
||||||
<string-reader> "redefining-a-class-5" parse-stream drop
|
<string-reader> "redefining-a-class-5" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
"IN: parser.tests TUPLE: foo ; GENERIC: foo"
|
||||||
<string-reader> "redefining-a-class-7" parse-stream drop
|
<string-reader> "redefining-a-class-7" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ ] [
|
[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
"IN: parser.tests TUPLE: foo ;"
|
"IN: parser.tests TUPLE: foo ;"
|
||||||
<string-reader> "redefining-a-class-7" parse-stream drop
|
<string-reader> "redefining-a-class-7" parse-stream drop
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
[ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
|
[ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
|
||||||
|
] times
|
||||||
|
|
||||||
[ "resource:core/parser/test/assert-depth.factor" run-file ]
|
[ "resource:core/parser/test/assert-depth.factor" run-file ]
|
||||||
[ relative-overflow-stack { 1 2 3 } sequence= ]
|
[ relative-overflow-stack { 1 2 3 } sequence= ]
|
||||||
|
|
|
@ -317,3 +317,15 @@ unit-test
|
||||||
[ ] [ 1 \ + curry unparse drop ] unit-test
|
[ ] [ 1 \ + curry unparse drop ] unit-test
|
||||||
|
|
||||||
[ ] [ 1 \ + compose unparse drop ] unit-test
|
[ ] [ 1 \ + compose unparse drop ] unit-test
|
||||||
|
|
||||||
|
GENERIC: generic-see-test-with-f ( obj -- obj )
|
||||||
|
|
||||||
|
M: f generic-see-test-with-f ;
|
||||||
|
|
||||||
|
[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
|
||||||
|
[ { POSTPONE: f generic-see-test-with-f } see ] with-string-writer
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "USING: prettyprint.tests ;\nM: f generic-see-test-with-f ;\n" ] [
|
||||||
|
[ \ f \ generic-see-test-with-f method see ] with-string-writer
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -172,13 +172,13 @@ M: hook-generic synopsis*
|
||||||
stack-effect. ;
|
stack-effect. ;
|
||||||
|
|
||||||
M: method-spec synopsis*
|
M: method-spec synopsis*
|
||||||
dup definer. [ pprint-word ] each ;
|
first2 method synopsis* ;
|
||||||
|
|
||||||
M: method-body synopsis*
|
M: method-body synopsis*
|
||||||
dup dup
|
dup dup
|
||||||
definer.
|
definer.
|
||||||
"method-class" word-prop pprint*
|
"method-class" word-prop pprint-word
|
||||||
"method-generic" word-prop pprint* ;
|
"method-generic" word-prop pprint-word ;
|
||||||
|
|
||||||
M: mixin-instance synopsis*
|
M: mixin-instance synopsis*
|
||||||
dup definer.
|
dup definer.
|
||||||
|
|
|
@ -169,7 +169,12 @@ SYMBOL: changed-words
|
||||||
"declared-effect" "constructor-quot" "delimiter"
|
"declared-effect" "constructor-quot" "delimiter"
|
||||||
} reset-props ;
|
} reset-props ;
|
||||||
|
|
||||||
|
GENERIC: subwords ( word -- seq )
|
||||||
|
|
||||||
|
M: word subwords drop f ;
|
||||||
|
|
||||||
: reset-generic ( word -- )
|
: reset-generic ( word -- )
|
||||||
|
dup subwords [ forget ] each
|
||||||
dup reset-word
|
dup reset-word
|
||||||
{ "methods" "combination" "default-method" } reset-props ;
|
{ "methods" "combination" "default-method" } reset-props ;
|
||||||
|
|
||||||
|
|
|
@ -150,7 +150,8 @@ SYMBOL: event-stream-callbacks
|
||||||
: event-stream-counter \ event-stream-counter counter ;
|
: event-stream-counter \ event-stream-counter counter ;
|
||||||
|
|
||||||
[
|
[
|
||||||
H{ } clone event-stream-callbacks set-global
|
event-stream-callbacks global
|
||||||
|
[ [ drop expired? not ] assoc-subset ] change-at
|
||||||
1 \ event-stream-counter set-global
|
1 \ event-stream-counter set-global
|
||||||
] "core-foundation" add-init-hook
|
] "core-foundation" add-init-hook
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue