mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-03 18:50:19 +02:00
Code Activity

boot-9: case warnings use syntax-source

Browse source 
* module/ice-9/boot-9.scm (case): Use syntax-source instead of
source-properties.
This commit is contained in:
Andy Wingo 2025-05-09 14:19:09 +02:00
parent a35cb9dc46
commit 05dd829ad3
1 changed files with 9 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/ice-9/boot-9.scm
View file

@ -548,23 +548,24 @@ If returning early, return the return value of F."
(let ((seen (let ((seen
(fold (fold
(lambda (datum seen) (lambda (datum seen)
(define raw (syntax->datum datum))
(define (warn-datum type) (define (warn-datum type)
((@ (system base message) ((@ (system base message)
warning) warning)
type type
(append (source-properties datum) (or (syntax-source datum)
(source-properties (syntax-source #'test)
(syntax->datum #'test))) '())
datum raw
(syntax->datum clause) (syntax->datum clause)
(syntax->datum whole-expr))) (syntax->datum whole-expr)))
(when (memv datum seen) (when (memv raw seen)
(warn-datum 'duplicate-case-datum)) (warn-datum 'duplicate-case-datum))
(when (or (pair? datum) (array? datum)) (when (or (pair? raw) (array? raw))
(warn-datum 'bad-case-datum)) (warn-datum 'bad-case-datum))
(cons datum seen)) (cons raw seen))
seen seen
(map syntax->datum #'(datums ...))))) #'(datums ...))))
(values (lambda (tail) (values (lambda (tail)
#`((if (memv key '(datums ...)) #`((if (memv key '(datums ...))
clause-expr clause-expr