mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-02 02:10:19 +02:00
boot-9: case warnings use syntax-source
* module/ice-9/boot-9.scm (case): Use syntax-source instead of source-properties.
This commit is contained in:
parent
a35cb9dc46
commit
05dd829ad3
1 changed files with 9 additions and 8 deletions
|
@ -548,23 +548,24 @@ If returning early, return the return value of F."
|
|||
(let ((seen
|
||||
(fold
|
||||
(lambda (datum seen)
|
||||
(define raw (syntax->datum datum))
|
||||
(define (warn-datum type)
|
||||
((@ (system base message)
|
||||
warning)
|
||||
type
|
||||
(append (source-properties datum)
|
||||
(source-properties
|
||||
(syntax->datum #'test)))
|
||||
datum
|
||||
(or (syntax-source datum)
|
||||
(syntax-source #'test)
|
||||
'())
|
||||
raw
|
||||
(syntax->datum clause)
|
||||
(syntax->datum whole-expr)))
|
||||
(when (memv datum seen)
|
||||
(when (memv raw seen)
|
||||
(warn-datum 'duplicate-case-datum))
|
||||
(when (or (pair? datum) (array? datum))
|
||||
(when (or (pair? raw) (array? raw))
|
||||
(warn-datum 'bad-case-datum))
|
||||
(cons datum seen))
|
||||
(cons raw seen))
|
||||
seen
|
||||
(map syntax->datum #'(datums ...)))))
|
||||
#'(datums ...))))
|
||||
(values (lambda (tail)
|
||||
#`((if (memv key '(datums ...))
|
||||
clause-expr
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue