home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / csys / unit-cache.scm < prev    next >
Encoding:
Text File  |  1994-09-27  |  1.3 KB  |  48 lines  |  [TEXT/CCL2]
  1.  
  2. ;;;=====================================================================
  3. ;;; Cache manager
  4. ;;;=====================================================================
  5.  
  6. ;;; This is the cache manager for compilation units.  We use an alist at
  7. ;;; the moment.
  8.  
  9. (define *unit-cache* '())
  10.  
  11. (define (reset-unit-cache)
  12.   (setf *unit-cache* '()))
  13.  
  14.  
  15. ;;; This checks to make sure that the compilation unit it finds
  16. ;;; in the cache has not been made out-of-date by updates to the unit file.
  17.  
  18. (define (lookup-compilation-unit name)
  19.   (let ((r (ass-string name *unit-cache*)))
  20.     (if r
  21.     (let ((c  (cdr r)))
  22.      (if (ucache-stable? c)
  23.          c
  24.          (if (and (file-exists? (ucache-ufile c))
  25.               (< (ucache-udate c) (file-write-date (ucache-ufile c))))
  26.          '#f  ; unit file modified
  27.          c))) ; unit valid
  28.     '#f)))
  29.  
  30. ;;; This is used as an after compilation lookup where no check of the file
  31. ;;; updates is needed.
  32.  
  33. (define (lookup-compiled-unit name)
  34.   (let ((r (ass-string name *unit-cache*)))
  35.     (cdr r)))
  36.  
  37. (define (install-compilation-unit name c)
  38.   (let ((r (ass-string name *unit-cache*)))
  39.     (if (eq? r '#f)
  40.     (push (cons name c) *unit-cache*)
  41.     (setf (cdr r) c))))
  42.  
  43. ;;; This is used to examine the cache for units to be uncached.
  44.  
  45. (define (for-all-cached-units p)
  46.   (dolist (c *unit-cache*)
  47.     (funcall p (tuple-2-2 c))))
  48.