factor: slot:
Doug Coleman
parent
9910c373c2
commit
7f0d6f34a7
|
|
@ -43,7 +43,7 @@ M: slice >c-ptr
|
|||
[ [ from>> ] [ element-size ] bi * ] [ seq>> >c-ptr ] bi
|
||||
<displaced-alien> ; inline
|
||||
|
||||
SLOT: underlying
|
||||
slot: underlying
|
||||
|
||||
M: object >c-ptr underlying>> ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -303,10 +303,10 @@ ARTICLE: "protocol-slots" "Protocol slots"
|
|||
"A " { $emphasis "protocol slot" } " is one which is assumed to exist by the implementation of a class, without being defined on the class itself. The burden is on subclasses (or mixin instances) to provide this slot."
|
||||
$nl
|
||||
"Protocol slots are defined using a parsing word:"
|
||||
{ $subsections postpone: SLOT: }
|
||||
{ $subsections postpone: slot: }
|
||||
"Protocol slots are used where the implementation of a superclass needs to assume that each subclass defines certain slots, however the slots of each subclass are potentially declared with different class specializers, thus preventing the slots from being defined in the superclass."
|
||||
$nl
|
||||
"For example, the " { $link growable } " mixin provides an implementation of the sequence protocol which wraps an underlying sequence, resizing it as necessary when elements are added beyond the length of the sequence. It assumes that the concrete mixin instances define two slots, " { $snippet "length" } " and " { $snippet "underlying" } ". These slots are defined as protocol slots: " { $snippet "SLOT: length" } " and " { $snippet "SLOT: underlying" } ". "
|
||||
"For example, the " { $link growable } " mixin provides an implementation of the sequence protocol which wraps an underlying sequence, resizing it as necessary when elements are added beyond the length of the sequence. It assumes that the concrete mixin instances define two slots, " { $snippet "length" } " and " { $snippet "underlying" } ". These slots are defined as protocol slots: " { $snippet "slot: length" } " and " { $snippet "slot: underlying" } ". "
|
||||
"An alternate approach would be to define " { $link growable } " as a tuple class with these two slots, and have other classes subclass it as required. However, this rules out subclasses defining these slots with custom type declarations."
|
||||
$nl
|
||||
"For example, compare the definitions of the " { $link sbuf } " class,"
|
||||
|
|
|
|||
|
|
@ -631,10 +631,10 @@ M: bogus-hashcode-1 hashcode* 2drop 0 >bignum ;
|
|||
{ } [ T{ bogus-hashcode-2 f T{ bogus-hashcode-1 } } hashcode drop ] unit-test
|
||||
|
||||
defer: change-slot-test
|
||||
SLOT: kex
|
||||
slot: kex
|
||||
|
||||
{ } [
|
||||
"in: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
|
||||
"in: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; slot: kex M: change-slot-test kex>> drop 3 ;"
|
||||
<string-reader> "change-slot-test" parse-stream
|
||||
drop
|
||||
] unit-test
|
||||
|
|
@ -650,7 +650,7 @@ SLOT: kex
|
|||
{ t } [ \ change-slot-test \ kex>> ?lookup-method >boolean ] unit-test
|
||||
|
||||
{ } [
|
||||
"in: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; SLOT: kex M: change-slot-test kex>> drop 3 ;"
|
||||
"in: classes.tuple.tests USING: kernel accessors ; TUPLE: change-slot-test ; slot: kex M: change-slot-test kex>> drop 3 ;"
|
||||
<string-reader> "change-slot-test" parse-stream
|
||||
drop
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -145,7 +145,7 @@ PROTOCOL: silly-protocol do-me ;
|
|||
|
||||
! A slot protocol issue
|
||||
defer: slot-protocol-test-3
|
||||
SLOT: y
|
||||
slot: y
|
||||
|
||||
{ f } [ \ slot-protocol-test-3 \ y>> ?lookup-method >boolean ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ symbol: debug-leaks?
|
|||
|
||||
<PRIVATE
|
||||
|
||||
SLOT: continuation
|
||||
slot: continuation
|
||||
|
||||
: register-disposable ( obj -- )
|
||||
debug-leaks? get-global [ current-continuation >>continuation ] when
|
||||
|
|
|
|||
|
|
@ -6,8 +6,8 @@ in: growable
|
|||
|
||||
mixin: growable
|
||||
|
||||
SLOT: length
|
||||
SLOT: underlying
|
||||
slot: length
|
||||
slot: underlying
|
||||
|
||||
M: growable length length>> ; inline
|
||||
M: growable nth-unsafe underlying>> nth-unsafe ; inline
|
||||
|
|
|
|||
|
|
@ -6,8 +6,8 @@ sequences.private strings ;
|
|||
in: io.streams.sequence
|
||||
|
||||
! Readers
|
||||
SLOT: underlying
|
||||
SLOT: i
|
||||
slot: underlying
|
||||
slot: i
|
||||
|
||||
: >sequence-stream< ( stream -- i underlying )
|
||||
[ i>> ] [ underlying>> ] bi ; inline
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ TUPLE: hello length ;
|
|||
[ "xyz" 4 >>length ] [ no-method? ] must-fail-with
|
||||
|
||||
! Test protocol slots
|
||||
SLOT: my-protocol-slot-test
|
||||
slot: my-protocol-slot-test
|
||||
|
||||
TUPLE: protocol-slot-test-tuple x ;
|
||||
|
||||
|
|
|
|||
|
|
@ -789,8 +789,8 @@ HELP: read-only
|
|||
|
||||
{ initial: read-only } related-words
|
||||
|
||||
HELP: SLOT:
|
||||
{ $syntax "SLOT: name" }
|
||||
HELP: slot:
|
||||
{ $syntax "slot: name" }
|
||||
{ $values { "name" "a slot name" } }
|
||||
{ $description "Defines a protocol slot; that is, defines the accessor words for a slot named " { $snippet "slot" } " without associating it with any specific tuple." } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -243,7 +243,7 @@ in: bootstrap.syntax
|
|||
|
||||
"INSTANCE:" [
|
||||
location [
|
||||
scan-word scan-word 2dup add-mixin-instance
|
||||
scan-word scan-word ";" expect 2dup add-mixin-instance
|
||||
<mixin-instance>
|
||||
] dip remember-definition
|
||||
] define-core-syntax
|
||||
|
|
|
|||
|
|
@ -20,9 +20,9 @@ FROM: mongodb.tuple => +transient+ +load+ <tuple-index> ;
|
|||
|
||||
mixin: mdb-persistent
|
||||
|
||||
SLOT: id
|
||||
SLOT: _id
|
||||
SLOT: _mfd
|
||||
slot: id
|
||||
slot: _id
|
||||
slot: _mfd
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
|
|||
|
|
@ -258,7 +258,7 @@ M: float-11-11-10-components (component-type>type)
|
|||
: image-data-format ( component-order component-type -- gl-format gl-type )
|
||||
[ (component-order>format) ] [ (component-type>type) ] 2bi ;
|
||||
|
||||
SLOT: display-list
|
||||
slot: display-list
|
||||
|
||||
: draw-texture ( texture -- ) display-list>> [ glCallList ] when* ;
|
||||
|
||||
|
|
|
|||
|
|
@ -106,7 +106,7 @@ M: sessions call-responder* ( path responder -- response )
|
|||
request-session [ begin-session ] unless*
|
||||
existing-session put-session-cookie ;
|
||||
|
||||
SLOT: session
|
||||
slot: session
|
||||
|
||||
: check-session ( state/f -- state/f )
|
||||
dup [ dup session>> session get id>> = [ drop f ] unless ] when ;
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ PRIVATE>
|
|||
{ T{ drag } [ update-clicked drop ] }
|
||||
} set-gestures
|
||||
|
||||
SLOT: popup
|
||||
slot: popup
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ in: ui.gadgets.labels
|
|||
! A label gadget draws a string.
|
||||
TUPLE: label < aligned-gadget text font ;
|
||||
|
||||
SLOT: string
|
||||
slot: string
|
||||
|
||||
M: label string>> ( label -- string )
|
||||
text>> dup string? [ "\n" join ] unless ; inline
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
USING: accessors io.pathnames sequences ui.images ui.theme ;
|
||||
in: ui.gadgets.theme
|
||||
|
||||
SLOT: font ! Temporarily necessary to fix Windows bootstrap.
|
||||
slot: font ! Temporarily necessary to fix Windows bootstrap.
|
||||
|
||||
: theme-image ( name -- image-name )
|
||||
"vocab:ui/gadgets/theme/" prepend-path ".tiff" append <image-name> ;
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ symbol: viewport-translation
|
|||
[ clip namespaces:set ] bi
|
||||
do-clip ;
|
||||
|
||||
SLOT: background-color
|
||||
slot: background-color
|
||||
|
||||
: gl-init ( -- )
|
||||
check-extensions "1.0" require-gl-version
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ links-popup H{
|
|||
{ T{ key-down f f "ESC" } [ hide-glass ] }
|
||||
} set-gestures
|
||||
|
||||
SLOT: model
|
||||
slot: model
|
||||
|
||||
: show-links-popup ( browser-gadget quot title -- )
|
||||
[ dup model>> ] 2dip <links-popup>
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@ M: tool layout*
|
|||
[ [ dim>> ] [ class-of ] bi set-tool-dim ]
|
||||
bi ;
|
||||
|
||||
SLOT: scroller
|
||||
slot: scroller
|
||||
|
||||
: com-page-up ( tool -- )
|
||||
scroller>> scroll-up-page ;
|
||||
|
|
|
|||
|
|
@ -14,8 +14,8 @@ ui.tools.listener.popups vocabs words ;
|
|||
in: ui.tools.listener.completion
|
||||
|
||||
! We don't directly depend on the listener tool but we use a few slots
|
||||
SLOT: interactor
|
||||
SLOT: history
|
||||
slot: interactor
|
||||
slot: history
|
||||
|
||||
: history-list ( interactor -- alist )
|
||||
history>> elements>>
|
||||
|
|
|
|||
|
|
@ -36,7 +36,7 @@ INSTANCE: interactor input-stream
|
|||
[ thread>> dup [ thread-registered? ] when ]
|
||||
} 1&& not ;
|
||||
|
||||
SLOT: manifest
|
||||
slot: manifest
|
||||
|
||||
M: interactor manifest>>
|
||||
dup interactor-busy? [ drop f ] [
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ TUPLE: struct-bit-slot-spec < struct-slot-spec
|
|||
PREDICATE: struct-class < tuple-class
|
||||
superclass-of \ struct eq? ;
|
||||
|
||||
SLOT: fields
|
||||
slot: fields
|
||||
|
||||
: struct-slots ( struct-class -- slots )
|
||||
"c-type" word-prop fields>> ;
|
||||
|
|
|
|||
|
|
@ -42,8 +42,8 @@ MACRO: (vectored-element>) ( struct-class -- quot: ( elt -- struct ) )
|
|||
[ struct-slots [ name>> reader-word 1quotation ] map ] keep
|
||||
'[ _ cleave _ <struct-boa> ] ;
|
||||
|
||||
SLOT: (n)
|
||||
SLOT: (vectored)
|
||||
slot: (n)
|
||||
slot: (vectored)
|
||||
|
||||
FUNCTOR: define-vectored-accessors ( S>> S<< T -- )
|
||||
|
||||
|
|
|
|||
|
|
@ -4,8 +4,8 @@ USING: accessors arrays compiler.cfg compiler.cfg.instructions
|
|||
compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.utilities
|
||||
kernel make math namespaces sequences ;
|
||||
in: compiler.cfg.builder.blocks
|
||||
SLOT: in-d
|
||||
SLOT: out-d
|
||||
slot: in-d
|
||||
slot: out-d
|
||||
|
||||
: set-basic-block ( basic-block -- )
|
||||
dup begin-local-analysis instructions>> building set ;
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ windows.time windows.types windows.winsock ;
|
|||
SPECIALIZED-ARRAY: ushort
|
||||
in: io.files.windows
|
||||
|
||||
SLOT: file
|
||||
slot: file
|
||||
|
||||
: CreateFile-flags ( DWORD -- DWORD )
|
||||
flags{ FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED } bitor ;
|
||||
|
|
@ -281,7 +281,7 @@ SYMBOLS: +read-only+ +hidden+ +system+
|
|||
+sparse-file+ +reparse-point+ +compressed+ +offline+
|
||||
+not-content-indexed+ +encrypted+ ;
|
||||
|
||||
SLOT: attributes
|
||||
slot: attributes
|
||||
|
||||
: read-only? ( file-info -- ? )
|
||||
attributes>> +read-only+ swap member? ;
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ M: local present path>> "Unix domain socket: " prepend ;
|
|||
|
||||
M: local protocol drop 0 ;
|
||||
|
||||
SLOT: port
|
||||
slot: port
|
||||
|
||||
TUPLE: ipv4 { host maybe{ string } read-only } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -59,7 +59,7 @@ in: http.server.cgi
|
|||
] with-stream
|
||||
] >>body ;
|
||||
|
||||
SLOT: special
|
||||
slot: special
|
||||
|
||||
: enable-cgi ( responder -- responder )
|
||||
[ serve-cgi ] "application/x-cgi-script"
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ C-TYPE: cairo_snurface_t
|
|||
main: majn
|
||||
|
||||
! ! SLOT
|
||||
SLOT: komba
|
||||
slot: komba
|
||||
|
||||
! ! SYNTAX
|
||||
<<
|
||||
|
|
|
|||
|
|
@ -57,12 +57,12 @@ TUPLE: spidering-site < watching-site max-depth max-count ;
|
|||
|
||||
C: <spidering-site> spidering-site
|
||||
|
||||
SLOT: site
|
||||
slot: site
|
||||
|
||||
M: watching-site site>>
|
||||
site-id>> site-with-id ;
|
||||
|
||||
SLOT: account
|
||||
slot: account
|
||||
|
||||
M: watching-site account>>
|
||||
account-name>> account new swap >>account-name select-tuple ;
|
||||
|
|
|
|||
|
|
@ -10,13 +10,13 @@ in: webapps.mason.version.files
|
|||
: remote-directory ( string -- string' )
|
||||
[ package-directory get ] dip "/" glue ;
|
||||
|
||||
SLOT: os
|
||||
SLOT: cpu
|
||||
slot: os
|
||||
slot: cpu
|
||||
|
||||
: platform ( builder -- string )
|
||||
[ os>> ] [ cpu>> ] bi (platform) ;
|
||||
|
||||
SLOT: last-release
|
||||
slot: last-release
|
||||
|
||||
: binary-package-name ( builder -- string )
|
||||
[ [ platform % "/" % ] [ last-release>> % ] bi ] "" make
|
||||
|
|
|
|||
Loading…
Reference in New Issue