diff --git a/host/chez/cli.ss b/host/chez/cli.ss index 1d03c82..eddec52 100644 --- a/host/chez/cli.ss +++ b/host/chez/cli.ss @@ -53,6 +53,9 @@ (display "Unhandled exception: " port) (display (if (condition? v) (with-output-to-string (lambda () (display-condition v))) (jolt-pr-str v)) port) (newline port))) + ;; The top-level form that was evaluating when this propagated (file:line:col). + (let ((loc (jolt-current-source-string))) + (when loc (display " at " port) (display loc port) (newline port))) (exit 1))) (guard (v (#t (jolt-report-uncaught v))) diff --git a/host/chez/compile-eval.ss b/host/chez/compile-eval.ss index 624511b..ad3eb4a 100644 --- a/host/chez/compile-eval.ss +++ b/host/chez/compile-eval.ss @@ -20,6 +20,29 @@ ;; whose data conversion would turn those into real sets. (define jolt-ce-read jolt-read-form-raw) +;; --- current source location ------------------------------------------------ +;; The position of the top-level form currently compiling/evaluating, so an +;; uncaught error can report where it came from (cli.ss jolt-report-uncaught). +;; Thread-local: a future/agent worker tracks its own form. Holds #f or a +;; {:line :column :file?} position map (jolt.host/form-position's shape). +;; Top-level granularity — one set per top-level form, nothing per call. +(define jolt-current-source (make-thread-parameter #f)) +(define (jolt-enter-form! form) + (let ((p (hc-form-position form))) + (when (pmap? p) (jolt-current-source p)))) + +;; "file:line:col" / "line:col" for the current form, or #f when none is set. +(define (jolt-current-source-string) + (let ((p (jolt-current-source))) + (and (pmap? p) + (let ((line (jolt-get p hc-kw-line jolt-nil)) + (col (jolt-get p hc-kw-column jolt-nil)) + (file (jolt-get p hc-kw-file jolt-nil))) + (string-append + (if (jolt-nil? file) "" (string-append file ":")) + (if (jolt-nil? line) "?" (number->string line)) ":" + (if (jolt-nil? col) "?" (number->string col))))))) + ;; The spine ALWAYS runs with the full clojure.core prelude loaded, so a clojure.* ;; ref must lower to var-deref (resolved from the prelude), not trip the emitter's ;; "unsupported stdlib fn (no core on Chez yet)" out-of-subset guard — that guard @@ -124,6 +147,9 @@ ;; of the expander fn + (mark-macro! …) so subsequent forms expand it. One ;; macro-expansion path (no separate spine interception). (else + ;; record this form's source location first, so a compile- or run-time error + ;; in it reports the right place. + (jolt-enter-form! form) (eval (read (open-input-string (jolt-analyze-emit-form form ns))) (interaction-environment))))) diff --git a/host/chez/smoke.sh b/host/chez/smoke.sh index 4002b5f..11eacf4 100755 --- a/host/chez/smoke.sh +++ b/host/chez/smoke.sh @@ -18,6 +18,18 @@ check() { } pass=0 +# An uncaught error reports the source location of the top-level form (stderr). +check_loc() { + err="$(bin/joltc -e "$1" 2>&1 >/dev/null)" + if printf '%s' "$err" | grep -q "$2"; then + pass=$((pass + 1)) + else + echo " FAIL (loc): $1" + echo " want stderr to contain \`$2\`, got \`$err\`" + fails=$((fails + 1)) + fi +} + check '(+ 1 2)' '3' check '(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 15)' '610' check '(->> (range 10) (filter even?) (map (fn [x] (* x x))) (reduce +))' '120' @@ -31,6 +43,8 @@ check '(deref (future (+ 1 2)))' '3' check '(/ 1 2)' '1/2' check '(= 3 3.0)' 'false' check '(== 3 3.0)' 'true' +check_loc '(throw (ex-info "boom" {}))' ' at 1:' +check_loc '(do (+ 1 1) (/ 1 0))' ' at 1:' echo "cli smoke: $pass passed, $fails failed" [ "$fails" -eq 0 ]