: 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>
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 ;
[ 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 ;