Preparation to use (cache) for (net oauth)...

Author: ktakashi

sitelib/cache.scm

@@ -0,0 +1,43 @@
+;;; -*- mode:scheme; coding: utf-8; -*-
+;;;
+;;; cache.scm - Cache
+;;;
+;;;   Copyright (c) 2026  Takashi Kato  <ktakashi@ymail.com>
+;;;
+;;;   Redistribution and use in source and binary forms, with or without
+;;;   modification, are permitted provided that the following conditions
+;;;   are met:
+;;;
+;;;   1. Redistributions of source code must retain the above copyright
+;;;      notice, this list of conditions and the following disclaimer.
+;;;
+;;;   2. Redistributions in binary form must reproduce the above copyright
+;;;      notice, this list of conditions and the following disclaimer in the
+;;;      documentation and/or other materials provided with the distribution.
+;;;
+;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
+;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;
+
+#!nounbound
+(library (cache)
+    (export cache?
+	    cache-put!
+	    cache-get
+	    cache-evict!
+	    cache-clear!
+	    cache-size
+	    cache-values
+	    <lru-cache> lru-cache? make-lru-cache
+	    make-simple-lru-cache)
+    (import (cache apis)
+	    (cache lru)))

sitelib/cache/apis.scm

@@ -30,7 +30,7 @@
 
 #!nounbound
 (library (cache apis)
-    (export <cache>
+    (export <cache> cache?
 	    cache-put!
 	    cache-get
 	    cache-evict!
@@ -62,6 +62,8 @@
    (evict-strategy :init-keyword :evict-strategy :init-value #f)
    (on-evict :init-keyword :on-evict :init-value #f)))
 
+(define (cache? o) (is-a? o <cache>))
+
 (define-method initialize ((o <cache>) initargs)
   (call-next-method)
   (let ((c (slot-ref o 'comparator)))

sitelib/cache/lru.scm

@@ -31,7 +31,9 @@
 #!nounbound
 (library (cache lru)
     (export make-simple-lru-cache
-	    <lru-cache>)
+	    <lru-cache>
+	    lru-cache?
+	    make-lru-cache)
     (import (rnrs)
 	    (clos user)
 	    (cache apis)
@@ -45,6 +47,10 @@
 (define-class <lru-cache> (<cache>)
   ((queue :init-value '())
    equal?))
+(define (lru-cache? o) (is-a? o <lru-cache>))
+(define (make-lru-cache size :key (comparator default-comparator) (on-evict #f))
+  (make <lru-cache> :evict-strategy (strategy size) :comparator comparator
+	:on-evict on-evict))
 
 (define-method initialize ((o <lru-cache>) initargs)
   (cond ((get-keyword :max-size initargs #f) =>
@@ -78,8 +84,7 @@
 
 (define (make-simple-lru-cache size create 
 			       :optional (comparator default-comparator))
-  (define cache (make <lru-cache> :evict-strategy (strategy size)
-		      :comparator comparator))
+  (define cache (make-lru-cache size :comparator comparator))
   (define mark (list 'not-found))
   (lambda (name)
     (let ((r (cache-get cache name mark)))

test/tests/cache/lru.scm

@@ -1,6 +1,5 @@
 (import (rnrs) 
-	(cache lru)
-	(cache apis)
+	(cache)
 	(clos user)
 	(sagittarius regex)
 	(sagittarius comparators)
@@ -49,6 +48,8 @@
   (define cache (make <lru-cache> :max-size 1 :comparator eq-comparator))
   (define first (list 'ok))
   (define second (list 'ok))
+  (test-assert (cache? cache))
+  (test-assert "lru-cache?" (lru-cache? cache))
   (test-assert (cache-put! cache first 'ok))
   (test-equal 'ok (cache-get cache first))
 
@@ -61,11 +62,13 @@
   )
 
 (let ((count 0))
-  (define cache (make <lru-cache> :max-size 2 :comparator eq-comparator
+  (define cache (make-lru-cache 2 :comparator eq-comparator
 		      :on-evict (lambda (o) (set! count (+ count 1)))))
   (define first (list 'ok))
   (define second (list 'ok))
   (define third (list 'ok))
+  (test-assert (cache? cache))
+  (test-assert "lru-cache?" (lru-cache? cache))
   (cache-put! cache first '1st)
   (cache-put! cache second '2nd)
   (cache-put! cache third '3rd)