memoize: speed up memoized functions with no arguments.
parent
667a00a69c
commit
c8221b9f2a
|
@ -38,9 +38,19 @@ IN: memoize
|
|||
: unpack/pack ( quot effect -- newquot )
|
||||
[ in>> unpacker ] [ out>> packer ] bi surround ;
|
||||
|
||||
: make/n ( table quot effect -- quot )
|
||||
[ unpack/pack '[ _ _ cache ] ] keep pack/unpack ;
|
||||
|
||||
: make/0 ( table quot effect -- quot )
|
||||
out>> [
|
||||
packer '[
|
||||
_ dup first-unsafe
|
||||
[ nip ] [ @ @ [ 0 rot set-nth-unsafe ] keep ] if*
|
||||
]
|
||||
] keep unpacker compose ;
|
||||
|
||||
: make-memoizer ( table quot effect -- quot )
|
||||
[ unpack/pack '[ _ _ cache ] ] keep
|
||||
pack/unpack ;
|
||||
dup in>> length zero? [ make/0 ] [ make/n ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -51,10 +61,12 @@ PRIVATE>
|
|||
3tri ;
|
||||
|
||||
: define-memoized ( word quot effect -- )
|
||||
H{ } clone (define-memoized) ;
|
||||
dup in>> length zero? [ f 1array ] [ H{ } clone ] if
|
||||
(define-memoized) ;
|
||||
|
||||
: define-identity-memoized ( word quot effect -- )
|
||||
IH{ } clone (define-memoized) ;
|
||||
dup in>> length zero? [ f 1array ] [ IH{ } clone ] if
|
||||
(define-memoized) ;
|
||||
|
||||
SYNTAX: MEMO: (:) define-memoized ;
|
||||
|
||||
|
@ -75,7 +87,8 @@ M: memoized reset-word
|
|||
[ H{ } clone ] 2dip make-memoizer ;
|
||||
|
||||
: reset-memoized ( word -- )
|
||||
"memoize" word-prop clear-assoc ;
|
||||
"memoize" word-prop dup sequence?
|
||||
[ f swap set-first ] [ clear-assoc ] if ;
|
||||
|
||||
: invalidate-memoized ( inputs... word -- )
|
||||
[ stack-effect in>> packer call ] [ "memoize" word-prop delete-at ] bi ;
|
||||
|
|
Loading…
Reference in New Issue