diff options
Diffstat (limited to 'scheme')
| -rw-r--r-- | scheme/geiser/emacs.scm | 32 | ||||
| -rw-r--r-- | scheme/geiser/eval.scm | 16 | ||||
| -rw-r--r-- | scheme/geiser/introspection.scm | 65 |
3 files changed, 106 insertions, 7 deletions
diff --git a/scheme/geiser/emacs.scm b/scheme/geiser/emacs.scm new file mode 100644 index 0000000..014c44a --- /dev/null +++ b/scheme/geiser/emacs.scm @@ -0,0 +1,32 @@ +;; emacs.scm -- procedures for emacs interaction + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sun Feb 08, 2009 18:39 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Comentary: + +;; Re-exports of procedures used by Emacs. + +;;; Code: + +(define-module (geiser emacs) + #:re-export (proc-args var-metadata) + #:use-module (geiser introspection)) + + +;;; emacs.scm ends here diff --git a/scheme/geiser/eval.scm b/scheme/geiser/eval.scm index 450221a..e6fa0cf 100644 --- a/scheme/geiser/eval.scm +++ b/scheme/geiser/eval.scm @@ -38,13 +38,13 @@ SUBR, MSG and REST." (let ((module (or (and module-name (resolve-module module-name)) (current-module)))) (catch #t - (lambda () - (let* ((result #f) - (output (with-output-to-string - (lambda () (set! result (eval form module)))))) - (list (cons 'result result) (cons 'output output)))) - (lambda (key . args) - (list (cons 'error (apply parse-error (cons key args)))))))) + (lambda () + (let* ((result #f) + (output (with-output-to-string + (lambda () (set! result (compile form module)))))) + (list (cons 'result result) (cons 'output output)))) + (lambda (key . args) + (list (cons 'error (apply parse-error (cons key args)))))))) (define (parse-error key . args) (let* ((len (length args)) @@ -57,4 +57,6 @@ SUBR, MSG and REST." (cons 'msg (if msg (apply format (cons #f (cons msg margs))) '())) (cons 'rest (or rest '()))))) +(define (test-geiser) 4) + ;;; eval.scm ends here diff --git a/scheme/geiser/introspection.scm b/scheme/geiser/introspection.scm new file mode 100644 index 0000000..eff9573 --- /dev/null +++ b/scheme/geiser/introspection.scm @@ -0,0 +1,65 @@ +;; introspection.scm -- name says it all + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sun Feb 08, 2009 18:44 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Comentary: + +;; Procedures introspecting on scheme objects and their properties. + +;;; Code: + +(define-module (geiser introspection) + #:export (proc-args var-metadata) + #:use-module (system vm program) + #:use-module (srfi srfi-1)) + +(define (proc-args proc) + (let ((proc (and (symbol? proc) + (module-bound? (current-module) proc) + (eval proc (current-module))))) + (cond ((not proc) #f) + ((program? proc) (program-args proc)) + ((procedure? proc) (procedure-args proc)) + ((macro? proc) (macro-args proc)) + (else #f)))) + +(define (program-args program) + (let* ((arity (program-arity program)) + (arg-no (first arity)) + (opt (> (second arity) 0)) + (args (map first (take (program-bindings program) arg-no)))) + (format-args (if opt (drop-right args 1) args) (and opt (last args))))) + +(define (procedure-args proc) + (let* ((arity (procedure-property proc 'arity)) + (req (first arity)) + (opt (third arity))) + (format-args (map (lambda (n) + (string->symbol (format "arg~A" n))) + (iota req)) + (and opt 'rest)))) + +(define (macro-args macro) + (format-args '(...) #f)) + +(define (format-args args opt) + (list (cons 'required args) + (cons 'optional (or opt '())))) + +;;; introspection.scm ends here |