Missed yet more renames

db4
Doug Coleman 2011-10-24 17:00:09 -07:00
parent df64529fb5
commit 763d9a3f7d
28 changed files with 49 additions and 49 deletions

View File

@ -24,7 +24,7 @@ STRUCT: T-class { real N-type } { imaginary N-type } ;
: *T ( alien -- z ) : *T ( alien -- z )
T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline T-class memory>struct [ real>> ] [ imaginary>> ] bi rect> ; inline
T-class c-type T-class lookup-c-type
<T> 1quotation >>unboxer-quot <T> 1quotation >>unboxer-quot
*T 1quotation >>boxer-quot *T 1quotation >>boxer-quot
complex >>boxed-class complex >>boxed-class

View File

@ -190,13 +190,13 @@ M: db-connection <select-by-slots-statement> ( tuple class -- statement )
} 2cleave ; } 2cleave ;
M: db-connection query>statement ( query -- tuple ) M: db-connection query>statement ( query -- tuple )
[ tuple>> dup class ] keep [ tuple>> dup class-of ] keep
[ <select-by-slots-statement> ] dip make-query* ; [ <select-by-slots-statement> ] dip make-query* ;
! select ID, NAME, SCORE from EXAM limit 1 offset 3 ! select ID, NAME, SCORE from EXAM limit 1 offset 3
M: db-connection <count-statement> ( query -- statement ) M: db-connection <count-statement> ( query -- statement )
[ tuple>> dup class ] keep [ tuple>> dup class-of ] keep
[ [ "select count(*) from " 0% 0% where-clause ] query-make ] [ [ "select count(*) from " 0% 0% where-clause ] query-make ]
dip make-query* ; dip make-query* ;

View File

@ -29,7 +29,7 @@ SYMBOL: sql-counter
GENERIC: eval-generator ( singleton -- object ) GENERIC: eval-generator ( singleton -- object )
: resulting-tuple ( exemplar-tuple row out-params -- tuple ) : resulting-tuple ( exemplar-tuple row out-params -- tuple )
rot class new [ rot class-of new [
'[ slot-name>> _ set-slot-named ] 2each '[ slot-name>> _ set-slot-named ] 2each
] keep ; ] keep ;
@ -52,13 +52,13 @@ GENERIC: eval-generator ( singleton -- object )
] if ; inline ] if ; inline
: insert-db-assigned-statement ( tuple -- ) : insert-db-assigned-statement ( tuple -- )
dup class dup class-of
db-connection get insert-statements>> db-connection get insert-statements>>
[ <insert-db-assigned-statement> ] cache [ <insert-db-assigned-statement> ] cache
[ bind-tuple ] 2keep insert-tuple-set-key ; [ bind-tuple ] 2keep insert-tuple-set-key ;
: insert-user-assigned-statement ( tuple -- ) : insert-user-assigned-statement ( tuple -- )
dup class dup class-of
db-connection get insert-statements>> db-connection get insert-statements>>
[ <insert-user-assigned-statement> ] cache [ <insert-user-assigned-statement> ] cache
[ bind-tuple ] keep execute-statement ; [ bind-tuple ] keep execute-statement ;
@ -131,17 +131,17 @@ ERROR: no-defined-persistent object ;
: ensure-tables ( classes -- ) [ ensure-table ] each ; : ensure-tables ( classes -- ) [ ensure-table ] each ;
: insert-tuple ( tuple -- ) : insert-tuple ( tuple -- )
dup class ensure-defined-persistent db-assigned? dup class-of ensure-defined-persistent db-assigned?
[ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ; [ insert-db-assigned-statement ] [ insert-user-assigned-statement ] if ;
: update-tuple ( tuple -- ) : update-tuple ( tuple -- )
dup class ensure-defined-persistent dup class-of ensure-defined-persistent
db-connection get update-statements>> [ <update-tuple-statement> ] cache db-connection get update-statements>> [ <update-tuple-statement> ] cache
[ bind-tuple ] keep execute-statement ; [ bind-tuple ] keep execute-statement ;
: delete-tuples ( tuple -- ) : delete-tuples ( tuple -- )
dup dup
dup class ensure-defined-persistent dup class-of ensure-defined-persistent
<delete-tuples-statement> [ <delete-tuples-statement> [
[ bind-tuple ] keep execute-statement [ bind-tuple ] keep execute-statement
] with-disposal ; ] with-disposal ;

View File

@ -38,7 +38,7 @@ SYMBOL: IGNORE
ERROR: no-slot ; ERROR: no-slot ;
: offset-of-slot ( string tuple -- n ) : offset-of-slot ( string tuple -- n )
class all-slots slot-named dup [ no-slot ] unless offset>> ; class-of all-slots slot-named dup [ no-slot ] unless offset>> ;
: get-slot-named ( name tuple -- value ) : get-slot-named ( name tuple -- value )
[ nip ] [ offset-of-slot ] 2bi slot ; [ nip ] [ offset-of-slot ] 2bi slot ;
@ -62,7 +62,7 @@ ERROR: not-persistent class ;
: set-primary-key ( value tuple -- ) : set-primary-key ( value tuple -- )
[ [
class db-columns class-of db-columns
find-primary-key first slot-name>> find-primary-key first slot-name>>
] keep set-slot-named ; ] keep set-slot-named ;

View File

@ -126,7 +126,7 @@ ERROR: type-error type ;
] recover ; ] recover ;
: random-local-server ( -- server ) : random-local-server ( -- server )
remote-address get class new binary <server> ; remote-address get class-of new binary <server> ;
: port>bytes ( port -- hi lo ) : port>bytes ( port -- hi lo )
[ -8 shift ] keep [ 8 bits ] bi@ ; [ -8 shift ] keep [ 8 bits ] bi@ ;

