This commit is contained in:
Justin Ethier 2020-07-20 14:52:46 -04:00
parent 858cac4eee
commit f3c9874e29
2 changed files with 20 additions and 9 deletions

View file

@ -10,7 +10,7 @@
(import (scheme cyclone common))
(export
*source-loc-lis*
syntax-error/loc
syntax-error2
member
assoc
cons-source
@ -235,14 +235,21 @@
)
(begin
(define *source-loc-lis* '())
(define (syntax-error/loc reason expr)
(let ((loc-vec (assoc expr *source-loc-lis*)))
(define (syntax-error2 reason expr)
(Cyc-write expr (current-error-port))
(Cyc-display #\newline (current-error-port))
(let* ((found (assoc expr *source-loc-lis*))
(loc-vec (if found
(cdr found) ;; Get value
(vector #f #f #f))))
(Cyc-display loc-vec (current-error-port))
(Cyc-display #\newline (current-error-port))
(error "Syntax error at "
(vector-ref (assoc loc-vec *source-loc-lis*) 0)
(vector-ref loc-vec 0)
":"
(vector-ref (assoc loc-vec *source-loc-lis*) 1)
(vector-ref loc-vec 1)
":"
(vector-ref (assoc loc-vec *source-loc-lis*) 2)
(vector-ref loc-vec 2)
reason
expr)))
@ -290,7 +297,8 @@
(define-syntax let
(er-macro-transformer
(lambda (expr rename compare)
(if (null? (cdr expr)) (error "empty let" expr))
(if (null? (cdr expr)) (syntax-error2 "empty let" expr))
;(if (null? (cdr expr)) (error "empty let" expr))
(if (null? (cddr expr)) (error "no let body" expr))
((lambda (bindings)
(if (list? bindings) #f (error "bad let bindings"))

View file

@ -198,7 +198,7 @@
;; Open paren, start read loop
((Cyc-opaque-unsafe-eq? token #\()
(let ((line-num (get-line-num fp))
(col-num (get-col-num fp))) ;; TODO: minus one for paren
(col-num (get-col-num fp)))
(let loop ((lis '())
(t (parse fp ssi! fname)))
(cond
@ -213,7 +213,10 @@
(pair? result)
(symbol? (car result)))
;; Possible macro expansion, save source info
(ssi! result fname line-num col-num))
(ssi! result
fname
line-num
(- col-num 1))) ;; Account for open paren
result)))
(else
(loop (cons t lis) (parse fp ssi! fname)))))))