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.
|
# JOLT_PWD.
|
||||||
root="$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)"
|
root="$(CDPATH= cd -- "$(dirname -- "$0")/.." && pwd)"
|
||||||
export JOLT_PWD="${JOLT_PWD:-$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".
|
# 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)}"
|
export JOLT_VERSION="${JOLT_VERSION:-$(git -C "$root" describe --tags --always --dirty 2>/dev/null || echo dev)}"
|
||||||
cd "$root" || exit 1
|
cd "$root" || exit 1
|
||||||
exec ${CHEZ} --script host/chez/cli.ss "$@"
|
exec chez --script host/chez/cli.ss "$@"
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -145,10 +145,11 @@
|
||||||
(scheme-start
|
(scheme-start
|
||||||
(lambda args
|
(lambda args
|
||||||
(set-source-roots! (list \"jolt-core\" \"stdlib\"))
|
(set-source-roots! (list \"jolt-core\" \"stdlib\"))
|
||||||
;; JOLT_TRACE at RUNTIME (the env is unset at heap-build), before any app ns
|
(guard (v (#t (jolt-report-throwable v (current-error-port))
|
||||||
;; compiles, so a `-M:run` traces the app's own code.
|
(let ((bt (jolt-backtrace-string v)))
|
||||||
(jolt-trace-init-from-env!)
|
(when bt (display \" trace:\\n\" (current-error-port))
|
||||||
(guard (v (#t (jolt-report-throwable v (current-error-port)) (exit 1)))
|
(display bt (current-error-port))))
|
||||||
|
(exit 1)))
|
||||||
(cond
|
(cond
|
||||||
((and (= (length args) 2) (string=? (car args) \"-e\"))
|
((and (= (length args) 2) (string=? (car args) \"-e\"))
|
||||||
(let ((result (jolt-final-str
|
(let ((result (jolt-final-str
|
||||||
|
|
|
||||||
|
|
@ -66,9 +66,6 @@
|
||||||
(when bt (display " trace:\n" port) (display bt port)))
|
(when bt (display " trace:\n" port) (display bt port)))
|
||||||
(exit 1)))
|
(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)))
|
(guard (v (#t (jolt-report-uncaught v)))
|
||||||
(cond
|
(cond
|
||||||
;; -e EXPR — evaluate one expression and print it (blank for nil). Wrapped in
|
;; -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 —
|
;; 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.
|
;; which is exactly the code you eval / reload in a live session.
|
||||||
(def-var! "jolt.host" "enable-trace!" jolt-enable-trace!)
|
(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
|
;; 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. Called
|
;; namespace is compiled, so a plain `-M:run` traces the app's own code too. Only an
|
||||||
;; from the runtime entrypoints (cli.ss, and the built joltc launcher) — NOT at load
|
;; affirmative value (set, non-empty, not falsey) forces it on here.
|
||||||
;; time: a built joltc runs top-level forms at heap-build time, where JOLT_TRACE is
|
(let ((e (getenv "JOLT_TRACE")))
|
||||||
;; always unset, so a load-time check would never see the user's runtime env. Only an
|
(when (and e (fx>? (string-length e) 0) (not (jolt-trace-env-off? e))) (jolt-enable-trace!)))
|
||||||
;; 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!))))
|
|
||||||
|
|
||||||
;; (with-meta sym m) -> sym, else x — an (ns ^:no-doc name …) yields the name with
|
;; (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.
|
;; 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
|
exit 1
|
||||||
fi
|
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
|
# 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
|
# 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.
|
# 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
|
else
|
||||||
pass=$((pass + 1))
|
pass=$((pass + 1))
|
||||||
fi
|
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 prints usage, and lists the nREPL server under its real flag name.
|
||||||
help_out="$(bin/joltc --help 2>/dev/null)"
|
help_out="$(bin/joltc --help 2>/dev/null)"
|
||||||
|
|
|
||||||
|
|
@ -790,21 +790,6 @@
|
||||||
(returns-scheme-bool? (:body node) bools'))
|
(returns-scheme-bool? (:body node) bools'))
|
||||||
:else false)))
|
: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]
|
(defn emit* [node]
|
||||||
(case (:op node)
|
(case (:op node)
|
||||||
:const (emit-const (:val node))
|
:const (emit-const (:val node))
|
||||||
|
|
@ -904,8 +889,7 @@
|
||||||
:fn (emit-fn node)
|
:fn (emit-fn node)
|
||||||
;; (def name) with no init (declare): reserve the cell. A def with non-empty
|
;; (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).
|
;; reader metadata lowers to def-var-with-meta! (ported in a later increment).
|
||||||
:def (let [reg (trace-source-reg node)
|
:def (cond
|
||||||
d (cond
|
|
||||||
(:no-init node)
|
(:no-init node)
|
||||||
(str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
(str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
||||||
(jmeta-nonempty? (:meta node))
|
(jmeta-nonempty? (:meta node))
|
||||||
|
|
@ -913,8 +897,7 @@
|
||||||
(emit-with-cells #(emit (:init node))) " " (emit-def-meta node) ")")
|
(emit-with-cells #(emit (:init node))) " " (emit-def-meta node) ")")
|
||||||
:else
|
:else
|
||||||
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
|
||||||
(emit-with-cells #(emit (:init node))) ")"))]
|
(emit-with-cells #(emit (:init node))) ")"))
|
||||||
(if (= reg "") d (str "(begin " d reg ")")))
|
|
||||||
(throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op 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,
|
;; ^: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