Document reset-class, forget-class, forget-method. Use lookup-method in see, fix...

diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor
index 40fbf026e37408adba8289cda1fdfe9822054039..524875ecd0b9655f0c6d9fde289dd8b1ee41d234 100644 (file)
--- a/basis/classes/struct/struct-tests.factor
+++ b/basis/classes/struct/struct-tests.factor
@@ -8,7 +8,7 @@ destructors io.encodings.utf8 io.pathnames io.streams.string
 kernel libc literals math mirrors namespaces prettyprint
 prettyprint.config see sequences specialized-arrays system
 tools.test parser lexer eval layouts generic.single classes
-vocabs generic ;
+vocabs generic classes.private ;
 FROM: math => float ;
 FROM: specialized-arrays.private => specialized-array-vocab ;
 QUALIFIED-WITH: alien.c-types c
@@ -543,3 +543,13 @@ STRUCT: going-to-redefine { a uint } ;
 [ f ] [ \ going-to-redefine \ clone ?lookup-method ] unit-test
 [ f ] [ \ going-to-redefine \ struct-slot-values ?lookup-method ] unit-test
 
+! Test reset-class on structs, which should forget all the accessors, clone, and struct-slot-values
+STRUCT: some-accessors { aaa uint } { bbb int } ;
+[ ] [ [ \ some-accessors reset-class ] with-compilation-unit ] unit-test
+[ f ] [ \ some-accessors \ a>> ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ a<< ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ b>> ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ b<< ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ clone ?lookup-method ] unit-test
+[ f ] [ \ some-accessors \ struct-slot-values ?lookup-method ] unit-test
+

diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor
index f16b4be1d8c30e7519f86a042735188812562877..49b338f404ce14c703db3d93e9b092b7726d93e0 100644 (file)
--- a/basis/classes/struct/struct.factor
+++ b/basis/classes/struct/struct.factor
@@ -321,16 +321,9 @@ ERROR: invalid-struct-slot token ;
     c-type c-type-boxed-class
     dup \ byte-array = [ drop \ c-ptr ] when ;
 
-: forget-struct-accessors ( class -- )
-    dup "c-type" word-prop fields>> [
-        name>>
-        [ reader-word ?lookup-method forget ]
-        [ writer-word ?lookup-method forget ] 2bi
-    ] with each ;
-
 M: struct-class reset-class
     {
-        [ forget-struct-accessors ]
+        [ dup "c-type" word-prop fields>> forget-struct-slot-accessors ]
         [
             [ forget-struct-slot-values-method ]
             [ forget-clone-method ] bi

diff --git a/basis/see/see.factor b/basis/see/see.factor
index 839e7a5d0522831a99daf4f38c55653c2e4374d6..df6eac1cca0bcf6f92195f509b05513e5a34ecf5 100644 (file)
--- a/basis/see/see.factor
+++ b/basis/see/see.factor
@@ -224,7 +224,7 @@ M: word see*
 : seeing-implementors ( class -- seq )
     dup implementors
     [ [ reader? ] [ writer? ] bi or not ] filter
-    [ ?lookup-method ] with map
+    [ lookup-method ] with map
     natural-sort ;
 
 : seeing-methods ( generic -- seq )

diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor
index 1c5bec67161b23c4146b6b2ff20d4e61e0f78e99..50d2dc5e7b4494129193d559ab196f704a03f4ba 100644 (file)
--- a/core/classes/classes-docs.factor
+++ b/core/classes/classes-docs.factor
@@ -19,7 +19,9 @@ $nl
     predicate
     predicate?
 }
-"A predicate word holds a reference to the class it is predicating over in the " { $snippet "\"predicating\"" } " word property." ;
+"A predicate word holds a reference to the class it is predicating over in the " { $snippet "\"predicating\"" } " word property." $nl
+"Implementation of class reloading:"
+{ $subsections reset-class forget-class forget-methods } ;
 
 ARTICLE: "classes" "Classes"
 "Conceptually, a " { $snippet "class" } " is a set of objects whose members can be identified with a predicate, and on which generic words can specialize methods. Classes are organized into a general partial order, and an object may be an instance of more than one class."
@@ -151,3 +153,16 @@ HELP: instance?
      { "object" object } { "class" class }
      { "?" "a boolean" } }
 { $description "Tests whether the input object is a member of the class." } ;
