From d9f05a61a322efbaf37457ccad87d550ad8550d8 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Wed, 4 May 2011 20:09:01 -0600
Subject: [PATCH] syntax/parse: better error message for unbound literals

---
 collects/syntax/parse/private/litconv.rkt | 14 +++---------
 collects/syntax/parse/private/rep.rkt     |  4 +++-
 collects/syntax/parse/private/runtime.rkt | 28 ++++++++++++++++++-----
 3 files changed, 28 insertions(+), 18 deletions(-)

diff --git a/collects/syntax/parse/private/litconv.rkt b/collects/syntax/parse/private/litconv.rkt
index a0fa2fc554..5d1e8e3acb 100644
--- a/collects/syntax/parse/private/litconv.rkt
+++ b/collects/syntax/parse/private/litconv.rkt
@@ -148,24 +148,16 @@
                 (for ([x (in-list (syntax->list #'(external ...)))])
                   (unless (identifier-binding x 'relphase)
                     (raise-syntax-error #f
-                                        (format "literal is unbound in phase ~a~a"
+                                        (format "literal is unbound in phase ~a~a~a"
                                                 'relphase
                                                 (case 'relphase
                                                   ((1) " (for-syntax)")
                                                   ((-1) " (for-template)")
                                                   ((#f) " (for-label)")
-                                                  (else "")))
+                                                  (else ""))
+                                                " relative to the enclosing module")
                                         (quote-syntax #,stx) x))))))))]))
 
-(define-syntax (phase-of-enclosing-module stx)
-  (syntax-case stx ()
-    [(poem)
-     (let ([phase-within-module (syntax-local-phase-level)])
-       #`(let ([phase-of-this-expression
-                (variable-reference->phase (#%variable-reference))])
-           (- phase-of-this-expression
-              #,(if (zero? phase-within-module) 0 1))))]))
-
 #|
 Literal sets: The goal is for literals to refer to their bindings at
 
diff --git a/collects/syntax/parse/private/rep.rkt b/collects/syntax/parse/private/rep.rkt
index 47b73b8e42..fadbb9ac6d 100644
--- a/collects/syntax/parse/private/rep.rkt
+++ b/collects/syntax/parse/private/rep.rkt
@@ -1301,7 +1301,9 @@ A syntax class is integrable if
 (define (check-literal-entry stx ctx)
   (define (go internal external phase)
     (txlift #`(check-literal (quote-syntax #,external)
-                             #,phase (quote-syntax #,ctx)))
+                             #,phase
+                             (phase-of-enclosing-module)
+                             (quote-syntax #,ctx)))
     (list internal external phase phase))
   (syntax-case stx ()
     [(internal external #:phase phase)
diff --git a/collects/syntax/parse/private/runtime.rkt b/collects/syntax/parse/private/runtime.rkt
index 14b191409f..5c4d54747a 100644
--- a/collects/syntax/parse/private/runtime.rkt
+++ b/collects/syntax/parse/private/runtime.rkt
@@ -257,13 +257,16 @@
 (provide check-literal
          free-identifier=?/phases)
 
-;; check-literal : id phase-level stx -> void
+;; check-literal : id phase-level phase-level stx -> void
 ;; FIXME: change to normal 'error', if src gets stripped away
-(define (check-literal id phase ctx)
-  (unless (identifier-binding id phase)
-    (raise-syntax-error #f
-                        (format "literal is unbound in phase ~s" phase)
-                        ctx id)))
+(define (check-literal id abs-phase mod-phase ctx)
+  (unless (identifier-binding id abs-phase)
+    (raise-syntax-error
+     #f
+     (format "literal is unbound in phase ~a (phase ~a relative to the enclosing module)"
+             abs-phase
+             (and abs-phase (- abs-phase mod-phase)))
+     ctx id)))
 
 ;; free-identifier=?/phases : id phase-level id phase-level -> boolean
 ;; Determines whether x has the same binding at phase-level phase-x
@@ -366,3 +369,16 @@
      ;; For now, let #%app handle it.
      (with-syntax ([((kw-part ...) ...) #'((kw kwarg) ...)])
        #'(proc kw-part ... ... extra-parg ... parg ...))]))
+
+;; ----
+
+(provide phase-of-enclosing-module)
+
+(define-syntax (phase-of-enclosing-module stx)
+  (syntax-case stx ()
+    [(poem)
+     (let ([phase-within-module (syntax-local-phase-level)])
+       #`(let ([phase-of-this-expression
+                (variable-reference->phase (#%variable-reference))])
+           (- phase-of-this-expression
+              #,(if (zero? phase-within-module) 0 1))))]))