From 81a671dea7a41bb7c607bbacf1b6744bb238a57b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Thu, 16 Feb 2023 21:32:51 +0100 Subject: [PATCH] cmp: defun-cached: fix reset-cache and a declaration reset-cache did cons a new array but did not assign it to the cache variable so it was essentially a no-op. Also we bind cache to lexvar and then declare that lexvar to preserve declaration semantics. --- src/cmp/cmputil.lsp | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 356176dfe..47a3aa976 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -488,18 +488,20 @@ comparing circular objects." ((EQUAL EQUAL-WITH-CIRCULARITY) 'SI::HASH-EQUAL) (t (setf test 'EQUALP) 'SI::HASH-EQUALP)))) `(progn - (eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter ,cache-name (make-array 1024 :element-type t :adjustable nil))) - (defun ,reset-name () + (defvar ,cache-name (make-array 1024 :element-type t :adjustable nil)) + (defun ,reset-name () + (setf ,cache-name + (make-array 1024 :element-type t :adjustable nil))) (defun ,name ,lambda-list (flet ((,name ,lambda-list ,@body)) (let* ((hash (logand (,hash-function ,@lambda-list) 1023)) - (elt (aref ,cache-name hash))) + (cache ,cache-name) + (elt (aref cache hash))) (declare (type (integer 0 1023) hash) - (type (array t (*)) ,cache-name)) + (type (array t (*)) cache)) (if (and elt ,@(loop for arg in lambda-list - collect `(,test (pop (ext:truly-the cons elt)) ,arg))) + collect `(,test (pop (ext:truly-the cons elt)) ,arg))) (first (ext:truly-the cons elt)) (let ((output (,name ,@lambda-list))) (setf (aref ,cache-name hash) (list ,@lambda-list output))