From c8221b9f2a7e94e6fdae7c8b15bd51dc8f1d4caa Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Tue, 17 Jul 2012 17:51:15 -0700 Subject: [PATCH] memoize: speed up memoized functions with no arguments. --- basis/memoize/memoize.factor | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/basis/memoize/memoize.factor b/basis/memoize/memoize.factor index 71580257dd..bd0cd8d77c 100644 --- a/basis/memoize/memoize.factor +++ b/basis/memoize/memoize.factor @@ -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 ;