summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDan Leslie <dan@ironoxide.ca>2015-10-03 14:34:21 -0700
committerDan Leslie <dan@ironoxide.ca>2015-10-03 14:34:21 -0700
commitea8d1f97119bdd058ae918ca7f7fcb3279b70a7f (patch)
treeaab55e1ce463234fc22e35d1d8a4f38ba4b8860e
parent57d6934beb882c6dcd7119f7a2ebe04ab977b9c5 (diff)
downloadgeiser-chez-ea8d1f97119bdd058ae918ca7f7fcb3279b70a7f.tar.gz
geiser-chez-ea8d1f97119bdd058ae918ca7f7fcb3279b70a7f.tar.bz2
Adds memoization
Clears memo when anything other than a safe geiser call is made. Removes the last calls to regex within the thing
-rw-r--r--scheme/chicken/geiser/emacs.scm50
1 files changed, 36 insertions, 14 deletions
diff --git a/scheme/chicken/geiser/emacs.scm b/scheme/chicken/geiser/emacs.scm
index df804c3..09a3068 100644
--- a/scheme/chicken/geiser/emacs.scm
+++ b/scheme/chicken/geiser/emacs.scm
@@ -5,8 +5,7 @@
;; have received a copy of the license along with this program. If
;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
-(module geiser
- ;; A bunch of these needn't be toplevel functions
+(module geiser
(geiser-eval
geiser-no-values
geiser-newline
@@ -37,10 +36,11 @@
extras
ports
posix
- regex
srfi-1
srfi-13
+ srfi-14
srfi-18
+ srfi-69
tcp
utils)
@@ -219,8 +219,17 @@
(define module-name ##sys#module-name)
(define (list-modules) (map car ##sys#module-table))
- (define debug-log (make-parameter #f))
+ (define memo (make-parameter (make-hash-table)))
+ (define (clear-memo) (hash-table-clear! (memo)))
+ (define (memoize tag thunk)
+ (let ((table (memo)))
+ (if (hash-table-exists? table tag)
+ (hash-table-ref table tag)
+ (begin
+ (hash-table-set! table tag (thunk))
+ (memoize tag thunk)))))
+ (define debug-log (make-parameter #f))
(define (write-to-log form)
(when (geiser-use-debug-log)
(when (not (debug-log))
@@ -390,7 +399,8 @@
(args (if (or (list? rest) (pair? rest)) (cdr rest) '())))
(define (clean-arg arg)
- (string->symbol (string-substitute "(.*[^0-9]+)[0-9]+" "\\1" (->string arg))))
+ (let ((s (->string arg)))
+ (substring/shared s 0 (string-skip-right s char-set:digit))))
(define (collect-args args #!key (reqs? #t) (opts? #f) (keys? #f))
(when (not (null? args))
@@ -452,7 +462,7 @@
(or (not filter-for-type)
(eq? (node-type n) filter-for-type)))
(match-nodes symbol))))))
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Geiser core functions
@@ -463,24 +473,36 @@
(define (geiser-eval module form . rest)
;; We can't allow nested module definitions in Chicken
(define (form-has-module? form)
- (let ((reg "\\( *module +|\\( *define-library +"))
- (string-search reg form)))
-
+ (or (eq? (car form) 'module) (eq? (car form) 'define-library)))
+
+ (define (form-has-safe-geiser? form)
+ (any (cut eq? (car form) <>)
+ '(geiser-no-values geiser-newline geiser-start-server geiser-completions
+ geiser-autodoc geiser-object-signature geiser-symbol-location
+ geiser-symbol-documentation geiser-find-file geiser-add-to-load-path
+ geiser-module-exports geiser-module-path geiser-module-location
+ geiser-module-completions geiser-macroexpand geiser-use-debug-log)))
+
(when (and module
(not (symbol? module)))
(error "Module should be a symbol"))
;; All calls start at toplevel
- (let* ((str-form (format "~s" form))
- (is-module? (form-has-module? str-form))
+ (let* ((is-module? (form-has-module? form))
+ (is-safe-geiser? (form-has-safe-geiser? form))
(host-module (and (not is-module?)
(any (cut equal? module <>) (list-modules))
- module)))
+ module))
+ (thunk (lambda () (eval form))))
- (write-to-log '[[REQUEST]])
+ (write-to-log `[[REQUEST host-module ,host-module is-safe-geiser? ,is-safe-geiser?]])
(write-to-log form)
- (call-with-result host-module (lambda () (eval form)))))
+ (if is-safe-geiser?
+ (call-with-result host-module (lambda () (memoize form thunk)))
+ (begin
+ (clear-memo)
+ (call-with-result host-module thunk)))))
;; Load a file