From b28c3cdfa12e983ab0af40a31e31843dc2c8a0c2 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Fri, 23 Sep 2011 17:29:43 -0400
Subject: [PATCH] caching without sqlite

---
 js-assembler/hash-cache.rkt | 94 +++++++++++++++++++++++++++++++++++++
 js-assembler/package.rkt    | 23 +++++----
 2 files changed, 108 insertions(+), 9 deletions(-)
 create mode 100644 js-assembler/hash-cache.rkt

diff --git a/js-assembler/hash-cache.rkt b/js-assembler/hash-cache.rkt
new file mode 100644
index 0000000..663e832
--- /dev/null
+++ b/js-assembler/hash-cache.rkt
@@ -0,0 +1,94 @@
+#lang racket/base
+
+;; on-disk hashtable cache.
+
+(require (prefix-in whalesong: "../version.rkt")
+         racket/runtime-path
+         racket/file
+         file/md5)
+
+
+(define cache-directory-path
+  (build-path (find-system-path 'pref-dir)
+              "whalesong"))
+
+(provide cached? save-in-cache!)
+
+
+;; create-cache-directory!: -> void
+(define (create-cache-directory!)
+  (unless (directory-exists? cache-directory-path)
+    (make-directory* cache-directory-path)))
+  
+
+;; clear-cache-files!: -> void
+;; Remove all the cache files.
+(define (clear-cache-files!)
+  (for ([file (directory-list cache-directory-path)])
+    (when (file-exists? (build-path cache-directory-path file))
+      (with-handlers ([exn:fail? void])
+        (delete-file (build-path cache-directory-path file))))))
+
+
+(define whalesong-cache.scm
+  (build-path cache-directory-path 
+              (format "whalesong-cache-~a.scm"
+                      whalesong:version)))
+
+
+(define (ensure-cache-db-structure!)
+  (when (not (file-exists? whalesong-cache.scm))
+    ;; Clear existing cache files: they're obsolete.
+    (clear-cache-files!)
+    (call-with-output-file whalesong-cache.scm
+      (lambda (op)
+        (write (make-hash) op)))))
+    
+
+
+(define (get-db)
+  (hash-copy (call-with-input-file whalesong-cache.scm read)))
+
+
+(define (write-db! hash)
+  (call-with-output-file whalesong-cache.scm
+    (lambda (op) (write hash op))
+    #:exists 'replace))
+
+
+
+
+(create-cache-directory!)
+(ensure-cache-db-structure!)
+(define db (get-db))
+
+
+
+
+;; cached?: path -> (U false bytes)
+;; Returns a true value, (vector path md5-signature data), if we can
+;; find an appropriate entry in the cache, and false otherwise.
+(define (cached? path)
+  (cond
+    [(file-exists? path)
+     (hash-ref db
+               (list (path->string path)
+                     (call-with-input-file* path md5))
+               #f)]
+    [else
+     #f]))
+
+
+;; save-in-cache!: path bytes -> void
+;; Saves a record.
+(define (save-in-cache! path data)
+  (cond
+    [(file-exists? path)
+     (define signature (call-with-input-file* path md5))
+     (hash-set! db
+                (list (path->string path)
+                      signature)
+                data)
+     (write-db! db)]
+    [else
+     (error 'save-in-cache! "File ~e does not exist" path)]))
\ No newline at end of file
diff --git a/js-assembler/package.rkt b/js-assembler/package.rkt
index 050c824..bececba 100644
--- a/js-assembler/package.rkt
+++ b/js-assembler/package.rkt
@@ -29,14 +29,19 @@
 ;; because not everyone's going to have Sqlite3 installed.
 ;; If this fails, just gracefully fall back to no caching.
 (define-runtime-path db-cache.rkt "db-cache.rkt")
-(define-values (db-cache:cached? db-cache:save-in-cache!)
-  (with-handlers ([exn:fail?
+(define-runtime-path hash-cache.rkt "hash-cache.rkt")
+(define-values (impl-cached? impl-save-in-cache!)
+  (values (dynamic-require `(file ,(path->string hash-cache.rkt)) 
+                           'cached?)
+          (dynamic-require `(file ,(path->string hash-cache.rkt)) 
+                           'save-in-cache!))
+  #;(with-handlers ([exn:fail?
                    (lambda (exn)
-                     (log-debug "Unable to use Sqlite3 cache.  Falling back to no-cache.")
-                     (values (lambda (path)
-                               #f)
-                             (lambda (path data)
-                               (void))))])
+                     (log-debug "Unable to use Sqlite3 cache.  Falling back to serialized hashtable cache.")
+                     (values (dynamic-require `(file ,(path->string hash-cache.rkt)) 
+                                              'cached?)
+                             (dynamic-require `(file ,(path->string hash-cache.rkt)) 
+                                              'save-in-cache!)))])
     (parameterize ([current-namespace (make-base-namespace)])
       (values
        (dynamic-require `(file ,(path->string db-cache.rkt)) 
@@ -399,7 +404,7 @@ M.modules[~s] =
 ;; Returns a true value (the cached bytes) if we've seen this path
 ;; and know its JavaScript-compiled bytes.
 (define (cached? path)
-  (db-cache:cached? path))
+  (impl-cached? path))
 
 
 
@@ -416,7 +421,7 @@ M.modules[~s] =
 ;; TODO: Needs to sign with the internal version of Whalesong, and
 ;; the md5sum of the path's content.
 (define (save-in-cache! path bytes)
-  (db-cache:save-in-cache! path bytes))
+  (impl-save-in-cache! path bytes))