summaryrefslogtreecommitdiff
path: root/scheme
diff options
context:
space:
mode:
authorDan Leslie <dan@ironoxide.ca>2015-10-03 12:39:05 -0700
committerDan Leslie <dan@ironoxide.ca>2015-10-03 12:44:04 -0700
commit57d6934beb882c6dcd7119f7a2ebe04ab977b9c5 (patch)
tree7da2cbe82250c6daa5012b47b96883e27fa5d351 /scheme
parentd109d97c262e1e20de62bfdd74f421f911494405 (diff)
downloadgeiser-chez-57d6934beb882c6dcd7119f7a2ebe04ab977b9c5.tar.gz
geiser-chez-57d6934beb882c6dcd7119f7a2ebe04ab977b9c5.tar.bz2
Converts toplevel methods to prefixed methods
This seems to improve speed; in a large environment I witnessed a regular 100ms increase in speed for autodoc.
Diffstat (limited to 'scheme')
-rw-r--r--scheme/chicken/geiser/emacs.scm114
1 files changed, 32 insertions, 82 deletions
diff --git a/scheme/chicken/geiser/emacs.scm b/scheme/chicken/geiser/emacs.scm
index 0e47e98..df804c3 100644
--- a/scheme/chicken/geiser/emacs.scm
+++ b/scheme/chicken/geiser/emacs.scm
@@ -311,28 +311,6 @@
(newline)))
- (define geiser-toplevel-functions (make-parameter '()))
-
- ;; This macro aids in the creation of toplevel definitions for the interpreter which are also available to code
- ;; toplevel passes parameters via the current-input-port, and so in order to make the definition behave nicely
- ;; in both usage contexts I defined a (get-arg) function which iteratively pulls arguments either from the
- ;; input port or from the variable arguments, depending on context.
- (define-syntax define-toplevel-for-geiser
- (lambda (f r c)
- (let* ((name (cadr f))
- (body (cddr f)))
- `(begin
- (,(r 'define) (,name . !!args)
- (,(r 'define) !!read-arg (null? !!args))
- (,(r 'define) (get-arg)
- (if !!read-arg
- (read)
- (let ((arg (car !!args)))
- (set! !!args (cdr !!args))
- arg)))
- (begin ,@body))
- (,(r 'geiser-toplevel-functions) (cons (cons ',name ,name) (geiser-toplevel-functions)))))))
-
(define (find-standards-with-symbol sym)
(append
(if (any (cut eq? <> sym) (geiser-r4rs-symbols))
@@ -444,7 +422,7 @@
("module" ,@(make-module-list sym module))))))))
;; Builds a signature list from an identifier
- (define (find-signatures toplevel-module sym)
+ (define (find-signatures sym)
(let ((str (->string sym)))
(map
(cut fmt sym <>)
@@ -457,7 +435,7 @@
(let-values
(((name module) (remove-internal-name-mangling (car s))))
(cons (string->symbol name)
- (cons (if (symbol? module) (string->symbol module) '())
+ (cons (if (string? module) (string->symbol module) module)
(cdr s)))))
(apropos-information-list sym #:macros? #t))))))
@@ -475,64 +453,39 @@
(eq? (node-type n) filter-for-type)))
(match-nodes symbol))))))
- (define (make-geiser-toplevel-bindings)
- (map
- (lambda (pair)
- (toplevel-command (car pair) (cdr pair)))
- (geiser-toplevel-functions)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Geiser toplevel functions
+;; Geiser core functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Basically all non-core functions pass through geiser-eval
- (define-toplevel-for-geiser geiser-eval
+ (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)))
- ;; Chicken doesn't support calling toplevel functions through eval,
- ;; So when we're in a module or calling into an environment we have
- ;; to first call from the toplevel environment and then switch
- ;; into the desired env.
- (define (form-has-geiser? form)
- (let ((reg "\\( *geiser-"))
- (string-search reg form)))
+ (when (and module
+ (not (symbol? module)))
+ (error "Module should be a symbol"))
;; All calls start at toplevel
- (let* ((module (get-arg))
- (form (get-arg))
- (str-form (format "~s" form))
+ (let* ((str-form (format "~s" form))
(is-module? (form-has-module? str-form))
- (is-geiser? (form-has-geiser? str-form))
(host-module (and (not is-module?)
- (not is-geiser?)
(any (cut equal? module <>) (list-modules))
module)))
- (when (and module (not (symbol? module)))
- (error "Module should be a symbol"))
-
- ;; Inject the desired module as the first parameter
- (when is-geiser?
- (let ((module (maybe-call (lambda (v) (symbol->string module)) module)))
- (set! form (cons (car form) (cons module (cdr form))))))
-
- (define (thunk)
- (eval form))
-
(write-to-log '[[REQUEST]])
(write-to-log form)
- (call-with-result host-module thunk)))
+ (call-with-result host-module (lambda () (eval form)))))
;; Load a file
- (define-toplevel-for-geiser geiser-load-file
- (let* ((file (get-arg))
- (file (if (symbol? file) (symbol->string file) file))
+ (define (geiser-load-file file)
+ (let* ((file (if (symbol? file) (symbol->string file) file))
(found-file (geiser-find-file #f file)))
(call-with-result #f
(lambda ()
@@ -541,7 +494,7 @@
;; The no-values identity
- (define-toplevel-for-geiser geiser-no-values
+ (define (geiser-no-values)
(values))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -578,38 +531,38 @@
;; Completions, Autodoc and Signature
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (define (geiser-completions toplevel-module prefix . rest)
+ (define (geiser-completions prefix . rest)
(let ((prefix (->string prefix))
(unfiltered (map remove-internal-name-mangling
(apropos-list prefix #:macros? #t))))
(filter (cut string-has-prefix? <> prefix) unfiltered)))
- (define (geiser-module-completions toplevel-module prefix . rest)
+ (define (geiser-module-completions prefix . rest)
(let ((prefix (->string prefix)))
(filter (cut string-has-prefix? <> prefix) (map ->string (list-modules)))))
- (define (geiser-autodoc toplevel-module ids . rest)
+ (define (geiser-autodoc ids . rest)
(cond
((null? ids) '())
((not (list? ids))
- (geiser-autodoc toplevel-module (list ids)))
+ (geiser-autodoc (list ids)))
(else
- (let ((details (find-signatures toplevel-module (car ids))))
+ (let ((details (find-signatures (car ids))))
(if (null? details)
- (geiser-autodoc toplevel-module (cdr ids))
+ (geiser-autodoc (cdr ids))
details)))))
- (define (geiser-object-signature toplevel-module name object . rest)
- (let* ((sig (geiser-autodoc toplevel-module `(,name))))
+ (define (geiser-object-signature name object . rest)
+ (let* ((sig (geiser-autodoc `(,name))))
(if (null? sig) '() (car sig))))
;; TODO: Divine some way to support this functionality
- (define (geiser-symbol-location toplevel-module symbol . rest)
+ (define (geiser-symbol-location symbol . rest)
'(("file") ("line")))
- (define (geiser-symbol-documentation toplevel-module symbol . rest)
- (let* ((sig (find-signatures toplevel-module symbol)))
+ (define (geiser-symbol-documentation symbol . rest)
+ (let* ((sig (find-signatures symbol)))
`(("signature" ,@(car sig))
("docstring" . ,(make-doc symbol)))))
@@ -619,7 +572,7 @@
(define geiser-load-paths (make-parameter '()))
- (define (geiser-find-file toplevel-module file . rest)
+ (define (geiser-find-file file . rest)
(let ((paths (append '("" ".") (geiser-load-paths))))
(define (try-find file paths)
(cond
@@ -629,7 +582,7 @@
(else (try-find file (cdr paths)))))
(try-find file paths)))
- (define (geiser-add-to-load-path toplevel-module directory . rest)
+ (define (geiser-add-to-load-path directory . rest)
(let* ((directory (if (symbol? directory)
(symbol->string directory)
directory))
@@ -641,9 +594,9 @@
(when (directory-exists? directory)
(geiser-load-paths (cons directory (geiser-load-paths))))))))
- (define (geiser-compile-file toplevel-module file . rest)
+ (define (geiser-compile-file file . rest)
(let* ((file (if (symbol? file) (symbol->string file) file))
- (found-file (geiser-find-file toplevel-module file)))
+ (found-file (geiser-find-file file)))
(call-with-result #f
(lambda ()
(when found-file
@@ -651,7 +604,7 @@
;; TODO: Support compiling regions
- (define (geiser-compile toplevel-module form module . rest)
+ (define (geiser-compile form module . rest)
(error "Chicken does not support compiling regions"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -660,7 +613,7 @@
;; Should return:
;; '(("modules" . sub-modules) ("procs" . procedures) ("syntax" . macros) ("vars" . variables))
- (define (geiser-module-exports toplevel-module module-name . rest)
+ (define (geiser-module-exports module-name . rest)
(let* ((nodes (match-nodes module-name)))
(if (null? nodes)
'()
@@ -690,26 +643,23 @@
;; Returns the path for the file in which an egg or module was defined
- (define (geiser-module-path toplevel-module module-name . rest)
+ (define (geiser-module-path module-name . rest)
#f)
;; Returns:
;; `(("file" . ,(module-path name)) ("line"))
- (define (geiser-module-location toplevel-module name . rest)
+ (define (geiser-module-location name . rest)
#f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Misc
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (define (geiser-macroexpand toplevel-module form . rest)
+ (define (geiser-macroexpand form . rest)
(with-output-to-string
(lambda ()
(write (expand form)))))
;; End module
)
-
-(import geiser)
-(make-geiser-toplevel-bindings)