Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 13:05:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Issue #353 - Clean up error reporting

Browse source
This commit is contained in:
Justin Ethier 2020-07-20 18:35:57 -04:00
parent f3c9874e29
commit 1ff14cf605
1 changed files with 29 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
scheme/base.sld
View file

@ -10,7 +10,7 @@
(import (scheme cyclone common)) (import (scheme cyclone common))
(export (export
*source-loc-lis* *source-loc-lis*
syntax-error2 error/loc
member member
assoc assoc
cons-source cons-source
@ -235,23 +235,32 @@
) )
(begin (begin
(define *source-loc-lis* '()) (define *source-loc-lis* '())
(define (syntax-error2 reason expr) (define (error/loc reason expr)
(Cyc-write expr (current-error-port)) ;(Cyc-write expr (current-error-port))
(Cyc-display #\newline (current-error-port)) ;(Cyc-display #\newline (current-error-port))
(let* ((found (assoc expr *source-loc-lis*)) (let* ((found (assoc expr *source-loc-lis*))
(loc-vec (if found (loc-vec (if found
(cdr found) ;; Get value (cdr found) ;; Get value
(vector #f #f #f)))) #f)))
(Cyc-display loc-vec (current-error-port)) ;(Cyc-display loc-vec (current-error-port))
(Cyc-display #\newline (current-error-port)) ;(Cyc-display #\newline (current-error-port))
(error "Syntax error at " (if loc-vec
(vector-ref loc-vec 0) (error
":" (string-append
(vector-ref loc-vec 1) "invalid syntax "
":" reason
(vector-ref loc-vec 2) " in "
reason (vector-ref loc-vec 0)
expr))) " line "
(number->string (vector-ref loc-vec 1))
", char "
(number->string (vector-ref loc-vec 2)))
expr)
(error
(string-append
"invalid syntax "
reason)
expr))))
;; Features implemented by this Scheme ;; Features implemented by this Scheme
(define (features) (define (features)
@ -297,11 +306,11 @@
(define-syntax let (define-syntax let
(er-macro-transformer (er-macro-transformer
(lambda (expr rename compare) (lambda (expr rename compare)
(if (null? (cdr expr)) (syntax-error2 "empty let" expr)) (if (null? (cdr expr)) (error/loc "empty let" expr))
;(if (null? (cdr expr)) (error "empty let" expr)) ;(if (null? (cdr expr)) (error/loc "empty let" expr))
(if (null? (cddr expr)) (error "no let body" expr)) (if (null? (cddr expr)) (error/loc "no let body" expr))
((lambda (bindings) ((lambda (bindings)
(if (list? bindings) #f (error "bad let bindings")) (if (list? bindings) #f (error/loc "bad let bindings" expr))
(if (every (lambda (x) (if (every (lambda (x)
(if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f)) (if (pair? x) (if (pair? (cdr x)) (null? (cddr x)) #f) #f))
bindings) bindings)
@ -316,7 +325,7 @@
`((,(rename 'lambda) ,vars ,@(cddr expr)) ,@vals))) `((,(rename 'lambda) ,vars ,@(cddr expr)) ,@vals)))
(map car bindings) (map car bindings)
(map cadr bindings)) (map cadr bindings))
(error "bad let syntax" expr))) (error/loc "bad let syntax" expr)))
(if (symbol? (cadr expr)) (car (cddr expr)) (cadr expr)))))) (if (symbol? (cadr expr)) (car (cddr expr)) (cadr expr))))))
(define-syntax let* (define-syntax let*
(er-macro-transformer (er-macro-transformer