suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

syntax/parse: better error message for unbound literals

Browse Source
This commit is contained in:
Ryan Culpepper 2011-05-04 20:09:01 -06:00
parent d40b43c0a9
commit d9f05a61a3
3 changed files with 28 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/syntax/parse/private/litconv.rkt
View File

@ -148,24 +148,16 @@
(for ([x (in-list (syntax->list #'(external ...)))]) (for ([x (in-list (syntax->list #'(external ...)))])
(unless (identifier-binding x 'relphase) (unless (identifier-binding x 'relphase)
(raise-syntax-error #f (raise-syntax-error #f
(format "literal is unbound in phase ~a~a" (format "literal is unbound in phase ~a~a~a"
'relphase 'relphase
(case 'relphase (case 'relphase
((1) " (for-syntax)") ((1) " (for-syntax)")
((-1) " (for-template)") ((-1) " (for-template)")
((#f) " (for-label)") ((#f) " (for-label)")
(else ""))) (else ""))
" relative to the enclosing module")
(quote-syntax #,stx) x))))))))])) (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 Literal sets: The goal is for literals to refer to their bindings at

4
collects/syntax/parse/private/rep.rkt
View File

@ -1301,7 +1301,9 @@ A syntax class is integrable if
(define (check-literal-entry stx ctx) (define (check-literal-entry stx ctx)
(define (go internal external phase) (define (go internal external phase)
(txlift #`(check-literal (quote-syntax #,external) (txlift #`(check-literal (quote-syntax #,external)
#,phase (quote-syntax #,ctx))) #,phase
(phase-of-enclosing-module)
(quote-syntax #,ctx)))
(list internal external phase phase)) (list internal external phase phase))
(syntax-case stx () (syntax-case stx ()
[(internal external #:phase phase) [(internal external #:phase phase)

28
collects/syntax/parse/private/runtime.rkt
View File

@ -257,13 +257,16 @@
(provide check-literal (provide check-literal
free-identifier=?/phases) 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 ;; FIXME: change to normal 'error', if src gets stripped away
(define (check-literal id phase ctx) (define (check-literal id abs-phase mod-phase ctx)
(unless (identifier-binding id phase) (unless (identifier-binding id abs-phase)
(raise-syntax-error #f (raise-syntax-error
(format "literal is unbound in phase ~s" phase) #f
ctx id))) (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 ;; free-identifier=?/phases : id phase-level id phase-level -> boolean
;; Determines whether x has the same binding at phase-level phase-x ;; Determines whether x has the same binding at phase-level phase-x
@ -366,3 +369,16 @@
;; For now, let #%app handle it. ;; For now, let #%app handle it.
(with-syntax ([((kw-part ...) ...) #'((kw kwarg) ...)]) (with-syntax ([((kw-part ...) ...) #'((kw kwarg) ...)])
#'(proc kw-part ... ... extra-parg ... parg ...))])) #'(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))))]))