From 6a1efc6a927e99257d15c16c300a1b929b908d1b Mon Sep 17 00:00:00 2001
From: Puck Meerburg <puck@puckipedia.com>
Date: Mon, 23 Jun 2025 12:22:20 +0000
Subject: [PATCH] (zilch zexpr): print zexpr stack when unquoting fails

---
 core/src/zexpr.sld | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/core/src/zexpr.sld b/core/src/zexpr.sld
index 1107fd0..b2949dc 100644
--- a/core/src/zexpr.sld
+++ b/core/src/zexpr.sld
@@ -50,10 +50,12 @@
     ;;
     ;; Prefer using zexp-context-register-items over directly interacting with this record.
     (define-record-type <zexp-context>
-      (make-zexp-context srcs drvs)
+      (make-zexp-context srcs drvs zexp parent)
       zexp-context?
       (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)
       (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.
     (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)
         (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)))
                  (if (eq? result #f)
                      (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.
     (define (zexp-unwrap val)
-      (parameterize ((*zexp-context* (make-zexp-context '() '())))
+      (parameterize ((*zexp-context* (make-zexp-context '() '() val (*zexp-context*))))
                     (let ((nval (zexp-unquote val)))
                          (make-zexp-evaluation nval (zexp-context-drvs (*zexp-context*)) (zexp-context-srcs (*zexp-context*))))))