From c8221b9f2a7e94e6fdae7c8b15bd51dc8f1d4caa Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
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 ;