WIP, universal macro exception handler

This commit is contained in:
Justin Ethier 2020-07-23 12:10:24 -04:00
parent c37e8dfad9
commit 1670670968
2 changed files with 19 additions and 17 deletions

View file

@ -239,22 +239,21 @@
(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
#f))) #f))
(if loc-vec (msg (if loc-vec
(error (string-append
(string-append "("
"(" (vector-ref loc-vec 0)
(vector-ref loc-vec 0) " line "
" line " (number->string (vector-ref loc-vec 1))
(number->string (vector-ref loc-vec 1)) ", column "
", column " (number->string (vector-ref loc-vec 2))
(number->string (vector-ref loc-vec 2)) ") "
") " reason)
reason) reason)))
(if (pair? args) args expr)) (if (pair? args)
(error (apply error (cons msg args))
reason (error msg expr))))
(if (pair? args) args expr))))
;; Features implemented by this Scheme ;; Features implemented by this Scheme
(define (features) (define (features)

View file

@ -829,6 +829,9 @@
;; Invoke ER macro ;; Invoke ER macro
(set! result (set! result
(with-handler
(lambda (err)
(apply error/loc (append (list (car err) exp) (cdr err))) )
(cond (cond
((not macro) ((not macro)
(error "macro not found" exp)) (error "macro not found" exp))
@ -844,7 +847,7 @@
(list 'quote exp) (list 'quote exp)
(Cyc-er-rename use-env mac-env local-renamed) (Cyc-er-rename use-env mac-env local-renamed)
(Cyc-er-compare? use-env rename-env)) (Cyc-er-compare? use-env rename-env))
mac-env)))) mac-env)))))
;(newline) ;(newline)
;(display "/* ") ;(display "/* ")
;(write (list 'macro:expand exp macro compiled-macro?)) ;(write (list 'macro:expand exp macro compiled-macro?))