From a937766d2f1c0866fbe8433f3a121f346c8a33ca Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 5 Apr 2023 15:24:24 -0700 Subject: [PATCH] memoize: fix a few more zero input cases --- core/memoize/memoize-tests.factor | 15 +++++++++++++++ core/memoize/memoize.factor | 18 +++++++++--------- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/core/memoize/memoize-tests.factor b/core/memoize/memoize-tests.factor index 809cae2794..87408ee313 100644 --- a/core/memoize/memoize-tests.factor +++ b/core/memoize/memoize-tests.factor @@ -59,3 +59,18 @@ MEMO: bar ( -- x ) bar-counter counter ; bar bar ] unit-test + +SYMBOL: baz-counter +0 baz-counter set-global + +MEMO: baz ( -- x ) baz-counter counter drop f ; + +{ 0 f 1 f 1 f 1 } [ + baz-counter get-global + baz + baz-counter get-global + baz + baz-counter get-global + baz + baz-counter get-global +] unit-test diff --git a/core/memoize/memoize.factor b/core/memoize/memoize.factor index 96e5952ca9..e209de08e2 100644 --- a/core/memoize/memoize.factor +++ b/core/memoize/memoize.factor @@ -23,7 +23,7 @@ IN: memoize : packer ( seq -- quot ) length dup 4 <= - [ { [ t ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ] + [ { [ f ] [ ] [ 2array ] [ 3array ] [ 4array ] } nth ] [ { } [nsequence] ] if ; : unpacker ( seq -- quot ) @@ -44,9 +44,9 @@ IN: memoize : make/0 ( table quot effect -- quot ) out>> [ packer '[ - _ - [ first-unsafe ] - [ @ @ [ 0 rot set-nth-unsafe ] keep ] ?unless + _ dup first-unsafe dup null eq? [ + drop @ @ [ 0 rot set-nth-unsafe ] keep + ] [ nip ] if ] ] keep unpacker compose ; @@ -62,11 +62,11 @@ PRIVATE> 3tri ; : define-memoized ( word quot effect -- ) - dup in>> length zero? [ f 1array ] [ H{ } clone ] if + dup in>> length zero? [ null 1array ] [ H{ } clone ] if (define-memoized) ; : define-identity-memoized ( word quot effect -- ) - dup in>> length zero? [ f 1array ] [ IH{ } clone ] if + dup in>> length zero? [ null 1array ] [ IH{ } clone ] if (define-memoized) ; PREDICATE: memoized < word "memoize" word-prop >boolean ; @@ -83,18 +83,18 @@ M: memoized reset-word bi ; : memoize-quot ( quot effect -- memo-quot ) - dup in>> length zero? [ f 1array ] [ H{ } clone ] if + dup in>> length zero? [ null 1array ] [ H{ } clone ] if -rot make-memoizer ; : reset-memoized ( word -- ) "memoize" word-prop dup sequence? - [ f swap set-first ] [ clear-assoc ] if ; + [ null swap set-first ] [ clear-assoc ] if ; : invalidate-memoized ( inputs... word -- ) [ stack-effect in>> packer call ] [ "memoize" word-prop dup sequence? - [ f swap set-first ] [ delete-at ] if + [ null swap set-first ] [ delete-at ] if ] bi ; -- 2.34.1