(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE (DEFPACKAGE "CASH-FILE" (USE "LISP" "XCL")))

(IL:FILECREATED "11-Jun-90 14:33:44" IL:|{DSK}<usr>local>lde>lispcore>library>CASH-FILE.;2|
 6688   

      IL:|changes| IL:|to:|  (IL:VARS IL:CASH-FILECOMS)

      IL:|previous| IL:|date:| " 9-Oct-87 11:22:19" 
IL:|{DSK}<usr>local>lde>lispcore>library>CASH-FILE.;1|)


; Copyright (c) 1987, 1990 by Venue & Xerox Corporation.  All rights reserved.

(IL:PRETTYCOMPRINT IL:CASH-FILECOMS)

(IL:RPAQQ IL:CASH-FILECOMS

          ((IL:P (PROVIDE "CASH-FILE")
                 (EXPORT '(MAKE-CASH-FILE OPEN-CASH-FILE GET-CASH-FILE REM-CASH-FILE CASH-FILE 
                                 CASH-FILE-P CASH-FILE-HASH-FILE)
                        "CASH-FILE")
                 (REQUIRE "HASH-FILE" "HASH-FILE.DFASL")
                 (USE-PACKAGE "HASH-FILE" "CASH-FILE"))
           (IL:STRUCTURES CASH-FILE)
           (IL:FUNCTIONS %PRINT-CASH-FILE)
           (IL:VARIABLES NOT-IN-HASH-FILE)
           (IL:FUNCTIONS MAKE-CASH-FILE OPEN-CASH-FILE GET-CASH-FILE PUT-CASH-FILE REM-CASH-FILE)
           (IL:SETFS GET-CASH-FILE)
           (IL:FUNCTIONS MOVE-TO-HEAD-OF-QUEUE ADD-TO-CACHE DEL-FROM-CACHE)
           (IL:PROP (IL:MAKEFILE-ENVIRONMENT IL:FILETYPE)
                  IL:CASH-FILE)))

(PROVIDE "CASH-FILE")

(EXPORT '(MAKE-CASH-FILE OPEN-CASH-FILE GET-CASH-FILE REM-CASH-FILE CASH-FILE CASH-FILE-P 
                CASH-FILE-HASH-FILE)
       "CASH-FILE")

(REQUIRE "HASH-FILE" "HASH-FILE.DFASL")

(USE-PACKAGE "HASH-FILE" "CASH-FILE")

(DEFSTRUCT (CASH-FILE
 (:CONSTRUCTOR MAKE-CASH-FILE-INTERNAL)
                          (:PRINT-FUNCTION %PRINT-CASH-FILE))
   (CACHE NIL :TYPE HASH-TABLE :READ-ONLY T)
   (CACHE-SIZE NIL :TYPE INTEGER :READ-ONLY T)
   (QUEUE NIL :TYPE LIST)
   (HASH-FILE NIL :TYPE HASH-FILE :READ-ONLY T))

(DEFUN %PRINT-CASH-FILE
 (CASH-FILE STREAM DEPTH)
   (FORMAT STREAM "#<Cash-File on ~A>" (LET* ((STREAM (HASH-FILE::HASH-FILE-STREAM (
                                                                                  CASH-FILE-HASH-FILE
                                                                                    CASH-FILE)))
                                              (NAMESTRING (NAMESTRING (PATHNAME STREAM))))
                                             (IF NAMESTRING
                                                 NAMESTRING
                                                 STREAM))))

