mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

Fix error messages involving definition forms

Browse source 
* module/ice-9/psyntax.scm (syntax-type): Return an additional value
  that contains the entire form in _all_ cases, including for definition
  forms.  Previously, the entire form was not returned for definition
  forms.

  (expand-expr): Add an additional argument that contains the entire
  form in _all_ cases, including for definition forms.  Use it to
  include the entire form in error messages, notably for definitions in
  expression context.  Include the source location information, which
  was previously missing from these errors when the rhs expression was
  an atom.  Improve the "definition in expression context" error message
  to be more comprehensible for Scheme beginners.

  (expand-top-sequence, expand, expand-body): Adjust as needed to handle
  the additional return value from 'syntax-type' and the additional
  argument to 'expand-expr'.

* module/ice-9/psyntax-pp.scm: Regenerate.

* NEWS: Update.
This commit is contained in:
Mark H Weaver 2012-01-26 23:55:24 -05:00
parent d4b5c773e4
commit 40e92f09fc
3 changed files with 11472 additions and 11325 deletions
Download patch file Download diff file Expand all files Collapse all files

1
NEWS
View file

@ -173,6 +173,7 @@ Search the manual for these identifiers and modules, for more.
** Fix <dynwind> serialization. ** Fix <dynwind> serialization.
** Fix erroneous check in `set-procedure-properties!'. ** Fix erroneous check in `set-procedure-properties!'.
** Fix generalized-vector-{ref,set!} for slices. ** Fix generalized-vector-{ref,set!} for slices.
** Fix error messages involving definition forms.
** HTTP: Extend handling of "Cache-Control" header. ** HTTP: Extend handling of "Cache-Control" header.
** HTTP: Fix qstring writing of cache-extension values ** HTTP: Fix qstring writing of cache-extension values
** HTTP: Fix validators for various list-style headers. ** HTTP: Fix validators for various list-style headers.

22721
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

75
module/ice-9/psyntax.scm
View file

