diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2017-02-04 08:13:11 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2017-02-04 08:13:11 -0800 |
| commit | f4c7237bba935ba7f632c8c07988b2b840a6e38b (patch) | |
| tree | 7b7f1190854474e2de93071e85fafdc354679be6 /share | |
| parent | d3acb1e10243875a1c836068679e902146f6740e (diff) | |
| download | txr-f4c7237bba935ba7f632c8c07988b2b840a6e38b.tar.gz txr-f4c7237bba935ba7f632c8c07988b2b840a6e38b.tar.bz2 txr-f4c7237bba935ba7f632c8c07988b2b840a6e38b.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.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/place.tl | 3 |
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) |