From 68a4e69aca1f8a84330def1ee24b2da6243419c0 Mon Sep 17 00:00:00 2001
From: Jose Antonio Ortega Ruiz <jao@gnu.org>
Date: Sun, 27 Feb 2011 13:14:30 +0100
Subject: 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)).
---
 scheme/racket/geiser/modules.rkt | 36 +++++++++++++++++++++---------------
 scheme/racket/geiser/user.rkt    | 23 +++++++++++++++++------
 2 files changed, 38 insertions(+), 21 deletions(-)

(limited to 'scheme')

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)))
-- 
cgit v1.2.3