diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index 0e88acb4c8..1c493b0730 100644 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -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 diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index ca65352065..dc1cbc1d65 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -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 ; diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor index 2d7998135f..64d2dfa70c 100644 --- a/basis/classes/struct/prettyprint/prettyprint.factor +++ b/basis/classes/struct/prettyprint/prettyprint.factor @@ -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 -- ) 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 : 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* diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index ec29e0b262..1fe2c573d3 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -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 [ 0 = ] all? ; inline ! class definition diff --git a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor index eadfe0aa91..025541e1f3 100644 --- a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor +++ b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor @@ -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 ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index 69fd37abb8..53fdb458c6 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -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 diff --git a/basis/compiler/tree/escape-analysis/check/check.factor b/basis/compiler/tree/escape-analysis/check/check.factor index 4679dfe342..e8a96c62f9 100644 --- a/basis/compiler/tree/escape-analysis/check/check.factor +++ b/basis/compiler/tree/escape-analysis/check/check.factor @@ -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? ; diff --git a/basis/compiler/tree/escape-analysis/simple/simple.factor b/basis/compiler/tree/escape-analysis/simple/simple.factor index ecdd10fee7..9a3d53d675 100644 --- a/basis/compiler/tree/escape-analysis/simple/simple.factor +++ b/basis/compiler/tree/escape-analysis/simple/simple.factor @@ -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 ; diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 22ea1306d6..8f0fed8c24 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -57,7 +57,7 @@ CONSTANT: object-info T{ value-info f object full-interval } DEFER: : tuple-slot-infos ( tuple -- slots ) - [ tuple-slots ] [ class all-slots ] bi + [ tuple-slots ] [ class-of all-slots ] bi [ read-only>> [ ] [ 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 swap prefix ; : slots-with-length ( seq -- slots ) - [ length ] [ class ] bi (slots-with-length) ; + [ length ] [ class-of ] bi (slots-with-length) ; : init-literal-info ( info -- info ) empty-interval >>interval diff --git a/basis/compiler/tree/propagation/slots/slots.factor b/basis/compiler/tree/propagation/slots/slots.factor index 14546f0237..22feb3382a 100644 --- a/basis/compiler/tree/propagation/slots/slots.factor +++ b/basis/compiler/tree/propagation/slots/slots.factor @@ -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 ] } 2&& ; diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 1edc04c42d..b193d5080c 100755 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -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. ; diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index abfb3199a2..413922b71f 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -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 ; diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 6f1504b615..618491a723 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -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 ; diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor index 110cc6ad81..6689f959e7 100644 --- a/basis/locals/rewrite/sugar/sugar.factor +++ b/basis/locals/rewrite/sugar/sugar.factor @@ -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* ; diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor index 819c3aa087..07b2945e69 100644 --- a/basis/mirrors/mirrors.factor +++ b/basis/mirrors/mirrors.factor @@ -10,7 +10,7 @@ TUPLE: mirror { object read-only } ; C: 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 diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 2714e8e56f..74ce0b0337 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -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 diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 09d93a0334..d4840b20a4 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -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 -- ) 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 ; diff --git a/basis/summary/summary.factor b/basis/summary/summary.factor index 2737ecec6c..e67be479ae 100644 --- a/basis/summary/summary.factor +++ b/basis/summary/summary.factor @@ -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" % diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor index 42d09d0ef9..a8a1b35e87 100644 --- a/basis/tools/destructors/destructors.factor +++ b/basis/tools/destructors/destructors.factor @@ -8,7 +8,7 @@ IN: tools.destructors alist [ first2 [ length ] keep 3array ] map [ second ] sort-with diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor index 04e8c47d4f..dbeb464934 100644 --- a/basis/tools/memory/memory.factor +++ b/basis/tools/memory/memory.factor @@ -72,8 +72,8 @@ PRIVATE> diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor index 44ce92ed8d..3217fafb52 100644 --- a/basis/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -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 add-gadget ] ] bi assoc-each ; diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index c082c0764e..27d502cc24 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -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 -- ? ) diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index e0cd9ede62..12855e65ba 100644 --- a/basis/ui/pixel-formats/pixel-formats.factor +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -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* ; diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 0adaa4028c..7217e4ef22 100644 --- a/basis/ui/tools/browser/browser.factor +++ b/basis/ui/tools/browser/browser.factor @@ -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 diff --git a/basis/ui/tools/common/common.factor b/basis/ui/tools/common/common.factor index 95af20ec72..4e307a5984 100644 --- a/basis/ui/tools/common/common.factor +++ b/basis/ui/tools/common/common.factor @@ -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 ; diff --git a/basis/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor index 1fc1ad1860..e5d5ab5759 100644 --- a/basis/ui/tools/inspector/inspector.factor +++ b/basis/ui/tools/inspector/inspector.factor @@ -33,7 +33,7 @@ M: inspector-renderer column-titles [ [ [ "Class:" write ] with-cell - [ class pprint ] with-cell + [ class-of pprint ] with-cell ] with-row ] [ diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor index 1595816ba2..e5aaa32201 100644 --- a/core/classes/builtin/builtin.factor +++ b/core/classes/builtin/builtin.factor @@ -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 ; diff --git a/core/classes/classes-docs.factor b/core/classes/classes-docs.factor index 50d2dc5e7b..965fcdc3ae 100644 --- a/core/classes/classes-docs.factor +++ b/core/classes/classes-docs.factor @@ -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" } } diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 4bbf6bc9cb..dd86586142 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -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 diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index bbc5004f0a..b6af0b39fb 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -67,7 +67,7 @@ C: predicate-test [ t ] [ 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 [ 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 [ 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 diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 5eafdb0332..7fc311de55 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -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 diff --git a/core/generic/math/math.factor b/core/generic/math/math.factor index 490015d451..fa84c57b92 100644 --- a/core/generic/math/math.factor +++ b/core/generic/math/math.factor @@ -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 ;