(DEFCONSTANT NOT-IN-HASH-FILE
 '(NOT-IN-HASH-FILE))

(DEFUN MAKE-CASH-FILE
 (FILE-NAME SIZE CACHE-SIZE)
   (MAKE-CASH-FILE-INTERNAL :HASH-FILE (MAKE-HASH-FILE FILE-NAME SIZE)
          :CACHE
          (MAKE-HASH-TABLE :SIZE CACHE-SIZE :TEST 'EQUAL)
          :CACHE-SIZE CACHE-SIZE))

(DEFUN OPEN-CASH-FILE
 (FILE-NAME CACHE-SIZE &KEY (DIRECTION :INPUT))
   (MAKE-CASH-FILE-INTERNAL :HASH-FILE (OPEN-HASH-FILE FILE-NAME :DIRECTION DIRECTION)
          :CACHE
          (MAKE-HASH-TABLE :SIZE CACHE-SIZE :TEST 'EQUAL)
          :CACHE-SIZE CACHE-SIZE))

(DEFUN GET-CASH-FILE
 (KEY CASH-FILE &OPTIONAL DEFAULT)
   (MULTIPLE-VALUE-BIND (VALUE FOUND?)
          (GETHASH KEY (CASH-FILE-CACHE CASH-FILE))
          (COND
             (FOUND? 

                    (IL:* IL:|;;| "cache hit ")


                    (MOVE-TO-HEAD-OF-QUEUE KEY CASH-FILE)
                    (IF (EQ VALUE NOT-IN-HASH-FILE)

                        (IL:* IL:|;;| "it was a cached miss")


                        (VALUES DEFAULT NIL)

                        (IL:* IL:|;;| "it was a cached hit")


                        (VALUES 

                               (IL:* IL:|;;| 

           "return a copy to be compatable with GET-HASH-FILE which always hands you new structure")


                               (COPY-TREE VALUE)
                               T)))
             (T 
                (IL:* IL:|;;| "try the HASH-FILE")


                (MULTIPLE-VALUE-SETQ (VALUE FOUND?)
                       (GET-HASH-FILE KEY (CASH-FILE-HASH-FILE CASH-FILE)))

                (IL:* IL:|;;| "cache what we found")


                (ADD-TO-CACHE KEY (IF FOUND?

                                      (IL:* IL:|;;| "cache the VALUE")


                                      VALUE

                                      (IL:* IL:|;;| "cache the miss")


                                      NOT-IN-HASH-FILE)
                       CASH-FILE)

                (IL:* IL:|;;| "return VALUE or DEFAULT")


                (IF FOUND?
                    (VALUES VALUE T)
                    (VALUES DEFAULT NIL))))))

(DEFUN PUT-CASH-FILE
 (KEY CASH-FILE VALUE)

   (IL:* IL:|;;| "add it to the hash file")


   (SETF (GET-HASH-FILE KEY (CASH-FILE-HASH-FILE CASH-FILE))
         VALUE)

   (IL:* IL:|;;| "add it to the cache")


   (ADD-TO-CACHE KEY VALUE CASH-FILE)
   VALUE)

(DEFUN REM-CASH-FILE
 (KEY CASH-FILE)
   (LET ((FOUND? (REM-HASH-FILE KEY (CASH-FILE-HASH-FILE CASH-FILE))))
        (WHEN FOUND? (DEL-FROM-CACHE KEY CASH-FILE))
        FOUND?))

(DEFSETF GET-CASH-FILE
 PUT-CASH-FILE)

(DEFUN MOVE-TO-HEAD-OF-QUEUE
 (KEY CASH-FILE)
   (SETF (CASH-FILE-QUEUE CASH-FILE)
         (DELETE KEY (CASH-FILE-QUEUE CASH-FILE)
                :TEST
                'EQUAL :COUNT 1))
   (PUSH KEY (CASH-FILE-QUEUE CASH-FILE)))

(DEFUN ADD-TO-CACHE
 (KEY VALUE CASH-FILE)
   (LET ((CACHE (CASH-FILE-CACHE CASH-FILE)))
        (IF (>= (HASH-TABLE-COUNT CACHE)
                (CASH-FILE-CACHE-SIZE CASH-FILE))

            (IL:* IL:|;;| "cache is full -- throw out last entry")


            (DEL-FROM-CACHE (CAR (LAST (CASH-FILE-QUEUE CASH-FILE)))
                   CASH-FILE))

        (IL:* IL:|;;| "store VALUE in the cache")


        (SETF (GETHASH KEY CACHE)
              VALUE)

        (IL:* IL:|;;| "put the KEY at the head of the QUEUE")


        (PUSH KEY (CASH-FILE-QUEUE CASH-FILE))
        VALUE))

(DEFUN DEL-FROM-CACHE
 (KEY CASH-FILE)

   (IL:* IL:|;;| "delete it from the queue")


   (SETF (CASH-FILE-QUEUE CASH-FILE)
         (DELETE KEY (CASH-FILE-QUEUE CASH-FILE)
                :TEST
                'EQUAL :COUNT 1))

   (IL:* IL:|;;| "delete it from the cache")


   (REMHASH KEY (CASH-FILE-CACHE CASH-FILE)))

(IL:PUTPROPS IL:CASH-FILE
 IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "XCL" :PACKAGE
                                                                 (DEFPACKAGE "CASH-FILE"
                                                                        (:USE "LISP" "XCL"))))

(IL:PUTPROPS IL:CASH-FILE
 IL:FILETYPE
 :XCL-COMPILE-FILE)
(IL:PUTPROPS IL:CASH-FILE IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1990))
(IL:DECLARE\: IL:DONTCOPY
  (IL:FILEMAP (NIL)))
IL:STOP