]> gitweb.factorcode.org Git - factor.git/commitdiff
memoize: fix a few more zero input cases
authorJohn Benediktsson <mrjbq7@gmail.com>
Wed, 5 Apr 2023 22:24:24 +0000 (15:24 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Wed, 5 Apr 2023 22:24:24 +0000 (15:24 -0700)
core/memoize/memoize-tests.factor
core/memoize/memoize.factor

index 809cae2794ac5dbce8e3a5252f888bcd45bcff1e..87408ee3131307486c2f50a135d81656494b4d56 100644 (file)
@@ -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
index 96e5952ca9c74661ed22253852b47695e6ff996d..e209de08e2bcb402924703762e408a38c0f44c16 100644 (file)
@@ -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 ;