syntax/parse: better error message for unbound literals
This commit is contained in:
parent
d40b43c0a9
commit
d9f05a61a3
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -257,12 +257,15 @@
|
|||
(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)
|
||||
(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
|
||||
|
@ -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))))]))
|
||||
|
|
Loading…
Reference in New Issue
Block a user