View File

@ -31,7 +31,7 @@ ERROR: no-such-responder responder ;
: base-path ( string -- seq ) : base-path ( string -- seq )
dup responder-nesting get dup responder-nesting get
[ second class superclasses [ name>> = ] with any? ] with find nip [ second class-of superclasses [ name>> = ] with any? ] with find nip
[ first ] [ no-such-responder ] ?if ; [ first ] [ no-such-responder ] ?if ;
: resolve-base-path ( string -- string' ) : resolve-base-path ( string -- string' )

View File

@ -34,7 +34,7 @@ TYPEDEF: void* gpointer
TYPEDEF: guint32 gunichar TYPEDEF: guint32 gunichar
TYPEDEF: void* va_list TYPEDEF: void* va_list
int c-type clone int lookup-c-type clone
[ >c-bool ] >>unboxer-quot [ >c-bool ] >>unboxer-quot
[ c-bool> ] >>boxer-quot [ c-bool> ] >>boxer-quot
object >>boxed-class object >>boxed-class

View File

@ -85,7 +85,7 @@ ERROR: unknown-type-error type ;
qualified-type-name type-infos get-global at ; qualified-type-name type-infos get-global at ;
:: register-type ( c-type type-info name -- ) :: register-type ( c-type type-info name -- )
type-info lookup-c-type >>c-type name type-info c-type >>c-type name
type-infos get-global set-at ; type-infos get-global set-at ;
: register-standard-type ( c-type name -- ) : register-standard-type ( c-type name -- )

View File

@ -225,7 +225,7 @@ DEFER: __
\ prepend 1 [ [ ?head assure ] curry ] define-pop-inverse \ prepend 1 [ [ ?head assure ] curry ] define-pop-inverse
: assure-same-class ( obj1 obj2 -- ) : assure-same-class ( obj1 obj2 -- )
[ class ] bi@ = assure ; inline [ class-of ] bi@ = assure ; inline
\ output>sequence 2 [ [undo] '[ dup _ assure-same-class _ input<sequence ] ] define-pop-inverse \ output>sequence 2 [ [undo] '[ dup _ assure-same-class _ input<sequence ] ] define-pop-inverse
\ input<sequence 1 [ [undo] '[ _ { } output>sequence ] ] define-pop-inverse \ input<sequence 1 [ [undo] '[ _ { } output>sequence ] ] define-pop-inverse

View File

