jolt/host/chez/cli.ss
Yogthos 6ab65a30e3 Fix arg evaluation order + host interop gaps so reitit/selmer/honeysql run
Shaking the ring-app example's real library stack out against jolt surfaced a
batch of divergences from JVM Clojure, the biggest being evaluation order.

backend_scheme: call and recur arguments were emitted as bare Scheme operands,
so Chez's unspecified (right-to-left) order won out. Clojure evaluates left to
right, which selmer's reader loop relies on: (recur (add-node ... rdr) (read-char
rdr)) consumed a char early and dropped the first chars of every {{tag}}. Bind
operands to fresh temps in a let* (only when two or more can have side effects,
so hot calls over locals/consts stay un-wrapped). emit-ordered already did this
for collection literals; generalize it.

host-contract: syntax-quote now resolves the alias part of a qualified symbol
(impl/foo -> clojure.tools.logging.impl/foo) instead of leaving it bare, which
limped along via short-name matching until two loaded namespaces (reitit.impl,
clojure.tools.logging.impl) shared the short name and it broke.

collections: key-hash masks with bitwise-and, not fxand — jolt-hash is set!-
decorated per type (records return their own hash) and Chez's equal-hash can be a
bignum, so a key's hash isn't always a fixnum.

seq: even?/odd? handle bignums (JVM accepts any integer; the fxand crashed).

records: Keyword/Symbol .sym/.getName/.toString (honeysql's :clj branch reads
(.sym k)); Throwable .getMessage/.toString over a Chez condition.

host-static: __register-class-ctor!/__register-class-statics! so a host shim
(reitit.trie-jolt) can mirror a Java class.

natives-str: String.intern returns the string.

sqlite: jdbc.core fetch/fetch-one kebab-case column keys (the jolt-lang/db
convention; created_at -> :created-at).

io: a relative io/file path resolves against JOLT_PWD (the user's cwd), not the
repo root the launcher cd'd to — matches JVM cwd semantics, so config.edn loads.

cli: render an uncaught jolt throw (ex-info message + ex-data, or a condition)
instead of Chez's opaque "non-condition value" dump.
2026-06-22 05:26:09 -04:00

70 lines
3.4 KiB
Scheme

;; cli.ss (jolt-9phg / jolt-90sp) — the pure-Chez jolt runtime. NO Janet.
;;
;; Loads the checked-in seed (host/chez/seed/{prelude,image}.ss — the bootstrap
;; compiler) and the zero-Janet spine, then either evaluates a -e expression or
;; dispatches a CLI command (run/-M/repl/path/task) through jolt.main. The loader
;; (loader.ss) turns `require` into real file loading off the source roots, so a
;; multi-file project with deps.edn dependencies runs end to end.
;;
;; Run from the repo root (bin/joltc cd's there); the project dir is JOLT_PWD.
(import (chezscheme))
(define cli-args (cdr (command-line))) ; drop the script name
(load "host/chez/rt.ss")
(set-chez-ns! "clojure.core")
(load "host/chez/seed/prelude.ss")
(load "host/chez/post-prelude.ss")
(set-chez-ns! "user")
(load "host/chez/host-contract.ss")
(load "host/chez/seed/image.ss")
(load "host/chez/compile-eval.ss")
(load "host/chez/png.ss") ; jolt.png — a baked namespace before the snapshot
(load "host/chez/http-client.ss") ; jolt.http-client (libcurl)
(load "host/chez/sqlite.ss") ; jolt.sqlite + jdbc.core (libsqlite3)
(load "host/chez/http-server.ss") ; jolt.http.server + ring-janet.adapter (BSD sockets)
(load "host/chez/loader.ss")
;; jolt.main + jolt.deps live under jolt-core; keep them (and src/jolt) on the
;; roots so the CLI's own namespaces — and any jolt.* an app pulls in — resolve.
;; A project's resolved deps roots are prepended to these by jolt.main.
(set-source-roots! (list "jolt-core" "src/jolt"))
;; Render an uncaught jolt throw (any value, not just a Chez condition) to stderr
;; and exit non-zero, instead of Chez's opaque "non-condition value" dump. An
;; ex-info shows its message + ex-data; anything else is pr-str'd.
(define (jolt-report-uncaught v)
(let ((port (current-error-port)))
(if (and (jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info))
(begin
(display "Unhandled exception: " port)
(display (jolt-str-render-one (jolt-get v jolt-kw-message jolt-nil)) port)
(newline port)
(let ((data (jolt-get v jolt-kw-data jolt-nil)))
(unless (jolt-nil? data)
(display " ex-data: " port) (display (jolt-pr-str data) port) (newline port)))
(let ((cause (jolt-get v jolt-kw-cause jolt-nil)))
(when (condition? cause)
(display " cause: " port)
(display (with-output-to-string (lambda () (display-condition cause))) port)
(newline port))))
(begin
(display "Unhandled exception: " port)
(display (if (condition? v) (with-output-to-string (lambda () (display-condition v))) (jolt-pr-str v)) port)
(newline port)))
(exit 1)))
(guard (v (#t (jolt-report-uncaught v)))
(cond
;; -e EXPR — evaluate one expression and print it (blank for nil). Wrapped in
;; (do …) so a multi-form string evaluates every form and returns the last.
((and (= (length cli-args) 2) (string=? (car cli-args) "-e"))
(let ((result (jolt-final-str
(jolt-compile-eval (string-append "(do " (cadr cli-args) ")") "user"))))
(unless (string=? result "")
(display result) (newline))))
;; otherwise dispatch the argv through jolt.main/-main
(else
(load-namespace "jolt.main")
(let ((mainv (var-deref "jolt.main" "-main")))
(apply jolt-invoke mainv cli-args)))))