Compare commits
No commits in common. "main" and "tail-frame-history" have entirely different histories.
main
...
tail-frame
8 changed files with 96 additions and 172 deletions
23
bin/joltc
23
bin/joltc
|
|
@ -14,28 +14,7 @@
|
|||
# JOLT_PWD.
|
||||
root="$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)"
|
||||
export JOLT_PWD="${JOLT_PWD:-$PWD}"
|
||||
|
||||
# Identify the Chez Scheme executable
|
||||
while read -r CHEZ
|
||||
do
|
||||
if [ `which ${CHEZ}` ]
|
||||
then
|
||||
break;
|
||||
fi
|
||||
done <<EOF
|
||||
chez
|
||||
chezscheme
|
||||
EOF
|
||||
|
||||
# If we failed to find one, whinge and exit.
|
||||
if [ ! `which ${CHEZ}` ]
|
||||
then
|
||||
echo "No valid Chez Scheme executable found: please install Chez Scheme."
|
||||
exit 1
|
||||
fi
|
||||
|
||||
# Version for --version / banners: git describe of this checkout, else "dev".
|
||||
export JOLT_VERSION="${JOLT_VERSION:-$(git -C "$root" describe --tags --always --dirty 2>/dev/null || echo dev)}"
|
||||
cd "$root" || exit 1
|
||||
exec ${CHEZ} --script host/chez/cli.ss "$@"
|
||||
|
||||
exec chez --script host/chez/cli.ss "$@"
|
||||
|
|
|
|||
|
|
@ -145,10 +145,11 @@
|
|||
(scheme-start
|
||||
(lambda args
|
||||
(set-source-roots! (list \"jolt-core\" \"stdlib\"))
|
||||
;; JOLT_TRACE at RUNTIME (the env is unset at heap-build), before any app ns
|
||||
;; compiles, so a `-M:run` traces the app's own code.
|
||||
(jolt-trace-init-from-env!)
|
||||
(guard (v (#t (jolt-report-throwable v (current-error-port)) (exit 1)))
|
||||
(guard (v (#t (jolt-report-throwable v (current-error-port))
|
||||
(let ((bt (jolt-backtrace-string v)))
|
||||
(when bt (display \" trace:\\n\" (current-error-port))
|
||||
(display bt (current-error-port))))
|
||||
(exit 1)))
|
||||
(cond
|
||||
((and (= (length args) 2) (string=? (car args) \"-e\"))
|
||||
(let ((result (jolt-final-str
|
||||
|
|
|
|||
|
|
@ -66,9 +66,6 @@
|
|||
(when bt (display " trace:\n" port) (display bt port)))
|
||||
(exit 1)))
|
||||
|
||||
;; JOLT_TRACE opt-in, at runtime (before any app ns compiles) so the app is traced.
|
||||
(jolt-trace-init-from-env!)
|
||||
|
||||
(guard (v (#t (jolt-report-uncaught v)))
|
||||
(cond
|
||||
;; -e EXPR — evaluate one expression and print it (blank for nil). Wrapped in
|
||||
|
|
|
|||
|
|
@ -132,16 +132,11 @@
|
|||
;; push is baked in at compile time, only code compiled after this call is traced —
|
||||
;; which is exactly the code you eval / reload in a live session.
|
||||
(def-var! "jolt.host" "enable-trace!" jolt-enable-trace!)
|
||||
;; Explicit opt-in for a whole run (JOLT_TRACE=1): turn tracing on BEFORE any app
|
||||
;; namespace is compiled, so a plain `-M:run` traces the app's own code too. Called
|
||||
;; from the runtime entrypoints (cli.ss, and the built joltc launcher) — NOT at load
|
||||
;; time: a built joltc runs top-level forms at heap-build time, where JOLT_TRACE is
|
||||
;; always unset, so a load-time check would never see the user's runtime env. Only an
|
||||
;; affirmative value (set, non-empty, not falsey) forces it on.
|
||||
(define (jolt-trace-init-from-env!)
|
||||
(let ((e (getenv "JOLT_TRACE")))
|
||||
(when (and e (fx>? (string-length e) 0) (not (jolt-trace-env-off? e)))
|
||||
(jolt-enable-trace!))))
|
||||
;; Explicit opt-in for a whole run (JOLT_TRACE=1): enable at load, BEFORE any app
|
||||
;; namespace is compiled, so a plain `-M:run` traces the app's own code too. Only an
|
||||
;; affirmative value (set, non-empty, not falsey) forces it on here.
|
||||
(let ((e (getenv "JOLT_TRACE")))
|
||||
(when (and e (fx>? (string-length e) 0) (not (jolt-trace-env-off? e))) (jolt-enable-trace!)))
|
||||
|
||||
;; (with-meta sym m) -> sym, else x — an (ns ^:no-doc name …) yields the name with
|
||||
;; reader metadata as a with-meta form; strip it to read the bare ns symbol.
|
||||
|
|
|
|||
|
|
@ -42,20 +42,6 @@ if [ "$got_e" != "45" ]; then
|
|||
exit 1
|
||||
fi
|
||||
|
||||
# 2b. JOLT_TRACE must take effect in the BUILT binary. The env check runs at
|
||||
# runtime (the launcher), NOT at heap-build where JOLT_TRACE is always unset — so
|
||||
# an uncaught error shows a tail-frame trace recovering the TCO-elided chain, and
|
||||
# exactly ONE trace block (the launcher must not double-print it).
|
||||
got_tr="$(env -i HOME="$HOME" JOLT_TRACE=1 "$joltc" -e '(defn a [x] (+ x 1)) (defn b [x] (a x)) (b :x)' 2>&1)"
|
||||
if ! printf '%s' "$got_tr" | grep -q ' trace:' || ! printf '%s' "$got_tr" | grep -q 'b'; then
|
||||
echo " FAIL: JOLT_TRACE=1 in the built joltc produced no tail-frame trace"
|
||||
echo "--- got ---"; echo "$got_tr"; exit 1
|
||||
fi
|
||||
if [ "$(printf '%s' "$got_tr" | grep -c ' trace:')" != "1" ]; then
|
||||
echo " FAIL: built joltc double-printed the trace block"
|
||||
echo "--- got ---"; echo "$got_tr"; exit 1
|
||||
fi
|
||||
|
||||
# 3. Build an app through the distributed joltc with an EMPTY environment — no
|
||||
# PATH at all, so no chez, no cc, no shell tools are reachable. This is the core
|
||||
# guarantee: joltc compiles apps entirely on its own.
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -124,21 +124,6 @@ if printf '%s' "$err_stale" | grep -q 'h1'; then
|
|||
else
|
||||
pass=$((pass + 1))
|
||||
fi
|
||||
# A file-backed project run maps each runtime-compiled frame to ns/name (file:line)
|
||||
# — the eval path registers source in trace mode, so the trace isn't bare names.
|
||||
tr_proj="$(mktemp -d)"
|
||||
mkdir -p "$tr_proj/src/tp"
|
||||
printf '{:paths ["src"] :aliases {:run {:main-opts ["-m" "tp.core"]}}}\n' > "$tr_proj/deps.edn"
|
||||
printf '(ns tp.core)\n(defn deep [x] (+ x 1))\n(defn mid [x] (inc (deep x)))\n(defn -main [& _] (mid :nan))\n' > "$tr_proj/src/tp/core.clj"
|
||||
tr_out="$(JOLT_TRACE=1 JOLT_PWD="$tr_proj" bin/joltc -M:run 2>&1)"
|
||||
if printf '%s' "$tr_out" | grep -Eq 'tp\.core/deep \(.*/tp/core\.clj:2\)'; then
|
||||
pass=$((pass + 1))
|
||||
else
|
||||
echo " FAIL: JOLT_TRACE trace should map a frame to ns/name (file:line)"
|
||||
printf '%s\n' "$tr_out" | sed 's/^/ | /'
|
||||
fails=$((fails + 1))
|
||||
fi
|
||||
rm -rf "$tr_proj"
|
||||
|
||||
# --help prints usage, and lists the nREPL server under its real flag name.
|
||||
help_out="$(bin/joltc --help 2>/dev/null)"
|
||||
|
|
|
|||
|
|
@ -790,21 +790,6 @@
|
|||
(returns-scheme-bool? (:body node) bools'))
|
||||
:else false)))
|
||||
|
||||
;; In trace mode, a fn def also registers its source so the tail-frame history maps
|
||||
;; the recorded frame-name to "ns/name (file:line)" instead of a bare name. Keyed by
|
||||
;; the SAME munged name the entry push records (emit-fn's letrec self-binding = the
|
||||
;; fn's own name). Returns "" when off / not a positioned fn def, so trace-off output
|
||||
;; (seed mint, `jolt build`) is byte-identical. Direct-link builds already register
|
||||
;; via emit-def-cached; this covers the open-world eval path.
|
||||
(defn- trace-source-reg [node]
|
||||
(let [init (:init node) pos (:pos node)]
|
||||
(if (and @trace-frames? (= :fn (:op init)) (:name init) pos)
|
||||
(str " (jolt-register-source! " (chez-str-lit (munge-name (:name init))) " "
|
||||
(chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||
(if (:file pos) (chez-str-lit (:file pos)) "jolt-nil") " "
|
||||
(or (:line pos) 0) ")")
|
||||
"")))
|
||||
|
||||
(defn emit* [node]
|
||||
(case (:op node)
|
||||
:const (emit-const (:val node))
|
||||
|
|
@ -904,17 +889,15 @@
|
|||
:fn (emit-fn node)
|
||||
;; (def name) with no init (declare): reserve the cell. A def with non-empty
|
||||
;; reader metadata lowers to def-var-with-meta! (ported in a later increment).
|
||||
:def (let [reg (trace-source-reg node)
|
||||
d (cond
|
||||
(:no-init node)
|
||||
(str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
||||
(jmeta-nonempty? (:meta node))
|
||||
(str "(def-var-with-meta! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||
(emit-with-cells #(emit (:init node))) " " (emit-def-meta node) ")")
|
||||
:else
|
||||
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||
(emit-with-cells #(emit (:init node))) ")"))]
|
||||
(if (= reg "") d (str "(begin " d reg ")")))
|
||||
:def (cond
|
||||
(:no-init node)
|
||||
(str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
||||
(jmeta-nonempty? (:meta node))
|
||||
(str "(def-var-with-meta! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||
(emit-with-cells #(emit (:init node))) " " (emit-def-meta node) ")")
|
||||
:else
|
||||
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||
(emit-with-cells #(emit (:init node))) ")"))
|
||||
(throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op node))) {}))))
|
||||
|
||||
;; ^:dynamic / ^:redef on a def opts it out of direct-linking: it stays redefinable,
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue