]> gitweb.factorcode.org Git - factor.git/commitdiff
Rename class to class-of
authorDoug Coleman <doug.coleman@gmail.com>
Mon, 24 Oct 2011 11:47:42 +0000 (06:47 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Mon, 24 Oct 2011 11:47:42 +0000 (06:47 -0500)
32 files changed:
basis/bootstrap/compiler/compiler.factor
basis/bootstrap/image/image.factor
basis/classes/struct/prettyprint/prettyprint.factor
basis/classes/struct/struct.factor
basis/compiler/cfg/stacks/uninitialized/uninitialized.factor
basis/compiler/codegen/codegen.factor
basis/compiler/tree/escape-analysis/check/check.factor
basis/compiler/tree/escape-analysis/simple/simple.factor
basis/compiler/tree/propagation/info/info.factor
basis/compiler/tree/propagation/slots/slots.factor
basis/debugger/debugger.factor
basis/hints/hints.factor
basis/io/sockets/sockets.factor
basis/locals/rewrite/sugar/sugar.factor
basis/mirrors/mirrors.factor
basis/peg/peg.factor
basis/prettyprint/backend/backend.factor
basis/summary/summary.factor
basis/tools/destructors/destructors.factor
basis/tools/memory/memory.factor
basis/ui/gadgets/buttons/buttons.factor
basis/ui/gestures/gestures.factor
basis/ui/pixel-formats/pixel-formats.factor
basis/ui/tools/browser/browser.factor
basis/ui/tools/common/common.factor
basis/ui/tools/inspector/inspector.factor
core/classes/builtin/builtin.factor
core/classes/classes-docs.factor
core/classes/classes.factor
core/classes/tuple/tuple-tests.factor
core/classes/tuple/tuple.factor
core/generic/math/math.factor

index 0e88acb4c89eeecf5046683e22a773938f125050..1c493b0730bda80817d69818a60633ee2d8d420f 100644 (file)
@@ -94,7 +94,7 @@ gc
 
     {
         member-eq? split harvest sift cut cut-slice start index clone
-        set-at reverse push-all class number>string string>number
+        set-at reverse push-all class-of number>string string>number
         like clone-like
     } compile-unoptimized
 
index ca6535206540bad8b1fba840b7c1e4a9903ca860..dc1cbc1d6542a093d43485b4783a94c5ced8955c 100755 (executable)
@@ -48,7 +48,7 @@ M: eql-wrapper hashcode* obj>> hashcode* ;
 GENERIC: (eql?) ( obj1 obj2 -- ? )
 
 : eql? ( obj1 obj2 -- ? )
-    { [ [ class ] bi@ = ] [ (eql?) ] } 2&& ;
+    { [ [ class-of ] bi@ = ] [ (eql?) ] } 2&& ;
 
 M: fixnum (eql?) eq? ;
 
@@ -440,11 +440,11 @@ ERROR: tuple-removed class ;
 
 : (emit-tuple) ( tuple -- pointer )
     [ tuple-slots ]
-    [ class transfer-word require-tuple-layout ] bi prefix [ ' ] map
+    [ class-of transfer-word require-tuple-layout ] bi prefix [ ' ] map
     tuple [ emit-seq ] emit-object ;
 
 : emit-tuple ( tuple -- pointer )
-    dup class name>> "tombstone" =
+    dup class-of name>> "tombstone" =
     [ [ (emit-tuple) ] cache-eql-object ]
     [ [ (emit-tuple) ] cache-eq-object ]
     if ;
index 2d7998135fbe261677e1638ae075fb0967b87810..64d2dfa70c79fad863b14709b92f5ab971c6e9b6 100644 (file)
@@ -19,7 +19,7 @@ IN: classes.struct.prettyprint
     } cond ;
 
 : struct>assoc ( struct -- assoc )
-    [ class struct-slots ] [ struct-slot-values ] bi zip ;
+    [ class-of struct-slots ] [ struct-slot-values ] bi zip ;
 
 : pprint-struct-slot ( slot -- )
     <flow \ { pprint-word
@@ -39,13 +39,13 @@ IN: classes.struct.prettyprint
 : pprint-struct ( struct -- )
     [
         [ \ S{ ] dip
-        [ class ]
+        [ class-of ]
         [ struct>assoc [ [ name>> ] dip ] assoc-map ] bi
         \ } (pprint-tuple)
     ] ?pprint-tuple ;
 
 : pprint-struct-pointer ( struct -- )
-    \ S@ [ [ class pprint-word ] [ >c-ptr pprint* ] bi ] pprint-prefix ;
+    \ S@ [ [ class-of pprint-word ] [ >c-ptr pprint* ] bi ] pprint-prefix ;
 
 PRIVATE>
 
@@ -58,7 +58,7 @@ M: struct pprint-delims
     drop \ S{ \ } ;
 
 M: struct >pprint-sequence
-    [ class ] [ struct-slot-values ] bi class-slot-sequence ;
+    [ class-of ] [ struct-slot-values ] bi class-slot-sequence ;
 
 M: struct pprint*
     [ pprint-struct ]
@@ -66,7 +66,7 @@ M: struct pprint*
 
 M: struct summary
     [
-        dup class name>> %
+        dup class-of name>> %
         " struct of " %
         byte-length #
         " bytes " %
@@ -76,19 +76,19 @@ TUPLE: struct-mirror { object read-only } ;
 C: <struct-mirror> struct-mirror
 
 : get-struct-slot ( struct slot -- value present? )
-    over class struct-slots slot-named
+    over class-of struct-slots slot-named
     [ name>> reader-word execute( struct -- value ) t ]
     [ drop f f ] if* ;
 : set-struct-slot ( value struct slot -- )
-    over class struct-slots slot-named
+    over class-of struct-slots slot-named
     [ name>> writer-word execute( value struct -- ) ]
     [ 2drop ] if* ;
 : reset-struct-slot ( struct slot -- )
-    over class struct-slots slot-named
+    over class-of struct-slots slot-named
     [ [ initial>> swap ] [ name>> writer-word ] bi execute( value struct -- ) ]
     [ drop ] if* ;
 : reset-struct-slots ( struct -- )
-    dup class struct-prototype
+    dup class-of struct-prototype
     dup byte-length memcpy ;
 
 M: struct-mirror at*
index ec29e0b262e2f1bbd9d4de24ab2d28e4c1b26171..1fe2c573d3db5c5ca29def619326278b81024722 100644 (file)
@@ -52,7 +52,7 @@ M: struct >c-ptr
 
 M: struct equal?
     over struct? [
-        2dup [ class ] bi@ = [
+        2dup [ class-of ] bi@ = [
             2dup [ >c-ptr ] both?
             [ [ >c-ptr ] [ binary-object ] bi* memory= ]
             [ [ >c-ptr not ] both? ]
@@ -247,7 +247,7 @@ M: struct-bit-slot-spec compute-slot-offset
 
 PRIVATE>
 
-M: struct byte-length class "struct-size" word-prop ; foldable
+M: struct byte-length class-of "struct-size" word-prop ; foldable
 M: struct binary-zero? binary-object uchar <c-direct-array> [ 0 = ] all? ; inline
 
 ! class definition
index eadfe0aa9152b4823049322f57cf37e5a4aa19d4..025541e1f305173fa303ed708d6b990a72145e78 100644 (file)
@@ -39,13 +39,13 @@ M: ##inc-r visit-insn n>> rs-loc handle-inc ;
 ERROR: uninitialized-peek insn ;
 
 : visit-peek ( ##peek -- )
-    dup loc>> [ n>> ] [ class get ] bi ?nth 0 =
+    dup loc>> [ n>> ] [ class-of get ] bi ?nth 0 =
     [ uninitialized-peek ] [ drop ] if ; inline
 
 M: ##peek visit-insn visit-peek ;
 
 : visit-replace ( ##replace -- )
-    loc>> [ n>> ] [ class get ] bi
+    loc>> [ n>> ] [ class-of get ] bi
     2dup length < [ [ 1 ] 2dip set-nth ] [ 2drop ] if ;
 
 M: ##replace visit-insn visit-replace ;
index 69fd37abb8f9284ad6f01fd5ae72c212b798f9bb..53fdb458c6a89a2632a0a96c57ee8f24f19913b9 100755 (executable)
@@ -77,7 +77,7 @@ M: ##dispatch generate-insn
     [ lookup-label resolve-label ]
     [
         instructions>> [
-            [ class insn-counts get inc-at ]
+            [ class-of insn-counts get inc-at ]
             [ generate-insn ]
             bi
         ] each
index 4679dfe3424c54e6b87b0997777fdd4b63b9fb9b..e8a96c62f9b1d1a3618d9c554a7a1cef42c619a4 100644 (file)
@@ -18,7 +18,7 @@ GENERIC: run-escape-analysis* ( node -- ? )
     { [ unbox-inputs? ] [ [ run-escape-analysis* ] any? ] } 1|| ;
 
 M: #push run-escape-analysis*
-    literal>> class immutable-tuple-class? ;
+    literal>> class-of immutable-tuple-class? ;
 
 M: #call run-escape-analysis*
     immutable-tuple-boa? ;
index ecdd10fee728f9fdd88723660a7aeaace7a93522..9a3d53d6755d6ed7dbc6a13a2e1d9de758c7d57e 100644 (file)
@@ -39,7 +39,7 @@ DEFER: record-literal-allocation
 
 : object-slots ( object -- slots/f )
     {
-        { [ dup class immutable-tuple-class? ] [ tuple-slots ] }
+        { [ dup class-of immutable-tuple-class? ] [ tuple-slots ] }
         [ drop f ]
     } cond ;
 
index 22ea1306d67bf2393ff7db5fb372c2bb011eae23..8f0fed8c2451803fce18e62ede5bb8fd997af02d 100644 (file)
@@ -57,7 +57,7 @@ CONSTANT: object-info T{ value-info f object full-interval }
 DEFER: <literal-info>
 
 : tuple-slot-infos ( tuple -- slots )
-    [ tuple-slots ] [ class all-slots ] bi
+    [ tuple-slots ] [ class-of all-slots ] bi
     [ read-only>> [ <literal-info> ] [ drop f ] if ] 2map
     f prefix ;
 
@@ -66,7 +66,7 @@ UNION: fixed-length array byte-array string ;
 : literal-class ( obj -- class )
     #! Handle forgotten tuples and singleton classes properly
     dup singleton-class? [
-        class dup class? [
+        class-of dup class? [
             drop tuple
         ] unless
     ] unless ;
@@ -75,7 +75,7 @@ UNION: fixed-length array byte-array string ;
     "slots" word-prop length 1 - f <array> swap prefix ;
 
 : slots-with-length ( seq -- slots )
-    [ length <literal-info> ] [ class ] bi (slots-with-length) ;
+    [ length <literal-info> ] [ class-of ] bi (slots-with-length) ;
 
 : init-literal-info ( info -- info )
     empty-interval >>interval
index 14546f0237dca9926e8f175536847086cd47ca6c..22feb3382a714fd546e9ff98e396181f4705e364 100644 (file)
@@ -60,7 +60,7 @@ IN: compiler.tree.propagation.slots
     #! heap would use the old layout since instances are updated
     #! immediately after compilation.
     {
-        [ class read-only-slot? ]
+        [ class-of read-only-slot? ]
         [ nip layout-up-to-date? ]
         [ swap slot <literal-info> ]
     } 2&& ;
index 1edc04c42dc8387f136b0867a3ff105cbb374da9..b193d5080cd0bec1796326e7f1389fff0e996196 100755 (executable)
@@ -17,7 +17,7 @@ GENERIC: error-help ( error -- topic )
 
 M: object error-help drop f ;
 
-M: tuple error-help class ;
+M: tuple error-help class-of ;
 
 M: source-file-error error-help error>> error-help ;
 
@@ -89,7 +89,7 @@ M: string error. print ;
 : type-check-error. ( obj -- )
     "Type check error" print
     "Object: " write dup fourth short.
-    "Object type: " write dup fourth class .
+    "Object type: " write dup fourth class-of .
     "Expected type: " write third type>class . ;
 
 : divide-by-zero-error. ( obj -- )
@@ -176,7 +176,7 @@ M: no-method error.
     "Generic word " write
     dup generic>> pprint
     " does not define a method for the " write
-    dup object>> class pprint
+    dup object>> class-of pprint
     " class." print
     "Dispatching on object: " write object>> short. ;
 
index abfb3199a2989574f3a1fc0546cc9a7d942c5310..413922b71ff100c455285cf2f67ed7bf12fd6cf8 100644 (file)
@@ -18,7 +18,7 @@ GENERIC: specializer-declaration ( spec -- class )
 
 M: class specializer-declaration ;
 
-M: object specializer-declaration class ;
+M: object specializer-declaration class-of ;
 
 : specializer ( word -- specializer )
     "specializer" word-prop ;
index 6f1504b6158a5b4c26f2e2f0ebf93251bb2bc964..618491a72343ea5660d994953ffb657b2d359b31 100644 (file)
@@ -288,8 +288,8 @@ HOOK: (receive-unsafe) io-backend ( n buf datagram -- size addrspec )
 ERROR: invalid-port object ;
 
 : check-port ( packet addrspec port -- packet addrspec port )
-    2dup addr>> [ class ] bi@ assert=
-    pick class byte-array assert= ;
+    2dup addr>> [ class-of ] bi@ assert=
+    pick class-of byte-array assert= ;
 
 : check-connectionless-port ( port -- port )
     dup { [ datagram-port? ] [ raw-port? ] } 1|| [ invalid-port ] unless ;
index 110cc6ad81db7249dba9ccb2b2aacd274b2b456a..6689f959e757931b3f792770b1c44d02f892e1ee 100644 (file)
@@ -66,7 +66,7 @@ M: hashtable rewrite-element
 
 M: tuple rewrite-element
     dup rewrite-literal? [
-        [ tuple-slots rewrite-elements ] [ class ] bi '[ _ boa ] %
+        [ tuple-slots rewrite-elements ] [ class-of ] bi '[ _ boa ] %
     ] [ , ] if ;
 
 M: quotation rewrite-element rewrite-sugar* ;
index 819c3aa087f680fba1469434e12ca6dc701851d1..07b2945e694675d77f19fb1bd6db41eb447d01cb 100644 (file)
@@ -10,7 +10,7 @@ TUPLE: mirror { object read-only } ;
 
 C: <mirror> mirror
 
-: object-slots ( mirror -- slots ) object>> class all-slots ; inline
+: object-slots ( mirror -- slots ) object>> class-of all-slots ; inline
 
 M: mirror at*
     [ nip object>> ] [ object-slots slot-named ] 2bi
index 2714e8e56f2676656ac0cd763cc89f5ae239fb43..74ce0b033778b853ac0849b18eb95ade7a925f59 100644 (file)
@@ -12,7 +12,7 @@ TUPLE: parse-result remaining ast ;
 TUPLE: parse-error position messages ; 
 TUPLE: parser peg compiled id ;
 
-M: parser equal?    { [ [ class ] bi@ = ] [ [ id>> ] bi@ = ] } 2&& ;
+M: parser equal?    { [ [ class-of ] bi@ = ] [ [ id>> ] bi@ = ] } 2&& ;
 M: parser hashcode* id>> hashcode* ;
 
 C: <parse-result> parse-result
index 09d93a03346daf59616b3a61fd893263aeba87e6..d4840b20a4f8b37817c9c6adb616aab267d4ee95 100644 (file)
@@ -117,7 +117,7 @@ M: pathname pprint*
 : check-recursion ( obj quot -- )
     nesting-limit? [
         drop
-        [ class name>> "~" dup surround ] keep present-text 
+        [ class-of name>> "~" dup surround ] keep present-text 
     ] [
         over recursion-check get member-eq? [
             drop "~circularity~" swap present-text
@@ -133,7 +133,7 @@ M: pathname pprint*
     [ [ name>> ] dip ] assoc-map ;
 
 : tuple>assoc ( tuple -- assoc )
-    [ class all-slots ] [ tuple-slots ] bi zip filter-tuple-assoc ;
+    [ class-of all-slots ] [ tuple-slots ] bi zip filter-tuple-assoc ;
 
 : pprint-slot-value ( name value -- )
     <flow \ { pprint-word
@@ -152,7 +152,7 @@ M: pathname pprint*
     [ boa-tuples? get [ pprint-object ] ] dip [ check-recursion ] curry if ; inline
 
 : pprint-tuple ( tuple -- )
-    [ [ \ T{ ] dip [ class ] [ tuple>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ;
+    [ [ \ T{ ] dip [ class-of ] [ tuple>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ;
 
 M: tuple pprint*
     pprint-tuple ;
@@ -203,7 +203,7 @@ M: hash-set >pprint-sequence members ;
     [ 1array ] [ [ f 2array ] dip append ] if-empty ;
 
 M: tuple >pprint-sequence
-    [ class ] [ tuple-slots ] bi class-slot-sequence ;
+    [ class-of ] [ tuple-slots ] bi class-slot-sequence ;
 
 M: object pprint-narrow? drop f ;
 M: byte-vector pprint-narrow? drop f ;
index 2737ecec6c21ff3d13d969742736a90dda2e25f2..e67be479ae639058d5e64a930f8f5d5089b48859 100644 (file)
@@ -7,13 +7,13 @@ IN: summary
 GENERIC: summary ( object -- string )
 
 : object-summary ( object -- string )
-    class name>> ;
+    class-of name>> ;
 
 M: object summary object-summary ;
 
 M: sequence summary
     [
-        dup class name>> %
+        dup class-of name>> %
         " with " %
         length #
         " elements" %
@@ -21,7 +21,7 @@ M: sequence summary
 
 M: assoc summary
     [
-        dup class name>> %
+        dup class-of name>> %
         " with " %
         assoc-size #
         " entries" %
index 42d09d0ef9ed6926b9b7c66635ea3fb24dbd9ba6..a8a1b35e8764ac86fd046ebee158e047a84e3a62 100644 (file)
@@ -8,7 +8,7 @@ IN: tools.destructors
 <PRIVATE
 
 : class-tally ( assoc -- assoc' )
-    H{ } clone [ [ keys ] dip '[ dup class _ push-at ] each ] keep ;
+    H{ } clone [ [ keys ] dip '[ dup class-of _ push-at ] each ] keep ;
 
 : (disposables.) ( assoc -- )
     class-tally >alist [ first2 [ length ] keep 3array ] map [ second ] sort-with
index 04e8c47d4f011709415b9154833cdb7b5d9b1ac2..dbeb46493493b4e1656a8475ef3cbf305f1bb792 100644 (file)
@@ -72,8 +72,8 @@ PRIVATE>
 <PRIVATE
 
 : heap-stat-step ( obj counts sizes -- )
-    [ [ class ] dip inc-at ]
-    [ [ [ size ] [ class ] bi ] dip at+ ] bi-curry* bi ;
+    [ [ class-of ] dip inc-at ]
+    [ [ [ size ] [ class-of ] bi ] dip at+ ] bi-curry* bi ;
 
 PRIVATE>
 
index 44ce92ed8df302098337d5222739091db8ac728c..3217fafb521524029374cf9fa986b0b385f49fbb 100644 (file)
@@ -248,7 +248,7 @@ PRIVATE>
         1 >>fill
         { 5 5 } >>gap
         swap
-        [ [ "toolbar" ] dip class command-map commands>> ]
+        [ [ "toolbar" ] dip class-of command-map commands>> ]
         [ '[ [ _ ] 2dip <command-button> add-gadget ] ]
         bi assoc-each ;
 
index c082c0764e46570e2a2aad5b50c0780013382ca2..27d502cc24670255d21aa46d2e701bfb866bbad9 100644 (file)
@@ -10,7 +10,7 @@ FROM: sets => members ;
 IN: ui.gestures
 
 : get-gesture-handler ( gesture gadget -- quot )
-    class superclasses [ "gestures" word-prop ] map assoc-stack ;
+    class-of superclasses [ "gestures" word-prop ] map assoc-stack ;
 
 GENERIC: handle-gesture ( gesture gadget -- ? )
 
index e0cd9ede62d4701010463eb25ae6bda22127924d..12855e65baca8012cd90dad5ee5fbe5e9bf0c32b 100644 (file)
@@ -77,7 +77,7 @@ M: object >PFA
 M: word >PFA
     TABLE at [ { } ] unless* ;
 M: pixel-format-attribute >PFA
-    dup class TABLE at
+    dup class-of TABLE at
     [ swap value>> suffix ]
     [ drop { } ] if* ;
 
index 0adaa4028cdb98dfd1ed9d076e762a782375bc74..7217e4ef22ce276347f8f572118b1917ee846145 100644 (file)
@@ -97,7 +97,7 @@ M: browser-gadget focusable-child* search-field>> ;
 : error-help-window ( error -- )
     {
         [ error-help ]
-        [ dup tuple? [ class ] [ drop "errors" ] if ]
+        [ dup tuple? [ class-of ] [ drop "errors" ] if ]
     } 1|| (browser-window) ;
 
 \ browser-window H{ { +nullary+ t } } define-command
index 95af20ec72e0ea519a75e9a708b7676ae036f1be..4e307a598450b7ff6f0463fca6c3c1e6758a3af9 100644 (file)
@@ -12,11 +12,11 @@ tool-dims [ H{ } clone ] initialize
 TUPLE: tool < track ;
 
 M: tool pref-dim*
-    { [ class tool-dims get at ] [ call-next-method ] } 1|| ;
+    { [ class-of tool-dims get at ] [ call-next-method ] } 1|| ;
 
 M: tool layout*
     [ call-next-method ]
-    [ [ dim>> ] [ class ] bi tool-dims get set-at ]
+    [ [ dim>> ] [ class-of ] bi tool-dims get set-at ]
     bi ;
 
 : set-tool-dim ( dim class -- ) tool-dims get set-at ;
index 1fc1ad18601080bcb02a6dadc80c78fe6e1da313..e5d5ab5759b7e6b951d8296ca9def775be88eb78 100644 (file)
@@ -33,7 +33,7 @@ M: inspector-renderer column-titles
             [
                 [
                     [ "Class:" write ] with-cell
-                    [ class pprint ] with-cell
+                    [ class-of pprint ] with-cell
                 ] with-row
             ]
             [
index 1595816ba2b0e79c0409e44f16692a7fcbe4fc23..e5aaa3220171d309a070f60162bed8f9d0006a5d 100644 (file)
@@ -16,7 +16,7 @@ PREDICATE: builtin-class < class
 
 : bootstrap-type>class ( n -- class ) builtins get nth ;
 
-M: object class tag type>class ; inline
+M: object class-of tag type>class ; inline
 
 M: builtin-class rank-class drop 0 ;
 
index 50d2dc5e7b4494129193d559ab196f704a03f4ba..965fcdc3aedfa48e1bda4a7f94b0537642a023f9 100644 (file)
@@ -33,7 +33,7 @@ $nl
 "Classes themselves form a class:"
 { $subsections class? }
 "You can ask an object for its class:"
-{ $subsections class }
+{ $subsections class-of }
 "Testing if an object is an instance of a class:"
 { $subsections instance? }
 "You can ask a class for its superclass:"
@@ -71,11 +71,11 @@ $nl
 
 ABOUT: "classes"
 
-HELP: class
+HELP: class-of
 { $values { "object" object } { "class" class } }
 { $description "Outputs an object's canonical class. While an object may be an instance of more than one class, the canonical class is either its built-in class, or if the object is a tuple, its tuple class." }
 { $class-description "The class of all class words." }
-{ $examples { $example "USING: classes prettyprint ;" "1.0 class ." "float" } { $example "USING: classes prettyprint ;" "IN: scratchpad" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class ." "point" } } ;
+{ $examples { $example "USING: classes prettyprint ;" "1.0 class-of ." "float" } { $example "USING: classes prettyprint ;" "IN: scratchpad" "TUPLE: point x y z ;\nT{ point f 1 2 3 } class-of ." "point" } } ;
 
 HELP: classes
 { $values { "seq" "a sequence of class words" } }
index 4bbf6bc9cb63985a04028069e28d14964d01f23b..dd865861421ad160a8da1226b9a54486cdd203ae 100644 (file)
@@ -224,6 +224,6 @@ M: class metaclass-changed
 M: class forget* ( class -- )
     [ call-next-method ] [ forget-class ] bi ;
 
-GENERIC: class ( object -- class )
+GENERIC: class-of ( object -- class )
 
 GENERIC: instance? ( object class -- ? ) flushable
index bbc5004f0a0c4a6fa75cc8c9bb9d9766b084c71b..b6af0b39fb58e3a691d3edbb216443d757604da0 100644 (file)
@@ -67,7 +67,7 @@ C: <predicate-test> predicate-test
 [ t ] [ <predicate-test> predicate-test? ] unit-test
 
 PREDICATE: silly-pred < tuple
-    class \ rect = ;
+    class-of \ rect = ;
 
 GENERIC: area ( obj -- n )
 M: silly-pred area dup w>> swap h>> * ;
@@ -218,7 +218,7 @@ C: <laptop> laptop
 [ t ] [ "laptop" get tuple? ] unit-test
 
 : test-laptop-slot-values ( -- )
-    [ laptop ] [ "laptop" get class ] unit-test
+    [ laptop ] [ "laptop" get class-of ] unit-test
     [ "Pentium" ] [ "laptop" get cpu>> ] unit-test
     [ 128 ] [ "laptop" get ram>> ] unit-test
     [ t ] [ "laptop" get battery>> 3 hours = ] unit-test ;
@@ -245,7 +245,7 @@ C: <server> server
 [ t ] [ "server" get tuple? ] unit-test
 
 : test-server-slot-values ( -- )
-    [ server ] [ "server" get class ] unit-test
+    [ server ] [ "server" get class-of ] unit-test
     [ "PowerPC" ] [ "server" get cpu>> ] unit-test
     [ 64 ] [ "server" get ram>> ] unit-test
     [ "1U" ] [ "server" get rackmount>> ] unit-test ;
@@ -539,23 +539,23 @@ must-fail-with
 ! Check bignum coercer
 TUPLE: bignum-coercer { n bignum initial: $[ 0 >bignum ] } ;
 
-[ 13 bignum ] [ 13.5 bignum-coercer boa n>> dup class ] unit-test
+[ 13 bignum ] [ 13.5 bignum-coercer boa n>> dup class-of ] unit-test
 
-[ 13 bignum ] [ bignum-coercer new 13.5 >>n n>> dup class ] unit-test
+[ 13 bignum ] [ bignum-coercer new 13.5 >>n n>> dup class-of ] unit-test
 
 ! Check float coercer
 TUPLE: float-coercer { n float } ;
 
-[ 13.0 float ] [ 13 float-coercer boa n>> dup class ] unit-test
+[ 13.0 float ] [ 13 float-coercer boa n>> dup class-of ] unit-test
 
-[ 13.0 float ] [ float-coercer new 13 >>n n>> dup class ] unit-test
+[ 13.0 float ] [ float-coercer new 13 >>n n>> dup class-of ] unit-test
 
 ! Check integer coercer
 TUPLE: integer-coercer { n integer } ;
 
-[ 13 fixnum ] [ 13.5 integer-coercer boa n>> dup class ] unit-test
+[ 13 fixnum ] [ 13.5 integer-coercer boa n>> dup class-of ] unit-test
 
-[ 13 fixnum ] [ integer-coercer new 13.5 >>n n>> dup class ] unit-test
+[ 13 fixnum ] [ integer-coercer new 13.5 >>n n>> dup class-of ] unit-test
 
 : foo ( a b -- c ) declared-types boa ;
 
@@ -610,7 +610,7 @@ T{ reshape-test f "hi" } "tuple" set
 
 TUPLE: boa-coercer-test { x array-capacity } ;
 
-[ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class ] unit-test
+[ fixnum ] [ 0 >bignum boa-coercer-test boa x>> class-of ] unit-test
 
 [ T{ boa-coercer-test f 0 } ] [ T{ boa-coercer-test } ] unit-test
 
index 5eafdb0332480c880687d2ea5e796c48867156c8..7fc311de55495a797e9cab831b59b54a722a91e5 100644 (file)
@@ -27,14 +27,14 @@ PREDICATE: immutable-tuple-class < tuple-class
 : layout-of ( tuple -- layout )
     1 slot { array } declare ; inline
 
-M: tuple class layout-of 2 slot { word } declare ; inline
+M: tuple class-of layout-of 2 slot { word } declare ; inline
 
 : tuple-size ( tuple -- size )
     layout-of 3 slot { fixnum } declare ; inline
 
 : layout-up-to-date? ( object -- ? )
     dup tuple?
-    [ [ layout-of ] [ class tuple-layout ] bi eq? ] [ drop t ] if ;
+    [ [ layout-of ] [ class-of tuple-layout ] bi eq? ] [ drop t ] if ;
 
 : check-tuple ( object -- tuple )
     dup tuple? [ not-a-tuple ] unless ; inline
@@ -196,7 +196,7 @@ SYMBOL: outdated-tuples
 
 : outdated-tuple? ( tuple assoc -- ? )
     [ [ layout-of ] dip key? ]
-    [ drop class "forgotten" word-prop not ]
+    [ drop class-of "forgotten" word-prop not ]
     2bi and ;
 
 : update-tuples ( -- )
@@ -356,7 +356,7 @@ M: tuple equal? over tuple? [ tuple= ] [ 2drop f ] if ;
 : tuple-hashcode ( depth obj -- hash )
     [
         [ drop 1000003 ] dip
-        [ class hashcode ] [ tuple-size ] bi
+        [ class-of hashcode ] [ tuple-size ] bi
         [ dup fixnum+fast 82520 fixnum+fast ] [ iota ] bi
     ] 2keep [
         swapd array-nth hashcode* >fixnum rot fixnum-bitxor
index 490015d4517dd4ed0b44c4de70d62e928a6b89ae..fa84c57b921b91aa5e4e84991595e30263673ef3 100644 (file)
@@ -88,7 +88,7 @@ SYMBOL: generic-word
     swap [ [ tag-dispatch-entry ] curry dip ] curry assoc-map math-alist>quot ;
 
 : tuple-dispatch-entry ( class picker -- quot )
-    [ 1quotation [ { tuple } declare class ] [ eq? ] surround ] dip prepend ;
+    [ 1quotation [ { tuple } declare class-of ] [ eq? ] surround ] dip prepend ;
 
 : tuple-dispatch ( picker alist -- alist' )
     swap [ [ tuple-dispatch-entry ] curry dip ] curry assoc-map math-alist>quot ;