From be3eebf719b484e78d95d3ac029964a07dd89aed Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 4 Oct 2011 10:40:48 -0700 Subject: [PATCH] Document reset-class, forget-class, forget-method. Use lookup-method in see, fix gpu.render for method->lookup-method renaming. Fixes #232. --- basis/classes/struct/struct-tests.factor | 12 +++++++++++- basis/classes/struct/struct.factor | 9 +-------- basis/see/see.factor | 2 +- core/classes/classes-docs.factor | 17 ++++++++++++++++- core/classes/tuple/tuple-tests.factor | 10 ++++++++++ core/classes/tuple/tuple.factor | 13 ++++++++----- extra/gpu/render/render.factor | 2 +- 7 files changed, 48 insertions(+), 17 deletions(-) diff --git a/basis/classes/struct/struct-tests.factor b/basis/classes/struct/struct-tests.factor index 40fbf026e3..524875ecd0 100644 --- 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 f16b4be1d8..49b338f404 100644 --- 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 839e7a5d05..df6eac1cca 100644 --- 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 1c5bec6716..50d2dc5e7b 100644 --- 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 5132f1f027..48db064cf8 100644 --- 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 f542fbe7fd..0d36f90908 100644 --- 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 72880a39f4..defede8a1e 100755 --- 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 ;