puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch zexpr): print zexpr stack when unquoting fails

Browse source
This commit is contained in:
puck 2025-06-23 12:22:20 +00:00
parent 933f46a385
commit 6a1efc6a92
1 changed files with 11 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

15
core/src/zexpr.sld
View file

@ -50,10 +50,12 @@
;; ;;
;; Prefer using zexp-context-register-items over directly interacting with this record. ;; Prefer using zexp-context-register-items over directly interacting with this record.
(define-record-type <zexp-context> (define-record-type <zexp-context>
(make-zexp-context srcs drvs) (make-zexp-context srcs drvs zexp parent)
zexp-context? zexp-context?
(srcs zexp-context-srcs set-zexp-context-srcs!) (srcs zexp-context-srcs set-zexp-context-srcs!)
(drvs zexp-context-drvs set-zexp-context-drvs!)) (drvs zexp-context-drvs set-zexp-context-drvs!)
(zexp zexp-context-zexp set-zexp-context-zexp!)
(parent zexp-context-parent set-parent-context-parent!))
(define-record-printer (<zexp-evaluation> zeval out) (define-record-printer (<zexp-evaluation> zeval out)
(fprintf out "#<zexp-context drvs: ~s; srcs: ~s>" (fprintf out "#<zexp-context drvs: ~s; srcs: ~s>"
@ -115,9 +117,14 @@
;; This procedure should return `#f` if the value passed in cannot be unquoted by this handler. ;; This procedure should return `#f` if the value passed in cannot be unquoted by this handler.
(define (zexp-add-unquote-handler handler) (set! zexp-unquote-handlers (cons handler zexp-unquote-handlers))) (define (zexp-add-unquote-handler handler) (set! zexp-unquote-handlers (cons handler zexp-unquote-handlers)))
(define (log-expr-stack port ctx)
(when (zexp-context-parent ctx)
(log-expr-stack port (zexp-context-parent ctx)))
(fprintf port "while evaluating ~S..\n" (zexp-context-zexp ctx)))
(define (iter-unquote-handler val handlers) (define (iter-unquote-handler val handlers)
(if (eq? handlers '()) (if (eq? handlers '())
(error "Cannot unquote this value." val) (begin (log-expr-stack (current-error-port) (*zexp-context*)) (error "Cannot unquote this value." val))
(let ((result ((car handlers) val))) (let ((result ((car handlers) val)))
(if (eq? result #f) (if (eq? result #f)
(iter-unquote-handler val (cdr handlers)) (iter-unquote-handler val (cdr handlers))
@ -137,7 +144,7 @@
;; Unwraps a <zexp>, returning a <zexp-evaluation> containing the proper quoted expressions, and its dependencies. ;; Unwraps a <zexp>, returning a <zexp-evaluation> containing the proper quoted expressions, and its dependencies.
(define (zexp-unwrap val) (define (zexp-unwrap val)
(parameterize ((*zexp-context* (make-zexp-context '() '()))) (parameterize ((*zexp-context* (make-zexp-context '() '() val (*zexp-context*))))
(let ((nval (zexp-unquote val))) (let ((nval (zexp-unquote val)))
(make-zexp-evaluation nval (zexp-context-drvs (*zexp-context*)) (zexp-context-srcs (*zexp-context*)))))) (make-zexp-evaluation nval (zexp-context-drvs (*zexp-context*)) (zexp-context-srcs (*zexp-context*))))))