steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rename class to class-of

db4
Doug Coleman 2011-10-24 06:47:42 -05:00
parent 26872ffe4d
commit f9257959fd
32 changed files with 70 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/bootstrap/compiler/compiler.factor
View 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

6
basis/bootstrap/image/image.factor
View File

@ -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 ;

18
basis/classes/struct/prettyprint/prettyprint.factor
View 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*

4
basis/classes/struct/struct.factor
View 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

4
basis/compiler/cfg/stacks/uninitialized/uninitialized.factor
View 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 ;

2
basis/compiler/codegen/codegen.factor
View File

@ -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

2
basis/compiler/tree/escape-analysis/check/check.factor
View 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? ;

2
basis/compiler/tree/escape-analysis/simple/simple.factor
View 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 ;

6
basis/compiler/tree/propagation/info/info.factor
View 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

2
basis/compiler/tree/propagation/slots/slots.factor
View 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&& ;

6
basis/debugger/debugger.factor
View File

@ -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. ;

2
basis/hints/hints.factor
View 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 ;

4
basis/io/sockets/sockets.factor
View 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 ;

2
basis/locals/rewrite/sugar/sugar.factor
View 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* ;

2
basis/mirrors/mirrors.factor
View 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

2
basis/peg/peg.factor
View 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

8
basis/prettyprint/backend/backend.factor
View 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 ;

6
basis/summary/summary.factor
View 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" %

2
basis/tools/destructors/destructors.factor
View 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

4
basis/tools/memory/memory.factor
View 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>

2
basis/ui/gadgets/buttons/buttons.factor
View 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 ;

2
basis/ui/gestures/gestures.factor
View 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 -- ? )

2
basis/ui/pixel-formats/pixel-formats.factor
View 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* ;

2
basis/ui/tools/browser/browser.factor
View 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

4
basis/ui/tools/common/common.factor
View 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 ;

2
basis/ui/tools/inspector/inspector.factor
View 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
]
[

2
core/classes/builtin/builtin.factor
View 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 ;

6
core/classes/classes-docs.factor
View 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" } }

2
core/classes/classes.factor
View 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

20
core/classes/tuple/tuple-tests.factor
View 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

8
core/classes/tuple/tuple.factor
View 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

2
core/generic/math/math.factor
View 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 ;