From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 28 Jan 2017 11:19:02 +0000 (-0800)
Subject: Implement simple-{list,lset}-memoizer to capture common pattern.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~41
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9aa63e1c009caa1a95fe24d477d4cecdb4ecb9cb;p=mit-scheme.git

Implement simple-{list,lset}-memoizer to capture common pattern.
---

diff --git a/src/runtime/memoizer.scm b/src/runtime/memoizer.scm
index 0df1e6e2b..032edceeb 100644
--- a/src/runtime/memoizer.scm
+++ b/src/runtime/memoizer.scm
@@ -124,4 +124,23 @@ USA.
  (lambda ()
    (set! list-memoizer (make-list-memoizer make-list= #f))
    (set! lset-memoizer (make-list-memoizer make-lset= #t))
+   unspecific))
+
+(define (make-simple-list-memoizer list-memoizer)
+  (lambda (elt= get-key get-datum)
+    (let ((memoizer
+           (list-memoizer elt=
+                          (lambda (args)
+                            (apply get-key args))
+                          (lambda (args)
+                            (apply get-datum args)))))
+      (lambda args
+        (memoizer args)))))
+
+(define simple-list-memoizer)
+(define simple-lset-memoizer)
+(add-boot-init!
+ (lambda ()
+   (set! simple-list-memoizer (make-simple-list-memoizer list-memoizer))
+   (set! simple-lset-memoizer (make-simple-list-memoizer lset-memoizer))
    unspecific))
\ No newline at end of file
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 9c6caa3e6..372f7a1c1 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2547,6 +2547,8 @@ USA.
           memoizer-table
           memoizer-procedure
           memoizer?
+          simple-list-memoizer
+          simple-lset-memoizer
           weak-eqv-memoizer))
 
 (define-package (runtime history)