tribes/gulie
1
0
Fork 0
Code Issues Pull Requests Releases Activity

Clean up compiler self-lint warnings

Browse Source
This commit is contained in:
Steffen
2026-04-04 16:42:51 +02:00
parent 8488cab0ac
commit f085882a4a
1 changed files with 31 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
gulie/compiler.scm
View File

@@ -6,7 +6,6 @@
(define-module (gulie compiler)
#:use-module (system base compile)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (gulie diagnostic)
@@ -60,32 +59,43 @@ Filters out warnings attributed to files other than FILE."
((string-contains msg "cannot be meaningfully") 'bad-case-datum)
(else 'compiler-warning)))
(define (display-raw-exception-args port args)
(for-each (lambda (a)
(display a port)
(display " " port))
args))
(define (format-exception-message key args)
"Format compiler exception KEY and ARGS into a readable string."
(call-with-output-string
(lambda (p)
(display key p)
(display ": " p)
(let ((subr (and (pair? args) (car args)))
(fmt (and (pair? args)
(pair? (cdr args))
(cadr args)))
(fmt-args (and (pair? args)
(pair? (cdr args))
(pair? (cddr args))
(caddr args))))
(catch #t
(lambda ()
(match args
((subr fmt fmt-args . _)
(if fmt
(begin
(when subr
(display subr p)
(display ": " p))
(if fmt-args
(apply format p fmt (if (list? fmt-args)
(apply format p fmt
(if (list? fmt-args)
fmt-args
(list fmt-args)))
(display fmt p)))
(_ (for-each (lambda (a)
(display a p) (display " " p))
args))))
(display-raw-exception-args p args)))
(lambda _
;; Fallback: just display the raw args
(for-each (lambda (a)
(display a p) (display " " p))
args))))))
(display-raw-exception-args p args)))))))
(define (source-location-ref loc key . default)
(let ((pair (and (list? loc) (assq key loc))))