summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2011-02-27 13:14:30 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2011-02-27 13:14:30 +0100
commit68a4e69aca1f8a84330def1ee24b2da6243419c0 (patch)
tree5d44f050064058f7830677ab38d58a0da00d5495
parent8eac2e737ac4f7563c944f4cfec9e8075d307d78 (diff)
downloadgeiser-chez-68a4e69aca1f8a84330def1ee24b2da6243419c0.tar.gz
geiser-chez-68a4e69aca1f8a84330def1ee24b2da6243419c0.tar.bz2
Racket: no errors ,entering an R5RS module
The catch here is that one cannot use #%variable-reference inside an R5RS module, and, as a consequence, namespace->module-path-name was failing badly. The solution is to take note of the module name being entered before hand, and use that name in case of error (we could actually use that name always, but then cheaters using Racket's enter! would see an inconsistent name (which probably they deserve)).
-rw-r--r--scheme/racket/geiser/modules.rkt36
-rw-r--r--scheme/racket/geiser/user.rkt23
2 files changed, 38 insertions, 21 deletions
diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt
index 9e6e14c..2c57db9 100644
--- a/scheme/racket/geiser/modules.rkt
+++ b/scheme/racket/geiser/modules.rkt
@@ -1,6 +1,6 @@
;;; modules.rkt -- module metadata
-;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the Modified BSD License. You should
@@ -51,11 +51,16 @@
(when (namespace? ns)
(current-namespace ns))))
-(define (namespace->module-path-name ns)
- (let ([rmp (variable-reference->resolved-module-path
- (eval '(#%variable-reference) (or ns (current-namespace))))])
- (and (resolved-module-path? rmp)
- (resolved-module-path-name rmp))))
+(define (namespace->rmp ns)
+ (with-handlers ([exn? (const #f)])
+ (variable-reference->resolved-module-path
+ (eval '(#%variable-reference) (or ns (current-namespace))))))
+
+(define (namespace->module-path-name ns (p #f))
+ (let ([rmp (namespace->rmp ns)])
+ (or (and (resolved-module-path? rmp)
+ (resolved-module-path-name rmp))
+ p)))
(define (module-spec->path-name spec)
(and (symbol? spec)
@@ -64,10 +69,13 @@
(namespace->module-path-name
(module-spec->namespace spec #f #f))))))
+(define unknown-module-name "*unresolved module*")
+
(define (module-path-name->name path)
- (cond [(path? path)
- (let* ([path (path->string path)]
- [cpaths (map (compose path->string path->directory-path)
+ (cond [(path? path) (module-path-name->name (path->string path))]
+ ;; [(eq? path '#%kernel) "(kernel)"]
+ [(string? path)
+ (let* ([cpaths (map (compose path->string path->directory-path)
(current-library-collection-paths))]
[prefix-len (lambda (p)
(let ((pl (string-length p)))
@@ -80,19 +88,17 @@
(let-values ([(_ base __) (split-path path)])
(path->string base))
(regexp-replace "\\.[^./]*$" real-path "")))]
- ;; [(eq? path '#%kernel) "(kernel)"]
- [(string? path) path]
[(symbol? path) (symbol->string path)]
- [else ""]))
+ [else unknown-module-name]))
(define (module-path-index->name mpi)
(let ([rmp (module-path-index-resolve mpi)])
(if (resolved-module-path? rmp)
(module-path-name->name (resolved-module-path-name rmp))
- "<unknown module>")))
+ unknown-module-name)))
-(define namespace->module-name
- (compose module-path-name->name namespace->module-path-name))
+(define (namespace->module-name ns (p #f))
+ (module-path-name->name (namespace->module-path-name ns p)))
(define (module-identifiers mod)
(define (extract-ids ls)
diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt
index 72aa48a..69a5df7 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -22,13 +22,23 @@
geiser/modules)
(define top-namespace (current-namespace))
+(define last-entered (make-parameter ""))
+
+(define (do-enter mod name)
+ (enter-module mod)
+ (current-namespace (module->namespace mod))
+ (last-entered name))
(define (enter! mod stx)
- (cond [(not mod) (current-namespace top-namespace)]
- [(module-path? mod)
- (enter-module mod)
- (current-namespace (module->namespace mod))]
- [(path-string? mod) (enter! `(file ,mod) stx)]
+ (cond [(not mod)
+ (current-namespace top-namespace)
+ (last-entered "")]
+ [(symbol? mod) (do-enter mod (symbol->string mod))]
+ [(and (list? mod)
+ (= 2 (length mod))
+ (eq? 'file (car mod))
+ (path-string? (cadr mod))) (do-enter mod (cadr mod))]
+ [(path-string? mod) (do-enter `(file ,mod) mod)]
[else (raise-syntax-error
#f
"not a valid module path, and not #f"
@@ -68,7 +78,8 @@
(define geiser-prompt
(lambda ()
- (printf "racket@~a> " (namespace->module-name (current-namespace)))))
+ (printf "racket@~a> "
+ (namespace->module-name (current-namespace) (last-entered)))))
(define (geiser-prompt-read prompt)
(make-repl-reader (geiser-read prompt)))