@ -25,7 +25,7 @@ gl-error-log [ V{ } clone ] initialize
name>> { [ "glGetError" = not ] [ "gl" head? ] [ third LETTER? ] } 1&& ; name>> { [ "glGetError" = not ] [ "gl" head? ] [ third LETTER? ] } 1&& ;
: gl-functions ( -- words ) : gl-functions ( -- words )
"opengl.gl" vocab words [ gl-function? ] filter ; "opengl.gl" lookup-vocab words [ gl-function? ] filter ;
: annotate-gl-functions ( quot -- ) : annotate-gl-functions ( quot -- )
[ [

View File

@ -93,7 +93,7 @@ M: float (serialize) ( obj -- )
M: tuple (serialize) ( obj -- ) M: tuple (serialize) ( obj -- )
[ [
CHAR: T write1 CHAR: T write1
[ class (serialize) ] [ class-of (serialize) ]
[ add-object ] [ add-object ]
[ tuple>array rest (serialize) ] [ tuple>array rest (serialize) ]
tri tri

View File

@ -111,7 +111,7 @@ TUPLE: response code messages ;
ERROR: smtp-error response ; ERROR: smtp-error response ;
M: smtp-error error. M: smtp-error error.
"SMTP error (" write dup class pprint ")" print "SMTP error (" write dup class-of pprint ")" print
response>> messages>> [ print ] each ; response>> messages>> [ print ] each ;
ERROR: smtp-server-busy < smtp-error ; ERROR: smtp-server-busy < smtp-error ;

View File

@ -58,21 +58,21 @@ IN: tools.deploy.shaker
] when ; ] when ;
: strip-debugger ( -- ) : strip-debugger ( -- )
strip-debugger? "debugger" vocab and [ strip-debugger? "debugger" lookup-vocab and [
"Stripping debugger" show "Stripping debugger" show
"vocab:tools/deploy/shaker/strip-debugger.factor" "vocab:tools/deploy/shaker/strip-debugger.factor"
run-file run-file
] when ; ] when ;
: strip-ui-error-hook ( -- ) : strip-ui-error-hook ( -- )
strip-debugger? deploy-ui? get and "ui" vocab and [ strip-debugger? deploy-ui? get and "ui" lookup-vocab and [
"Installing generic UI error hook" show "Installing generic UI error hook" show
"vocab:tools/deploy/shaker/strip-ui-error-hook.factor" "vocab:tools/deploy/shaker/strip-ui-error-hook.factor"
run-file run-file
] when ; ] when ;
: strip-libc ( -- ) : strip-libc ( -- )
"libc" vocab [ "libc" lookup-vocab [
"Stripping manual memory management debug code" show "Stripping manual memory management debug code" show
"vocab:tools/deploy/shaker/strip-libc.factor" "vocab:tools/deploy/shaker/strip-libc.factor"
run-file run-file
@ -88,28 +88,28 @@ IN: tools.deploy.shaker
"vocab:tools/deploy/shaker/strip-call.factor" run-file ; "vocab:tools/deploy/shaker/strip-call.factor" run-file ;
: strip-cocoa ( -- ) : strip-cocoa ( -- )
"cocoa" vocab [ "cocoa" lookup-vocab [
"Stripping unused Cocoa methods" show "Stripping unused Cocoa methods" show
"vocab:tools/deploy/shaker/strip-cocoa.factor" "vocab:tools/deploy/shaker/strip-cocoa.factor"
run-file run-file
] when ; ] when ;
: strip-gobject ( -- ) : strip-gobject ( -- )
"gobject-introspection.types" vocab [ "gobject-introspection.types" lookup-vocab [
"Stripping GObject type info" show "Stripping GObject type info" show
"vocab:tools/deploy/shaker/strip-gobject.factor" "vocab:tools/deploy/shaker/strip-gobject.factor"
run-file run-file
] when ; ] when ;
: strip-gtk-icon ( -- ) : strip-gtk-icon ( -- )
"ui.backend.gtk" vocab [ "ui.backend.gtk" lookup-vocab [
"Stripping GTK icon loading code" show "Stripping GTK icon loading code" show
"vocab:tools/deploy/shaker/strip-gtk-icon.factor" "vocab:tools/deploy/shaker/strip-gtk-icon.factor"
run-file run-file
] when ; ] when ;
: strip-specialized-arrays ( -- ) : strip-specialized-arrays ( -- )
strip-dictionary? "specialized-arrays" vocab and [ strip-dictionary? "specialized-arrays" lookup-vocab and [
"Stripping specialized arrays" show "Stripping specialized arrays" show
"vocab:tools/deploy/shaker/strip-specialized-arrays.factor" "vocab:tools/deploy/shaker/strip-specialized-arrays.factor"
run-file run-file

View File

@ -17,7 +17,7 @@ M: input-mismatch-error summary
"” expected input value of type " % "” expected input value of type " %
dup expected-type>> name>> % dup expected-type>> name>> %
" but got " % " but got " %
dup value>> class name>> % dup value>> class-of name>> %
drop drop
] "" make ; ] "" make ;
@ -28,6 +28,6 @@ M: output-mismatch-error summary
"” expected to output value of type " % "” expected to output value of type " %
dup expected-type>> name>> % dup expected-type>> name>> %
" but gave " % " but gave " %
dup value>> class name>> % dup value>> class-of name>> %
drop drop
] "" make ; ] "" make ;

View File

@ -56,7 +56,7 @@ annotation-tags natural-sort
] bi ] bi
<article> "annotations" add-article <article> "annotations" add-article
"annotations" vocab "annotations" >>help drop "annotations" lookup-vocab "annotations" >>help drop
annotation-tags [ annotation-tags [
{ {

View File

@ -93,7 +93,7 @@ M: range-observer model-changed
dup [ deg>rad cos behavior angle-cos<< ] connect dup [ deg>rad cos behavior angle-cos<< ] connect
horizontal <slider> { 1 2 } grid-add horizontal <slider> { 1 2 } grid-add
behavior class name>> <labeled-gadget> ; behavior class-of name>> <labeled-gadget> ;
:: set-population ( n boids-gadget -- ) :: set-population ( n boids-gadget -- )
boids-gadget [ boids-gadget [

View File

@ -96,7 +96,7 @@ PRIVATE>
: (fuel-word-synopsis) ( word usings -- str/f ) : (fuel-word-synopsis) ( word usings -- str/f )
[ [
[ vocab ] filter interactive-vocabs [ append ] change [ lookup-vocab ] filter interactive-vocabs [ append ] change
fuel-find-word [ synopsis ] [ f ] if* fuel-find-word [ synopsis ] [ f ] if*
] with-scope ; ] with-scope ;

View File

@ -38,7 +38,7 @@ M: object (build-alien) improper-statement-error ;
if ; inline if ; inline
: build-alien-attrs ( alien attrs -- ) : build-alien-attrs ( alien attrs -- )
[ class "slots" word-prop ] [ tuple>array rest ] bi [ class-of "slots" word-prop ] [ tuple>array rest ] bi
[ [ name>> ] dip build-alien-attr ] 2each drop ; [ [ name>> ] dip build-alien-attr ] 2each drop ;
M: graph-attributes (build-alien) M: graph-attributes (build-alien)

View File

@ -40,8 +40,8 @@ TUPLE: function name alien return params ;
"alien.llvm" create swap "alien.llvm" create swap
[ [
dup name>> function-pointer , dup name>> function-pointer ,
dup return>> lookup-c-type , dup return>> c:lookup-c-type ,
dup params>> [ second lookup-c-type ] map , dup params>> [ second c:lookup-c-type ] map ,
cdecl , \ alien-indirect , cdecl , \ alien-indirect ,
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ; ] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;

View File

@ -890,7 +890,7 @@ TYPED: macho-header ( c-ptr -- macho: mach_header_32/64 )
TYPED: load-commands ( macho: mach_header_32/64 -- load-commands ) TYPED: load-commands ( macho: mach_header_32/64 -- load-commands )
[ [
[ class heap-size ] [ class-of heap-size ]
[ >c-ptr <displaced-alien> ] [ >c-ptr <displaced-alien> ]
[ ncmds>> ] tri iota [ [ ncmds>> ] tri iota [
drop read-command drop read-command
@ -908,7 +908,7 @@ TYPED: load-commands ( macho: mach_header_32/64 -- load-commands )
: segment-sections ( segment-command -- sections ) : segment-sections ( segment-command -- sections )
{ {
[ class heap-size ] [ class-of heap-size ]
[ >c-ptr <displaced-alien> ] [ >c-ptr <displaced-alien> ]
[ nsects>> ] [ nsects>> ]
[ segment_command_64? ] [ segment_command_64? ]

View File

@ -47,7 +47,7 @@ PRIVATE>
class-pool pool-new ; class-pool pool-new ;
: free-to-pool ( object -- ) : free-to-pool ( object -- )
dup class class-pool pool-free ; dup class-of class-pool pool-free ;
SYNTAX: POOL: SYNTAX: POOL:
scan-word scan-word '[ _ swap <pool> ] [ swap set-class-pool ] bi ; scan-word scan-word '[ _ swap <pool> ] [ swap set-class-pool ] bi ;

View File

@ -39,13 +39,13 @@ MEMO: id-slot ( class -- slot )
PRIVATE> PRIVATE>
: >toid ( object -- toid ) : >toid ( object -- toid )
[ id>> ] [ class id-slot ] bi <toid> ; [ id>> ] [ class-of id-slot ] bi <toid> ;
M: mdb-persistent id>> ( object -- id ) M: mdb-persistent id>> ( object -- id )
dup class id-slot reader-word execute( object -- id ) ; dup class-of id-slot reader-word execute( object -- id ) ;
M: mdb-persistent id<< ( object value -- ) M: mdb-persistent id<< ( object value -- )
over class id-slot writer-word execute( object value -- ) ; over class-of id-slot writer-word execute( object value -- ) ;
@ -125,10 +125,10 @@ M: tuple-class tuple-collection ( tuple -- mdb-collection )
(mdb-collection) ; (mdb-collection) ;
M: mdb-persistent tuple-collection ( tuple -- mdb-collection ) M: mdb-persistent tuple-collection ( tuple -- mdb-collection )
class (mdb-collection) ; class-of (mdb-collection) ;
M: mdb-persistent mdb-slot-map ( tuple -- string ) M: mdb-persistent mdb-slot-map ( tuple -- string )
class (mdb-slot-map) ; class-of (mdb-slot-map) ;
M: tuple-class mdb-slot-map ( class -- assoc ) M: tuple-class mdb-slot-map ( class -- assoc )
(mdb-slot-map) ; (mdb-slot-map) ;
@ -137,7 +137,7 @@ M: mdb-collection mdb-slot-map ( collection -- assoc )
classes>> [ mdb-slot-map ] map assoc-combine ; classes>> [ mdb-slot-map ] map assoc-combine ;
M: mdb-persistent mdb-index-map M: mdb-persistent mdb-index-map
class (mdb-index-map) ; class-of (mdb-index-map) ;
M: tuple-class mdb-index-map M: tuple-class mdb-index-map
(mdb-index-map) ; (mdb-index-map) ;
M: mdb-collection mdb-index-map M: mdb-collection mdb-index-map

View File

@ -10,7 +10,7 @@ CONSTANT: MDB_TUPLE_INFO "_mfd_t_info"
PRIVATE> PRIVATE>
: <tuple-info> ( tuple -- tuple-info ) : <tuple-info> ( tuple -- tuple-info )
class [ V{ } clone ] dip over class-of [ V{ } clone ] dip over
[ [ name>> ] dip push ] [ [ name>> ] dip push ]
[ [ vocabulary>> ] dip push ] 2bi ; inline [ [ vocabulary>> ] dip push ] 2bi ; inline

View File

@ -202,7 +202,7 @@ M: no-method error.
dup arguments>> short. dup arguments>> short.
nl nl
"Inputs have signature:" print "Inputs have signature:" print
dup arguments>> [ class ] map niceify-method . dup arguments>> [ class-of ] map niceify-method .
nl nl
"Available methods: " print "Available methods: " print
generic>> methods canonicalize-specializers drop sort-methods generic>> methods canonicalize-specializers drop sort-methods

View File

@ -18,7 +18,7 @@ SYNTAX: STORED-TUPLE: parse-tuple-definition [ drop persistent ] dip [ remove-ty
: define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ; : define-db ( database class -- ) swap [ [ ensure-table ] with-db ] [ "database" set-word-prop ] 2bi ;
: query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ; : query>tuple ( tuple/query -- tuple ) dup query? [ tuple>> ] when ;
: w/db ( query quot -- ) [ dup query>tuple class "database" word-prop ] dip with-db ; inline : w/db ( query quot -- ) [ dup query>tuple class-of "database" word-prop ] dip with-db ; inline
: get-tuples ( query -- tuples ) [ select-tuples ] w/db ; : get-tuples ( query -- tuples ) [ select-tuples ] w/db ;
: get-tuple ( query -- tuple ) [ select-tuple ] w/db ; : get-tuple ( query -- tuple ) [ select-tuple ] w/db ;
: store-tuple ( tuple -- ) [ insert-tuple ] w/db ; : store-tuple ( tuple -- ) [ insert-tuple ] w/db ;

View File

@ -40,7 +40,7 @@ IN: project-euler
: solution-path ( n -- str/f ) : solution-path ( n -- str/f )
number>euler "project-euler." prepend number>euler "project-euler." prepend
vocab where dup [ first <pathname> ] when ; lookup-vocab where dup [ first <pathname> ] when ;
PRIVATE> PRIVATE>

View File

@ -17,7 +17,7 @@ IN: update.util
DEFER: to-strings DEFER: to-strings
: to-string ( obj -- str ) : to-string ( obj -- str )
dup class dup class-of
{ {
{ \ string [ ] } { \ string [ ] }
{ \ quotation [ call( -- string ) ] } { \ quotation [ call( -- string ) ] }

View File

@ -62,7 +62,7 @@ M: object (match-branch)
over \ unboa [ ] 2sequence prepend ; over \ unboa [ ] 2sequence prepend ;
: ?class ( object -- class ) : ?class ( object -- class )
dup word? [ class ] unless ; dup word? [ class-of ] unless ;
MACRO: match ( branches -- ) MACRO: match ( branches -- )
[ dup callable? [ first2 (match-branch) 2array ] unless ] map [ dup callable? [ first2 (match-branch) 2array ] unless ] map