summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-07 01:25:14 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-07 01:25:14 +0200
commit17b23aa1bfe807c68ddc5ff01eaccc99fd02a058 (patch)
treeee82f44eee65f6a864ad76840d117bb2ba7fa06f
parent95f39e30fd4ae59cf962648dc8c0120c654c05bd (diff)
downloadgeiser-chez-17b23aa1bfe807c68ddc5ff01eaccc99fd02a058.tar.gz
geiser-chez-17b23aa1bfe807c68ddc5ff01eaccc99fd02a058.tar.bz2
Guile: real fix for symbol locations (needs Guile's git head).
-rw-r--r--scheme/guile/geiser/evaluation.scm8
-rw-r--r--scheme/guile/geiser/modules.scm23
-rw-r--r--scheme/guile/geiser/xref.scm2
3 files changed, 22 insertions, 11 deletions
diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm
index 179e425..a0007c4 100644
--- a/scheme/guile/geiser/evaluation.scm
+++ b/scheme/guile/geiser/evaluation.scm
@@ -15,6 +15,7 @@
ge:macroexpand
ge:compile-file
ge:load-file)
+ #:use-module (geiser modules)
#:use-module (srfi srfi-1)
#:use-module (language tree-il)
#:use-module (system base compile)
@@ -33,13 +34,6 @@
(else (display (format "ERROR: ~a, args: ~a" (car args) (cdr args)))))
`(error (key . ,(car args))))
-(define (find-module module-name)
- (and (list? module-name)
- (or (nested-ref the-root-module (append '(%app modules) module-name))
- (let ((m (resolve-module module-name)))
- (beautify-user-module! m)
- m))))
-
(define (write-result result output)
(write (list (cons 'result result) (cons 'output output)))
(newline))
diff --git a/scheme/guile/geiser/modules.scm b/scheme/guile/geiser/modules.scm
index 2934603..39b01b8 100644
--- a/scheme/guile/geiser/modules.scm
+++ b/scheme/guile/geiser/modules.scm
@@ -11,7 +11,9 @@
(define-module (geiser modules)
#:export (symbol-module
- module-filename
+ module-name?
+ module-path
+ find-module
all-modules
module-exports
module-location)
@@ -21,6 +23,11 @@
#:use-module (ice-9 session)
#:use-module (srfi srfi-1))
+(define (module-name? module-name)
+ (and (list? module-name)
+ (> (length module-name) 0)
+ (every symbol? module-name)))
+
(define (symbol-module sym . all)
(and sym
(catch 'module-name
@@ -38,9 +45,19 @@
(and (eq? key 'module-name) (car args))))))
(define (module-location name)
- (make-location (module-filename name) #f))
+ (make-location (module-path name) #f))
+
+(define (find-module module-name)
+ (and (module-name? module-name)
+ (or (nested-ref (resolve-module '() #f) module-name)
+ (let ((m (resolve-module module-name)))
+ (beautify-user-module! m)
+ m))))
-(define module-filename (@@ (ice-9 session) module-filename))
+(define (module-path module-name)
+ (and (module-name? module-name)
+ (or ((@@ (ice-9 session) module-filename) module-name)
+ (module-filename (resolve-module module-name)))))
(define (all-modules)
(let ((roots ((@@ (ice-9 session) root-modules))))
diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm
index 060bec4..18005ee 100644
--- a/scheme/guile/geiser/xref.scm
+++ b/scheme/guile/geiser/xref.scm
@@ -55,7 +55,7 @@
(define (program-path p)
(let* ((mod (program-module p))
(name (and mod (module-name mod))))
- (and name (module-filename name))))
+ (and name (module-path name))))
(define (procedure-xref proc . mod-name)
(let ((proc-name (or (procedure-name proc) '<anonymous>))