summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2017-02-04 08:13:11 -0800
committerKaz Kylheku <kaz@kylheku.com>2017-02-04 08:13:11 -0800
commit920d69917327bc018fbd99d6bf7bca8c55481b72 (patch)
tree7b7f1190854474e2de93071e85fafdc354679be6
parentaf2d8eadf51601d056c3129f8fd82baf7b3e4909 (diff)
downloadtxr-920d69917327bc018fbd99d6bf7bca8c55481b72.tar.gz
txr-920d69917327bc018fbd99d6bf7bca8c55481b72.tar.bz2
txr-920d69917327bc018fbd99d6bf7bca8c55481b72.zip
Improve diagnostic of error during place expansion.
* share/txr/stdlib/place.tl (call-update-expander, call-clobber-expander, call-delete-expander): On entry into these functions, propagaet the ancestry info to the original unexpanded body, not only into the final expanded body. This way, if errors go off during the expansion of the original, the diagnostic will have access to the info. Test case: (flet ((f ())) (set (fun f) 4)). With this patch we trace to (fun 4) and its location.
-rw-r--r--share/txr/stdlib/place.tl3
1 files changed, 3 insertions, 0 deletions
diff --git a/share/txr/stdlib/place.tl b/share/txr/stdlib/place.tl
index e3156d70..1ea1b95c 100644
--- a/share/txr/stdlib/place.tl
+++ b/share/txr/stdlib/place.tl
@@ -165,6 +165,7 @@
to-tree)
(defun call-update-expander (getter setter unex-place env body)
+ (sys:propagate-ancestor body unex-place getter setter)
(let* ((place (sys:pl-expand unex-place env))
(expander (get-update-expander place))
(sys:*pl-env* env)
@@ -173,6 +174,7 @@
(sys:propagate-ancestor expansion-ex place getter setter)))
(defun call-clobber-expander (ssetter unex-place env body)
+ (sys:propagate-ancestor body unex-place ssetter)
(let* ((place (sys:pl-expand unex-place env))
(expander (get-clobber-expander place))
(sys:*pl-env* env)
@@ -181,6 +183,7 @@
(sys:propagate-ancestor expansion-ex place ssetter)))
(defun call-delete-expander (deleter unex-place env body)
+ (sys:propagate-ancestor body unex-place deleter)
(let* ((place (sys:pl-expand unex-place env))
(expander (get-delete-expander place))
(sys:*pl-env* env)