@ -982,7 +982,7 @@
(lambda () (lambda ()
(let ((e (car body))) (let ((e (car body)))
(syntax-type e r w (or (source-annotation e) s) #f mod #f))) (syntax-type e r w (or (source-annotation e) s) #f mod #f)))
(lambda (type value e w s mod) (lambda (type value form e w s mod)
(case type (case type
((begin-form) ((begin-form)
(syntax-case e () (syntax-case e ()
@ -1079,18 +1079,20 @@
exps))) exps)))
((displaced-lexical) ((displaced-lexical)
(syntax-violation #f "identifier out of context" (syntax-violation #f "identifier out of context"
e (wrap value w mod))) (source-wrap form w s mod)
(wrap value w mod)))
(else (else
(syntax-violation #f "cannot define keyword at top level" (syntax-violation #f "cannot define keyword at top level"
e (wrap value w mod)))))) (source-wrap form w s mod)
(wrap value w mod))))))
(else (else
(values (cons (values (cons
(if (eq? m 'c&e) (if (eq? m 'c&e)
(let ((x (expand-expr type value e r w s mod))) (let ((x (expand-expr type value form e r w s mod)))
(top-level-eval-hook x mod) (top-level-eval-hook x mod)
x) x)
(lambda () (lambda ()
(expand-expr type value e r w s mod))) (expand-expr type value form e r w s mod)))
exps))))))) exps)))))))
(lambda (exps) (lambda (exps)
(scan (cdr body) r w s m esew mod exps)))))) (scan (cdr body) r w s m esew mod exps))))))
@ -1132,8 +1134,8 @@
(syntax-violation 'eval-when "invalid situation" e (syntax-violation 'eval-when "invalid situation" e
(car l)))))))) (car l))))))))
;; syntax-type returns six values: type, value, e, w, s, and mod. The ;; syntax-type returns seven values: type, value, form, e, w, s, and
;; first two are described in the table below. ;; mod. The first two are described in the table below.
;; ;;
;; type value explanation ;; type value explanation
;; ------------------------------------------------------------------- ;; -------------------------------------------------------------------
@ -1162,10 +1164,11 @@
;; constant none self-evaluating datum ;; constant none self-evaluating datum
;; other none anything else ;; other none anything else
;; ;;
;; For definition forms (define-form, define-syntax-parameter-form, ;; form is the entire form. For definition forms (define-form,
;; and define-syntax-form), e is the rhs expression. For all ;; define-syntax-form, and define-syntax-parameter-form), e is the
;; others, e is the entire form. w is the wrap for e. s is the ;; rhs expression. For all others, e is the entire form. w is the
;; source for the entire form. mod is the module for e. ;; wrap for both form and e. s is the source for the entire form.
;; mod is the module for both form and e.
;; ;;
;; syntax-type expands macros and unwraps as necessary to get to one ;; syntax-type expands macros and unwraps as necessary to get to one
;; of the forms above. It also parses definition forms, although ;; of the forms above. It also parses definition forms, although
@ -1179,28 +1182,28 @@
(b (lookup n r mod)) (b (lookup n r mod))
(type (binding-type b))) (type (binding-type b)))
(case type (case type
((lexical) (values type (binding-value b) e w s mod)) ((lexical) (values type (binding-value b) e e w s mod))
((global) (values type n e w s mod)) ((global) (values type n e e w s mod))
((macro) ((macro)
(if for-car? (if for-car?
(values type (binding-value b) e w s mod) (values type (binding-value b) e e w s mod)
(syntax-type (expand-macro (binding-value b) e r w s rib mod) (syntax-type (expand-macro (binding-value b) e r w s rib mod)
r empty-wrap s rib mod #f))) r empty-wrap s rib mod #f)))
(else (values type (binding-value b) e w s mod))))) (else (values type (binding-value b) e e w s mod)))))
((pair? e) ((pair? e)
(let ((first (car e))) (let ((first (car e)))
(call-with-values (call-with-values
(lambda () (syntax-type first r w s rib mod #t)) (lambda () (syntax-type first r w s rib mod #t))
(lambda (ftype fval fe fw fs fmod) (lambda (ftype fval fform fe fw fs fmod)
(case ftype (case ftype
((lexical) ((lexical)
(values 'lexical-call fval e w s mod)) (values 'lexical-call fval e e w s mod))
((global) ((global)
;; If we got here via an (@@ ...) expansion, we need to ;; If we got here via an (@@ ...) expansion, we need to
;; make sure the fmod information is propagated back ;; make sure the fmod information is propagated back
;; correctly -- hence this consing. ;; correctly -- hence this consing.
(values 'global-call (make-syntax-object fval w fmod) (values 'global-call (make-syntax-object fval w fmod)
e w s mod)) e e w s mod))
((macro) ((macro)
(syntax-type (expand-macro fval e r w s rib mod) (syntax-type (expand-macro fval e r w s rib mod)
r empty-wrap s rib mod for-car?)) r empty-wrap s rib mod for-car?))
@ -1209,23 +1212,24 @@
(lambda (e r w s mod) (lambda (e r w s mod)
(syntax-type e r w s rib mod for-car?)))) (syntax-type e r w s rib mod for-car?))))
((core) ((core)
(values 'core-form fval e w s mod)) (values 'core-form fval e e w s mod))
((local-syntax) ((local-syntax)
(values 'local-syntax-form fval e w s mod)) (values 'local-syntax-form fval e e w s mod))
((begin) ((begin)
(values 'begin-form #f e w s mod)) (values 'begin-form #f e e w s mod))
((eval-when) ((eval-when)
(values 'eval-when-form #f e w s mod)) (values 'eval-when-form #f e e w s mod))
((define) ((define)
(syntax-case e () (syntax-case e ()
((_ name val) ((_ name val)
(id? #'name) (id? #'name)
(values 'define-form #'name #'val w s mod)) (values 'define-form #'name e #'val w s mod))
((_ (name . args) e1 e2 ...) ((_ (name . args) e1 e2 ...)
(and (id? #'name) (and (id? #'name)
(valid-bound-ids? (lambda-var-list #'args))) (valid-bound-ids? (lambda-var-list #'args)))
;; need lambda here... ;; need lambda here...
(values 'define-form (wrap #'name w mod) (values 'define-form (wrap #'name w mod)
(wrap e w mod)
(decorate-source (decorate-source
(cons #'lambda (wrap #'(args e1 e2 ...) w mod)) (cons #'lambda (wrap #'(args e1 e2 ...) w mod))
s) s)
@ -1233,38 +1237,39 @@
((_ name) ((_ name)
(id? #'name) (id? #'name)
(values 'define-form (wrap #'name w mod) (values 'define-form (wrap #'name w mod)
(wrap e w mod)
#'(if #f #f) #'(if #f #f)
empty-wrap s mod)))) empty-wrap s mod))))
((define-syntax) ((define-syntax)
(syntax-case e () (syntax-case e ()
((_ name val) ((_ name val)
(id? #'name) (id? #'name)
(values 'define-syntax-form #'name #'val w s mod)))) (values 'define-syntax-form #'name e #'val w s mod))))
((define-syntax-parameter) ((define-syntax-parameter)
(syntax-case e () (syntax-case e ()
((_ name val) ((_ name val)
(id? #'name) (id? #'name)
(values 'define-syntax-parameter-form #'name #'val w s mod)))) (values 'define-syntax-parameter-form #'name e #'val w s mod))))
(else (else
(values 'call #f e w s mod))))))) (values 'call #f e e w s mod)))))))
((syntax-object? e) ((syntax-object? e)
(syntax-type (syntax-object-expression e) (syntax-type (syntax-object-expression e)
r r
(join-wraps w (syntax-object-wrap e)) (join-wraps w (syntax-object-wrap e))
(or (source-annotation e) s) rib (or (source-annotation e) s) rib
(or (syntax-object-module e) mod) for-car?)) (or (syntax-object-module e) mod) for-car?))
((self-evaluating? e) (values 'constant #f e w s mod)) ((self-evaluating? e) (values 'constant #f e e w s mod))
(else (values 'other #f e w s mod))))) (else (values 'other #f e e w s mod)))))
(define expand (define expand
(lambda (e r w mod) (lambda (e r w mod)
(call-with-values (call-with-values
(lambda () (syntax-type e r w (source-annotation e) #f mod #f)) (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
(lambda (type value e w s mod) (lambda (type value form e w s mod)
(expand-expr type value e r w s mod))))) (expand-expr type value form e r w s mod)))))
(define expand-expr (define expand-expr
(lambda (type value e r w s mod) (lambda (type value form e r w s mod)
(case type (case type
((lexical) ((lexical)
(build-lexical-reference 'value s e value)) (build-lexical-reference 'value s e value))
@ -1318,8 +1323,8 @@
(expand-sequence #'(e1 e2 ...) r w s mod) (expand-sequence #'(e1 e2 ...) r w s mod)
(expand-void)))))) (expand-void))))))
((define-form define-syntax-form define-syntax-parameter-form) ((define-form define-syntax-form define-syntax-parameter-form)
(syntax-violation #f "definition in expression context" (syntax-violation #f "definition in expression context, where definitions are not allowed,"
e (wrap value w mod))) (source-wrap form w s mod)))
((syntax) ((syntax)
(syntax-violation #f "reference to pattern variable outside syntax form" (syntax-violation #f "reference to pattern variable outside syntax form"
(source-wrap e w s mod))) (source-wrap e w s mod)))
@ -1463,7 +1468,7 @@
(let ((e (cdar body)) (er (caar body))) (let ((e (cdar body)) (er (caar body)))
(call-with-values (call-with-values
(lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f)) (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f))
(lambda (type value e w s mod) (lambda (type value form e w s mod)
(case type (case type
((define-form) ((define-form)
(let ((id (wrap value w mod)) (label (gen-label))) (let ((id (wrap value w mod)) (label (gen-label)))
@ -2222,7 +2227,7 @@
((_ (head tail ...) val) ((_ (head tail ...) val)
(call-with-values (call-with-values
(lambda () (syntax-type #'head r empty-wrap no-source #f mod #t)) (lambda () (syntax-type #'head r empty-wrap no-source #f mod #t))
(lambda (type value ee ww ss modmod) (lambda (type value formform ee ww ss modmod)
(case type (case type
((module-ref) ((module-ref)
(let ((val (expand #'val r w mod))) (let ((val (expand #'val r w mod)))