+
+HELP: reset-class
+{ $values { "class" class } }
+{ $description "Forgets all of words that the class defines, but not words that are defined on the class. For instance, on a tuple class, this word should reset all of the tuple accessors but not things like " { $link nth } " that may be defined on the class elsewhere." } ;
+
+HELP: forget-class
+{ $values { "class" class } }
+{ $description "Removes a class by forgetting all of the methods defined on that class and all of the methods generated when that class was defined. Also resets any caches that may contain that class." } ;
+
+HELP: forget-methods
+{ $values { "class" class } }
+{ $description "Forgets all methods defined on a class. In contrast to " { $link reset-class } ", this not only forgets accessors but also any methods at all on the class." } ;
+

diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor
index 5132f1f027778e236c38e7539fa6db7ce1042167..48db064cf8400608c0c8e3f8ade67a43aeb73719 100644 (file)
--- a/core/classes/tuple/tuple-tests.factor
+++ b/core/classes/tuple/tuple-tests.factor
@@ -807,3 +807,13 @@ TUPLE: final-subclass < final-superclass ;
 [ ] [ "IN: classes.tuple.tests TUPLE: final-superclass x ;" eval( -- ) ] unit-test
 
 [ t ] [ \ final-subclass final-class? ] unit-test
+
+! Test reset-class on tuples
+! Should forget all accessors on rclasstest
+TUPLE: rclasstest a b ;
+[ ] [ [ \ rclasstest reset-class ] with-compilation-unit ] unit-test
+[ f ] [ \ rclasstest \ a>> ?lookup-method ] unit-test
+[ f ] [ \ rclasstest \ a<< ?lookup-method ] unit-test
+[ f ] [ \ rclasstest \ b>> ?lookup-method ] unit-test
+[ f ] [ \ rclasstest \ b<< ?lookup-method ] unit-test
+

diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor
index f542fbe7fdbe3c80e4f6933e88f791b568037884..0d36f90908faea3084e1f38366459396bb2313a6 100644 (file)
--- a/core/classes/tuple/tuple.factor
+++ b/core/classes/tuple/tuple.factor
@@ -315,13 +315,16 @@ M: error-class reset-class
 : define-boa-word ( word class -- )
     [ [ boa ] curry ] [ boa-effect ] bi define-inline ;
 
+: forget-struct-slot-accessors ( class slots -- )
+    [
+        name>>
+        [ reader-word ?lookup-method forget ]
+        [ writer-word ?lookup-method forget ] 2bi
+    ] with each ;
+
 M: tuple-class reset-class
     [
-        dup "slots" word-prop [
-            name>>
-            [ reader-word ?lookup-method forget ]
-            [ writer-word ?lookup-method forget ] 2bi
-        ] with each
+        dup "slots" word-prop forget-struct-slot-accessors
     ] [
         [ call-next-method ]
         [ { "layout" "slots" "boa-check" "prototype" "final" } reset-props ]

diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor
index 72880a39f4959919f8aec0f64caa82a448a0f32f..defede8a1e226be4d8f843ca679000706a739708 100755 (executable)
--- a/extra/gpu/render/render.factor
+++ b/extra/gpu/render/render.factor
@@ -491,7 +491,7 @@ DEFER: [bind-uniform-tuple]
 
 :: [bind-uniforms] ( superclass uniforms -- quot )
     superclass "uniform-tuple-texture-units" word-prop 0 or :> first-texture-unit
-    superclass \ (bind-uniforms) method :> next-method
+    superclass \ (bind-uniforms) lookup-method :> next-method
     first-texture-unit uniforms "" [bind-uniform-tuple] nip :> bind-quot
 
     { 2dup next-method } bind-quot [ ] append-as ;