Merge branch 'master' of git://factorcode.org/git/factor

core/generic/generic-tests.factor

@@ -238,3 +238,31 @@ M: sequence generic-forget-test-2 = ;
     \ = usage [ word? ] subset
     [ word-name "generic-forget-test-2/sequence" = ] contains?
 ] 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

core/generic/generic.factor

@@ -104,20 +104,25 @@ M: method-spec definition
     first2 method definition ;
 
 : forget-method ( class generic -- )
-    check-method
-    [ delete-at* ] with-methods
-    [ forget-word ] [ drop ] if ;
+    dup generic? [
+        [ delete-at* ] with-methods
+        [ forget-word ] [ drop ] if
+    ] [
+        2drop
+    ] if ;
 
 M: method-spec forget*
-    first2 forget-method ;
+    first2 method forget* ;
 
 M: method-body definer
     drop \ M: \ ; ;
 
 M: method-body forget*
-    dup "method-class" word-prop
-    swap "method-generic" word-prop
-    forget-method ;
+    dup "forgotten" word-prop [ drop ] [
+        dup "method-class" word-prop
+        over "method-generic" word-prop forget-method
+        t "forgotten" set-word-prop
+    ] if ;
 
 : implementors* ( classes -- words )
     all-words [
@@ -149,16 +154,12 @@ M: assoc update-methods ( assoc -- )
         make-generic
     ] if ;
 
-GENERIC: subwords ( word -- seq )
-
-M: word subwords drop f ;
-
 M: generic subwords
     dup "methods" word-prop values
     swap "default-method" word-prop add ;
 
 M: generic forget-word
-    dup subwords [ forget-word ] each (forget-word) ;
+    dup subwords [ forget ] each (forget-word) ;
 
 : xref-generics ( -- )
     all-words [ subwords [ xref ] each ] each ;

core/parser/parser-tests.factor

@@ -397,35 +397,47 @@ IN: parser.tests
 ] 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
 
-[ ] [
-    "IN: parser.tests M: f foo ;"
-    <string-reader> "redefining-a-class-6" parse-stream drop
-] unit-test
+2 [
+    [ ] [
+        "IN: parser.tests TUPLE: foo ; GENERIC: foo"
+        <string-reader> "redefining-a-class-5" parse-stream drop
+    ] unit-test
 
-[ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
+    [ ] [
+        "IN: parser.tests M: f foo ;"
+        <string-reader> "redefining-a-class-6" parse-stream drop
+    ] unit-test
 
-[ ] [
-    "IN: parser.tests TUPLE: foo ; GENERIC: foo"
-    <string-reader> "redefining-a-class-5" parse-stream drop
-] 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"
+        <string-reader> "redefining-a-class-5" parse-stream drop
+    ] unit-test
 
-[ ] [
-    "IN: parser.tests TUPLE: foo ; GENERIC: foo"
+    [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
+
+    [ ] [
+        "IN: parser.tests TUPLE: foo ; GENERIC: foo"
     <string-reader> "redefining-a-class-7" parse-stream drop
-] unit-test
+    ] unit-test
 
-[ ] [
-    "IN: parser.tests TUPLE: foo ;"
-    <string-reader> "redefining-a-class-7" parse-stream drop
-] unit-test
+    [ f ] [ f "foo" "parser.tests" lookup execute ] unit-test
 
-[ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
+    [ ] [
+        "IN: parser.tests TUPLE: foo ;"
+        <string-reader> "redefining-a-class-7" parse-stream drop
+    ] unit-test
+
+    [ t ] [ "foo" "parser.tests" lookup symbol? ] unit-test
+] times
 
 [ "resource:core/parser/test/assert-depth.factor" run-file ]
 [ relative-overflow-stack { 1 2 3 } sequence= ]

core/prettyprint/prettyprint-tests.factor

@@ -317,3 +317,15 @@ unit-test
 [ ] [ 1 \ + curry 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

core/prettyprint/prettyprint.factor

@@ -172,13 +172,13 @@ M: hook-generic synopsis*
     stack-effect. ;
 
 M: method-spec synopsis*
-    dup definer. [ pprint-word ] each ;
+    first2 method synopsis* ;
 
 M: method-body synopsis*
     dup dup
     definer.
-    "method-class" word-prop pprint*
-    "method-generic" word-prop pprint* ;
+    "method-class" word-prop pprint-word
+    "method-generic" word-prop pprint-word ;
 
 M: mixin-instance synopsis*
     dup definer.

core/words/words.factor

@@ -169,7 +169,12 @@ SYMBOL: changed-words
         "declared-effect" "constructor-quot" "delimiter"
     } reset-props ;
 
+GENERIC: subwords ( word -- seq )
+
+M: word subwords drop f ;
+
 : reset-generic ( word -- )
+    dup subwords [ forget ] each
     dup reset-word
     { "methods" "combination" "default-method" } reset-props ;
 

extra/core-foundation/fsevents/fsevents.factor

@@ -150,7 +150,8 @@ SYMBOL: event-stream-callbacks
 : 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
 ] "core-foundation" add-init-hook