55 lines
1.2 KiB
Factor
55 lines
1.2 KiB
Factor
! (c)2009 Joe Groff bsd license
|
|
USING: accessors arrays bit-arrays classes
|
|
classes.tuple.private fry kernel locals parser
|
|
sequences sequences.private vectors words ;
|
|
IN: memory.pools
|
|
|
|
TUPLE: pool
|
|
prototype
|
|
{ objects vector } ;
|
|
|
|
: <pool> ( size class -- pool )
|
|
[ nip new ]
|
|
[ [ iota ] dip '[ _ new ] V{ } replicate-as ] 2bi
|
|
pool boa ;
|
|
|
|
: pool-size ( pool -- size )
|
|
objects>> length ;
|
|
|
|
<PRIVATE
|
|
|
|
:: copy-tuple ( from to -- to )
|
|
from tuple-size :> size
|
|
size [| n | n from array-nth n to set-array-nth ] each
|
|
to ; inline
|
|
|
|
: (pool-new) ( pool -- object )
|
|
objects>> [ f ] [ pop ] if-empty ;
|
|
|
|
: (pool-init) ( pool object -- object )
|
|
[ prototype>> ] dip copy-tuple ; inline
|
|
|
|
PRIVATE>
|
|
|
|
: pool-new ( pool -- object )
|
|
dup (pool-new) [ (pool-init) ] [ drop f ] if* ; inline
|
|
|
|
: pool-free ( object pool -- )
|
|
objects>> push ;
|
|
|
|
: class-pool ( class -- pool )
|
|
"pool" word-prop ;
|
|
|
|
: set-class-pool ( class pool -- )
|
|
"pool" set-word-prop ;
|
|
|
|
: new-from-pool ( class -- object )
|
|
class-pool pool-new ;
|
|
|
|
: free-to-pool ( object -- )
|
|
dup class class-pool pool-free ;
|
|
|
|
SYNTAX: POOL:
|
|
scan-word scan-word '[ _ swap <pool> ] [ swap set-class-pool ] bi ;
|
|
|