cache: don't require values to have an age slot anymore
parent
e3a97b14c7
commit
d6872af3e7
|
@ -1,36 +1,43 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel assocs math accessors destructors fry ;
|
USING: kernel assocs math accessors destructors fry sequences ;
|
||||||
IN: cache
|
IN: cache
|
||||||
|
|
||||||
SLOT: age
|
|
||||||
|
|
||||||
GENERIC: age ( obj -- )
|
|
||||||
|
|
||||||
M: object age [ 1+ ] change-age drop ;
|
|
||||||
|
|
||||||
TUPLE: cache-assoc assoc max-age disposed ;
|
TUPLE: cache-assoc assoc max-age disposed ;
|
||||||
|
|
||||||
: <cache-assoc> ( -- cache )
|
: <cache-assoc> ( -- cache )
|
||||||
H{ } clone 10 f cache-assoc boa ;
|
H{ } clone 10 f cache-assoc boa ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
TUPLE: cache-entry value age ;
|
||||||
|
|
||||||
|
: <cache-entry> ( value -- entry ) 0 cache-entry boa ; inline
|
||||||
|
|
||||||
|
M: cache-entry dispose value>> dispose ;
|
||||||
|
|
||||||
M: cache-assoc assoc-size assoc>> assoc-size ;
|
M: cache-assoc assoc-size assoc>> assoc-size ;
|
||||||
|
|
||||||
M: cache-assoc at* assoc>> at* [ dup [ 0 >>age ] when ] dip ;
|
M: cache-assoc at* assoc>> at* [ dup [ 0 >>age value>> ] when ] dip ;
|
||||||
|
|
||||||
M: cache-assoc set-at dup check-disposed assoc>> set-at ;
|
M: cache-assoc set-at
|
||||||
|
[ check-disposed ] keep
|
||||||
|
[ <cache-entry> ] 2dip
|
||||||
|
assoc>> set-at ;
|
||||||
|
|
||||||
M: cache-assoc clear-assoc assoc>> clear-assoc ;
|
M: cache-assoc clear-assoc assoc>> clear-assoc ;
|
||||||
|
|
||||||
M: cache-assoc >alist assoc>> >alist ;
|
M: cache-assoc >alist assoc>> [ value>> ] { } assoc-map-as ;
|
||||||
|
|
||||||
INSTANCE: cache-assoc assoc
|
INSTANCE: cache-assoc assoc
|
||||||
|
|
||||||
|
M: cache-assoc dispose*
|
||||||
|
[ values dispose-each ] [ clear-assoc ] bi ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
: purge-cache ( cache -- )
|
: purge-cache ( cache -- )
|
||||||
dup max-age>> '[
|
dup max-age>> '[
|
||||||
[ nip dup age age>> _ >= ] assoc-partition
|
[ nip [ 1+ ] change-age age>> _ >= ] assoc-partition
|
||||||
[ values dispose-each ] dip
|
[ values dispose-each ] dip
|
||||||
] change-assoc drop ;
|
] change-assoc drop ;
|
||||||
|
|
||||||
M: cache-assoc dispose*
|
|
||||||
assoc>> [ values dispose-each ] [ clear-assoc ] bi ;
|
|
|
@ -0,0 +1 @@
|
||||||
|
An associative mapping whose entries expire after a while
|
|
@ -0,0 +1 @@
|
||||||
|
collections
|
|
@ -47,7 +47,7 @@ ERROR: not-a-string object ;
|
||||||
CTLineCreateWithAttributedString
|
CTLineCreateWithAttributedString
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
TUPLE: line font line metrics dim bitmap age disposed ;
|
TUPLE: line font line metrics dim bitmap disposed ;
|
||||||
|
|
||||||
: compute-line-metrics ( line -- line-metrics )
|
: compute-line-metrics ( line -- line-metrics )
|
||||||
0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
|
0 <CGFloat> 0 <CGFloat> 0 <CGFloat>
|
||||||
|
@ -92,9 +92,9 @@ TUPLE: line font line metrics dim bitmap age disposed ;
|
||||||
[ [ line ] dip CTLineDraw ]
|
[ [ line ] dip CTLineDraw ]
|
||||||
} cleave
|
} cleave
|
||||||
] with-bitmap-context
|
] with-bitmap-context
|
||||||
[ open-font line metrics dim ] dip 0 f
|
[ open-font line metrics dim ] dip
|
||||||
]
|
]
|
||||||
line boa
|
f line boa
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
M: line dispose* [ font>> CFRelease ] [ line>> CFRelease ] bi ;
|
M: line dispose* [ font>> CFRelease ] [ line>> CFRelease ] bi ;
|
||||||
|
|
|
@ -4,7 +4,7 @@ USING: accessors assocs cache colors.constants destructors fry
|
||||||
kernel opengl opengl.gl combinators ;
|
kernel opengl opengl.gl combinators ;
|
||||||
IN: opengl.texture-cache
|
IN: opengl.texture-cache
|
||||||
|
|
||||||
TUPLE: texture texture display-list age disposed ;
|
TUPLE: texture texture display-list disposed ;
|
||||||
|
|
||||||
: make-texture-display-list ( dim texture -- dlist )
|
: make-texture-display-list ( dim texture -- dlist )
|
||||||
GL_COMPILE [
|
GL_COMPILE [
|
||||||
|
@ -30,7 +30,7 @@ C: <texture-info> texture-info
|
||||||
{ [ dim>> ] [ bitmap>> ] [ format>> ] [ type>> ] }
|
{ [ dim>> ] [ bitmap>> ] [ format>> ] [ type>> ] }
|
||||||
cleave make-texture
|
cleave make-texture
|
||||||
] [ dim>> ] bi
|
] [ dim>> ] bi
|
||||||
over make-texture-display-list 0 f texture boa ;
|
over make-texture-display-list f texture boa ;
|
||||||
|
|
||||||
M: texture dispose*
|
M: texture dispose*
|
||||||
[ texture>> delete-texture ]
|
[ texture>> delete-texture ]
|
||||||
|
|
Loading…
Reference in New Issue