From 6df60229b053f04650f4ac2aaf43ab8c3571f5b9 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Fri, 19 Jun 2026 12:06:44 -0400 Subject: [PATCH] Chez Phase 2 (inc Y): runtime data reader + clojure.edn (jolt-r8ku) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Chez-side recursive-descent Clojure reader (host/chez/reader.ss) producing the same jolt forms the Janet reader yields, behind the read-string / __parse-next / __read-tagged seams the seed registers in eval_runtime.janet. That lights up the whole *in* read family — read, read+string, with-in-str (read) — plus read-string and read-string metadata, none of which needed an analyzer change (read-string is a clojure.core seam, jolt-nil on the prelude until now). Reader output is pinned to the Janet reader's shapes: numbers coerce to flonum (the all-double model emit-const uses, else a read int isn't = a source int), sets read as the {:jolt/type :jolt/set :value [...]} FORM, #tag/#inst/#uuid/#regex as tagged forms (no data reader applied — read-string never evaluates), ^meta on a symbol, and the ' ` ~ ~@ @ reader macros. clojure.edn is added to the prelude tier; its edn->value builds the real set/tagged values and __read-tagged reuses the inc X #inst/#uuid constructors. The reader-arity edn/read stays a lazy gap (drain-reader is Janet-coupled) — read-string is the live path. eval / load-string / runtime defmacro are still out: they need the compiler at runtime, which is Phase 3 (self-host). Chez-only change, no Janet gate. Parity 2238 -> 2259, 0 new divergences. _reader 47/47; all chez unit tests green; emit-test 331/331. --- host/chez/driver.janet | 6 +- host/chez/jolt-chez.janet | 4 +- host/chez/reader.ss | 370 +++++++++++++++++++++++++++++ host/chez/rt.ss | 5 + test/chez/_reader.janet | 95 ++++++++ test/chez/run-corpus-prelude.janet | 8 +- 6 files changed, 484 insertions(+), 4 deletions(-) create mode 100644 host/chez/reader.ss create mode 100644 test/chez/_reader.janet diff --git a/host/chez/driver.janet b/host/chez/driver.janet index 56c2347..02c294e 100644 --- a/host/chez/driver.janet +++ b/host/chez/driver.janet @@ -111,7 +111,11 @@ ["clojure.walk" "src/jolt/clojure/walk.clj"] # clojure.template requires clojure.walk (apply-template over postwalk-replace) # — must follow it so the alias resolves at emit time. - ["clojure.template" "src/jolt/clojure/template.clj"]]) + ["clojure.template" "src/jolt/clojure/template.clj"] + # clojure.edn requires clojure.string; read-string/__read-tagged are the + # reader.ss seams. The reader-arity's drain-reader is Janet-coupled (janet/type) + # so it's a lazy gap on Chez — read-string/edn->value are the live path. jolt-r8ku. + ["clojure.edn" "src/jolt/clojure/edn.clj"]]) (defn- sym-name [x] (when (and (struct? x) (= :symbol (get x :jolt/type))) (get x :name))) diff --git a/host/chez/jolt-chez.janet b/host/chez/jolt-chez.janet index 35cc199..5a19180 100644 --- a/host/chez/jolt-chez.janet +++ b/host/chez/jolt-chez.janet @@ -23,10 +23,10 @@ "host/chez/ns.ss" "host/chez/post-prelude.ss" "host/chez/natives-meta.ss" "host/chez/natives-str.ss" "host/chez/records.ss" "host/chez/host-class.ss" "host/chez/io.ss" - "host/chez/inst-time.ss" + "host/chez/inst-time.ss" "host/chez/reader.ss" "host/chez/host-static.ss" "host/chez/dot-forms.ss" "src/jolt/clojure/string.clj" "src/jolt/clojure/walk.clj" - "src/jolt/clojure/template.clj"] + "src/jolt/clojure/template.clj" "src/jolt/clojure/edn.clj"] (array/push parts (slurp f))) (string/slice (string (hash (string/join parts))) 0)) diff --git a/host/chez/reader.ss b/host/chez/reader.ss new file mode 100644 index 0000000..b4614a4 --- /dev/null +++ b/host/chez/reader.ss @@ -0,0 +1,370 @@ +;; Chez-side Clojure data reader (jolt-r8ku, inc Y). +;; +;; The data half of runtime read/eval: a recursive-descent reader that parses +;; ONE Clojure form off a string and produces the same jolt runtime values the +;; Janet reader's parse-next yields (the analyzer/eval half — eval, load-string, +;; runtime defmacro — stays Phase-3, it needs the compiler at runtime). Two host +;; seams hang off it, matching the Janet seed (eval_runtime.janet): +;; read-string : string -> first form (clojure.core seam, src 772) +;; __parse-next : string -> [form rest] | nil (the *in* family seam, src 801) +;; read / read+string / with-in-str / line-seq / clojure.edn are Clojure over +;; these (jolt-core/clojure/core/50-io.clj, src/jolt/clojure/edn.clj). +;; +;; Form shapes are pinned to the Janet reader's output (probed against build/jolt): +;; sets -> {:jolt/type :jolt/set :value [...]} (a FORM, not a set) +;; #tag frm -> {:jolt/type :jolt/tagged :tag :#tag :form ...} (NO data reader) +;; #"src" -> {:jolt/type :jolt/tagged :tag :regex :form "src"} +;; 'x `x ~x ~@x @x -> (quote x)/(syntax-quote x)/(unquote x)/ +;; (unquote-splicing x)/(clojure.core/deref x) +;; ^meta sym -> symbol carrying meta ({:tag "Name"} | {:kw true} | the map) +;; read-string of blank / comment-only input is nil (the documented seed wart), +;; NOT an EOF throw. + +;; Reader forms reuse these interned keywords for their tag structure. +(define rdr-kw-jolt-type (keyword "jolt" "type")) +(define rdr-kw-jolt-set (keyword "jolt" "set")) +(define rdr-kw-jolt-tagged (keyword "jolt" "tagged")) +(define rdr-kw-value (keyword #f "value")) +(define rdr-kw-tag (keyword #f "tag")) +(define rdr-kw-form (keyword #f "form")) + +;; A unique sentinel meaning "no form here" (EOF, or a close delimiter that the +;; caller — read-seq — must consume). Never a legal jolt value, so unambiguous. +(define rdr-eof (list 'reader-eof)) +(define (rdr-eof? x) (eq? x rdr-eof)) + +(define (rdr-ws? c) + (or (char-whitespace? c) (char=? c #\,))) + +(define (rdr-terminator? c) + (or (rdr-ws? c) + (memv c '(#\( #\) #\[ #\] #\{ #\} #\" #\; #\@ #\^ #\' #\` #\~ #\\)))) + +(define (rdr-digit? c) (and (char>=? c #\0) (char<=? c #\9))) + +;; Advance past whitespace, commas, and ;-to-end-of-line comments. +(define (rdr-skip-ws s i end) + (let loop ((i i)) + (cond + ((>= i end) i) + ((rdr-ws? (string-ref s i)) (loop (+ i 1))) + ((char=? (string-ref s i) #\;) + (let eol ((j (+ i 1))) + (if (or (>= j end) (char=? (string-ref s j) #\newline)) + (loop j) + (eol (+ j 1))))) + (else i)))) + +;; --- numbers ---------------------------------------------------------------- +;; A token is a number iff it (after an optional sign) starts with a digit and +;; parses. Ratios and big-N/M decimals follow the seed's all-double rendering +;; for division; ints/bignums stay exact (Chez's tower IS Clojure's). +(define (rdr-string-index-char str c) + (let ((n (string-length str))) + (let loop ((i 0)) + (cond ((>= i n) #f) + ((char=? (string-ref str i) c) i) + (else (loop (+ i 1))))))) + +;; jolt models EVERY number as a double (emit-const lowers integer literals to +;; flonums too), so the reader coerces every parsed number to inexact — else a +;; read int (exact) is not jolt= to a source int literal (flonum). +(define (rdr-try-number tok) + (let ((raw (rdr-try-number-raw tok))) + (and raw (exact->inexact raw)))) + +(define (rdr-try-number-raw tok) + (let ((len (string-length tok))) + (and (> len 0) + (let* ((c0 (string-ref tok 0)) + (signed (or (char=? c0 #\+) (char=? c0 #\-))) + (start (if signed 1 0))) + (and (> len start) + (rdr-digit? (string-ref tok start)) + (rdr-number-body tok start signed c0)))))) + +(define (rdr-number-body tok start signed sign-ch) + (let* ((sign (if (and signed (char=? sign-ch #\-)) -1 1)) + (len (string-length tok)) + (body (substring tok start len)) + (blen (string-length body)) + (slash (rdr-string-index-char body #\/))) + (cond + ;; ratio a/b -> flonum (the seed has no exact ratios) + (slash + (let ((n (string->number (substring body 0 slash))) + (d (string->number (substring body (+ slash 1) blen)))) + (and (integer? n) (integer? d) (not (= d 0)) + (* sign (exact->inexact (/ n d)))))) + ;; hex 0x.. + ((and (>= blen 2) (char=? (string-ref body 0) #\0) + (or (char=? (string-ref body 1) #\x) (char=? (string-ref body 1) #\X))) + (let ((h (string->number (substring body 2 blen) 16))) + (and h (* sign h)))) + ;; bigint suffix N + ((and (> blen 1) (char=? (string-ref body (- blen 1)) #\N)) + (let ((n (string->number (substring body 0 (- blen 1))))) + (and n (integer? n) (* sign n)))) + ;; bigdecimal suffix M -> double + ((and (> blen 1) (char=? (string-ref body (- blen 1)) #\M)) + (let ((n (string->number (substring body 0 (- blen 1))))) + (and n (exact->inexact (* sign n))))) + (else + (let ((n (string->number tok))) ; tok carries its own sign + (and (number? n) (real? n) + ;; never surface an exact non-integer ratio + (if (and (exact? n) (not (integer? n))) (exact->inexact n) n))))))) + +;; --- string / char literals ------------------------------------------------- +(define (rdr-hex->int s i n) ; n hex digits at i -> (values int j) + (let loop ((k 0) (acc 0) (j i)) + (if (= k n) + (values acc j) + (loop (+ k 1) (+ (* acc 16) (rdr-hexdigit (string-ref s j))) (+ j 1))))) + +(define (rdr-hexdigit c) + (cond ((and (char>=? c #\0) (char<=? c #\9)) (- (char->integer c) 48)) + ((and (char>=? c #\a) (char<=? c #\f)) (+ 10 (- (char->integer c) 97))) + ((and (char>=? c #\A) (char<=? c #\F)) (+ 10 (- (char->integer c) 65))) + (else (error 'reader "bad hex digit" c)))) + +;; opening quote already consumed; read to the closing quote, processing escapes. +(define (rdr-read-string-lit s i end) + (let loop ((i i) (acc '())) + (when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading string" (empty-pmap)))) + (let ((c (string-ref s i))) + (cond + ((char=? c #\") (values (list->string (reverse acc)) (+ i 1))) + ((char=? c #\\) + (let ((e (string-ref s (+ i 1)))) + (case e + ((#\n) (loop (+ i 2) (cons #\newline acc))) + ((#\t) (loop (+ i 2) (cons #\tab acc))) + ((#\r) (loop (+ i 2) (cons #\return acc))) + ((#\\) (loop (+ i 2) (cons #\\ acc))) + ((#\") (loop (+ i 2) (cons #\" acc))) + ((#\b) (loop (+ i 2) (cons #\backspace acc))) + ((#\f) (loop (+ i 2) (cons #\page acc))) + ((#\0) (loop (+ i 2) (cons #\nul acc))) + ((#\u) + (let-values (((cp j) (rdr-hex->int s (+ i 2) 4))) + (loop j (cons (integer->char cp) acc)))) + (else (loop (+ i 2) (cons e acc)))))) + (else (loop (+ i 1) (cons c acc))))))) + +;; backslash already consumed; read a Clojure character literal. +(define (rdr-read-char s i end) + (when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading char" (empty-pmap)))) + (let ((c0 (string-ref s i))) + (if (char-alphabetic? c0) + ;; named / unicode / single-letter: collect the alnum run + (let loop ((j (+ i 1))) + (if (and (< j end) + (let ((c (string-ref s j))) + (or (char-alphabetic? c) (char-numeric? c)))) + (loop (+ j 1)) + (let ((name (substring s i j))) + (if (= (string-length name) 1) + (values c0 j) + (values (rdr-named-char name) j))))) + ;; any other single char (\( \\ \; \space-as-symbol handled above) + (values c0 (+ i 1))))) + +(define (rdr-named-char name) + (cond + ((string=? name "newline") #\newline) + ((string=? name "space") #\space) + ((string=? name "tab") #\tab) + ((string=? name "return") #\return) + ((string=? name "backspace") #\backspace) + ((string=? name "formfeed") #\page) + ((char=? (string-ref name 0) #\u) + (integer->char (string->number (substring name 1 (string-length name)) 16))) + ((char=? (string-ref name 0) #\o) + (integer->char (string->number (substring name 1 (string-length name)) 8))) + (else (jolt-throw (jolt-ex-info (string-append "Unsupported character: \\" name) + (empty-pmap)))))) + +;; --- token (symbol / keyword / number / nil|true|false) --------------------- +(define (rdr-read-token s i end) + (let loop ((j i)) + (if (and (< j end) (not (rdr-terminator? (string-ref s j)))) + (loop (+ j 1)) + (values (substring s i j) j)))) + +;; split a "ns/name" token on the FIRST slash (a lone "/" is name "/") +(define (rdr-sym-parts tok) + (let ((slash (rdr-string-index-char tok #\/))) + (if (or (not slash) (= (string-length tok) 1) (= slash 0)) + (values #f tok) + (values (substring tok 0 slash) (substring tok (+ slash 1) (string-length tok)))))) + +(define (rdr-token->value tok) + (let ((n (rdr-try-number tok))) + (cond + (n n) + ((string=? tok "nil") jolt-nil) + ((string=? tok "true") #t) + ((string=? tok "false") #f) + (else (let-values (((ns name) (rdr-sym-parts tok))) (jolt-symbol ns name)))))) + +;; --- collections ------------------------------------------------------------ +;; Read forms until the close delimiter; returns (values reversed?-no list j). +(define (rdr-read-seq s i end close) + (let loop ((i i) (acc '())) + (let ((i (rdr-skip-ws s i end))) + (cond + ((>= i end) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap)))) + ((char=? (string-ref s i) close) (values (reverse acc) (+ i 1))) + (else + (let-values (((form j) (rdr-read-form s i end))) + (if (rdr-eof? form) + (loop j acc) ; a #_ discard or close — re-check at j + (loop j (cons form acc))))))))) + +(define (rdr-make-set elems) + (jolt-hash-map rdr-kw-jolt-type rdr-kw-jolt-set + rdr-kw-value (apply jolt-vector elems))) + +(define (rdr-make-tagged tag form) + (jolt-hash-map rdr-kw-jolt-type rdr-kw-jolt-tagged + rdr-kw-tag tag rdr-kw-form form)) + +;; --- metadata --------------------------------------------------------------- +(define (rdr-meta-map m) + (cond + ((keyword? m) (jolt-hash-map m #t)) + ((symbol-t? m) (jolt-hash-map rdr-kw-tag (symbol-t-name m))) + ((string? m) (jolt-hash-map rdr-kw-tag m)) + ((pmap? m) m) + (else (jolt-hash-map rdr-kw-tag m)))) + +(define (rdr-merge-meta old new) + (if (pmap? old) + (pmap-fold new (lambda (k v acc) (jolt-assoc1 acc k v)) old) + new)) + +(define (rdr-attach-meta target meta) + (if (symbol-t? target) + (make-symbol-t (symbol-t-ns target) (symbol-t-name target) + (rdr-merge-meta (symbol-t-meta target) meta)) + target)) ; non-symbol meta is dropped (corpus only hints symbols) + +;; --- # dispatch ------------------------------------------------------------- +(define (rdr-read-dispatch s i end) ; i points just past the '#' + (when (>= i end) (jolt-throw (jolt-ex-info "EOF after #" (empty-pmap)))) + (let ((c (string-ref s i))) + (cond + ((char=? c #\{) ; #{...} set + (let-values (((elems j) (rdr-read-seq s (+ i 1) end #\}))) + (values (rdr-make-set elems) j))) + ((char=? c #\") ; #"..." regex -> tagged :regex (raw source) + (let-values (((src j) (rdr-read-regex s (+ i 1) end))) + (values (rdr-make-tagged (keyword #f "regex") src) j))) + ((char=? c #\_) ; #_ discard the next form + (let-values (((_ j) (rdr-read-form s (+ i 1) end))) + (when (rdr-eof? _) (jolt-throw (jolt-ex-info "EOF after #_" (empty-pmap)))) + (rdr-read-form s j end))) + ((char=? c #\') ; #'x var-quote -> (var x) + (let-values (((form j) (rdr-read-form s (+ i 1) end))) + (values (jolt-list (jolt-symbol #f "var") form) j))) + (else ; #tag form -> tagged {:tag :#tag :form ...} + (let-values (((tok j) (rdr-read-token s i end))) + (let-values (((form k) (rdr-read-form s j end))) + (when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after #tag" (empty-pmap)))) + (values (rdr-make-tagged (keyword #f (string-append "#" tok)) form) k))))))) + +;; regex literal source: raw chars to the closing quote; \" is an escaped quote, +;; every other backslash sequence is kept verbatim (regex engine semantics). +(define (rdr-read-regex s i end) + (let loop ((i i) (acc '())) + (when (>= i end) (jolt-throw (jolt-ex-info "EOF while reading regex" (empty-pmap)))) + (let ((c (string-ref s i))) + (cond + ((char=? c #\") (values (list->string (reverse acc)) (+ i 1))) + ((and (char=? c #\\) (< (+ i 1) end) (char=? (string-ref s (+ i 1)) #\")) + (loop (+ i 2) (cons #\" acc))) + ((char=? c #\\) + (loop (+ i 2) (cons (string-ref s (+ i 1)) (cons #\\ acc)))) + (else (loop (+ i 1) (cons c acc))))))) + +;; --- keyword ---------------------------------------------------------------- +(define (rdr-read-keyword s i end) ; i points just past the leading ':' + ;; ::kw auto-resolves; the seed drops the ns, so skip a second ':' + (let ((i (if (and (< i end) (char=? (string-ref s i) #\:)) (+ i 1) i))) + (let-values (((tok j) (rdr-read-token s i end))) + (let-values (((ns name) (rdr-sym-parts tok))) + (values (keyword ns name) j))))) + +;; --- the main dispatch ------------------------------------------------------ +;; Returns (values form j). form is rdr-eof at end-of-input or at an unconsumed +;; close delimiter (read-seq consumes the close itself). +(define (rdr-read-form s i end) + (let ((i (rdr-skip-ws s i end))) + (if (>= i end) + (values rdr-eof i) + (let ((c (string-ref s i))) + (cond + ((char=? c #\() (let-values (((es j) (rdr-read-seq s (+ i 1) end #\)))) + (values (apply jolt-list es) j))) + ((char=? c #\[) (let-values (((es j) (rdr-read-seq s (+ i 1) end #\]))) + (values (apply jolt-vector es) j))) + ((char=? c #\{) (let-values (((es j) (rdr-read-seq s (+ i 1) end #\}))) + (values (apply jolt-hash-map es) j))) + ((or (char=? c #\)) (char=? c #\]) (char=? c #\})) + (values rdr-eof i)) ; unconsumed close — read-seq handles it + ((char=? c #\") (rdr-read-string-lit s (+ i 1) end)) + ((char=? c #\\) (rdr-read-char s (+ i 1) end)) + ((char=? c #\:) (rdr-read-keyword s (+ i 1) end)) + ((char=? c #\#) (rdr-read-dispatch s (+ i 1) end)) + ((char=? c #\') (rdr-wrap s (+ i 1) end (jolt-symbol #f "quote"))) + ((char=? c #\`) (rdr-wrap s (+ i 1) end (jolt-symbol #f "syntax-quote"))) + ((char=? c #\@) (rdr-wrap s (+ i 1) end (jolt-symbol "clojure.core" "deref"))) + ((char=? c #\~) + (if (and (< (+ i 1) end) (char=? (string-ref s (+ i 1)) #\@)) + (rdr-wrap s (+ i 2) end (jolt-symbol #f "unquote-splicing")) + (rdr-wrap s (+ i 1) end (jolt-symbol #f "unquote")))) + ((char=? c #\^) + (let-values (((mform j) (rdr-read-form s (+ i 1) end))) + (let-values (((target k) (rdr-read-form s j end))) + (when (rdr-eof? target) + (jolt-throw (jolt-ex-info "EOF after ^meta" (empty-pmap)))) + (values (rdr-attach-meta target (rdr-meta-map mform)) k)))) + (else + (let-values (((tok j) (rdr-read-token s i end))) + (values (rdr-token->value tok) j)))))))) + +;; wrap the next form in a 2-element list (READER-MACRO form) +(define (rdr-wrap s i end head) + (let-values (((form j) (rdr-read-form s i end))) + (when (rdr-eof? form) + (jolt-throw (jolt-ex-info "EOF while reading reader macro" (empty-pmap)))) + (values (jolt-list head form) j))) + +;; --- the two host seams ----------------------------------------------------- +;; clojure.core/read-string: first form, or nil for blank / comment-only input +;; (the seed's parse-string wart, matched deliberately). +(define (jolt-read-string s) + (let-values (((form j) (rdr-read-form s 0 (string-length s)))) + (if (rdr-eof? form) jolt-nil form))) + +;; __parse-next: [form rest-of-string] or nil when only whitespace/comments left. +(define (jolt-parse-next s) + (let ((end (string-length s))) + (let-values (((form j) (rdr-read-form s 0 end))) + (if (rdr-eof? form) + jolt-nil + (jolt-vector form (substring s j end)))))) + +;; __read-tagged: apply a built-in data reader to an already-read form. The tag +;; is the :#name keyword the reader produced; #uuid/#inst reuse the inc X ctors. +(define (jolt-read-tagged tag form) + (cond + ((eq? tag (keyword #f "#uuid")) (jolt-uuid-from-string form)) + ((eq? tag (keyword #f "#inst")) (jolt-inst-from-string form)) + (else (jolt-throw (jolt-ex-info (string-append "No reader function for tag " (jolt-pr-str tag)) + (empty-pmap)))))) + +(def-var! "clojure.core" "read-string" jolt-read-string) +(def-var! "clojure.core" "__parse-next" jolt-parse-next) +(def-var! "clojure.core" "__read-tagged" jolt-read-tagged) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 765a1fe..3050580 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -299,3 +299,8 @@ ;; LAST — it extends record-method-dispatch / jolt-get / jolt= / jolt-hash / ;; jolt-pr-str / jolt-type / instance-check and uses host-static.ss's registries. (load "host/chez/inst-time.ss") + +;; Chez-side data reader (jolt-r8ku inc Y): read-string / __parse-next / +;; __read-tagged. Loads after inst-time.ss — __read-tagged reuses its #uuid/#inst +;; constructors, and the reader needs the full value/collection layer above. +(load "host/chez/reader.ss") diff --git a/test/chez/_reader.janet b/test/chez/_reader.janet new file mode 100644 index 0000000..1be810c --- /dev/null +++ b/test/chez/_reader.janet @@ -0,0 +1,95 @@ +# jolt-r8ku (inc Y) — Chez-side Clojure data reader: read-string / read / +# read+string / with-in-str / clojure.edn. The reader (host/chez/reader.ss) +# produces the same jolt forms the Janet reader yields; the *in* family and +# clojure.edn are Clojure over the read-string / __parse-next seams. +# +# Outputs are kept order-stable (equality checks, scalars) so set/map iteration +# order — which legitimately differs from build/jolt — doesn't masquerade as a +# divergence. Oracle = build/jolt. +# +# janet test/chez/_reader.janet +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) + +(def cases + [# --- scalars + collections (value equality, order-independent) --- + ["(= 42 (read-string \"42\"))" "true"] + ["(= 42 (read-string \"0x2A\"))" "true"] + ["(= 0.5 (read-string \"1/2\"))" "true"] + ["(= -3.5 (read-string \"-3.5\"))" "true"] + ["(= 1000.0 (read-string \"1e3\"))" "true"] + ["(= 1 (read-string \"1N\"))" "true"] + ["(integer? (read-string \"7\"))" "true"] + ["(= :foo (read-string \":foo\"))" "true"] + ["(= :a/b (read-string \":a/b\"))" "true"] + ["(= :foo (read-string \"::foo\"))" "true"] + ["(= (quote sym) (read-string \"sym\"))" "true"] + ["(= (quote ns/sym) (read-string \"ns/sym\"))" "true"] + ["(nil? (read-string \"nil\"))" "true"] + ["(true? (read-string \"true\"))" "true"] + ["(false? (read-string \"false\"))" "true"] + ["(= \\a (read-string \"\\\\a\"))" "true"] + ["(= \\newline (read-string \"\\\\newline\"))" "true"] + ["(= \\space (read-string \"\\\\space\"))" "true"] + ["(= \"a\\nb\" (read-string \"\\\"a\\\\nb\\\"\"))" "true"] + ["(= [1 2 3] (read-string \"[1 2 3]\"))" "true"] + ["(= (quote (+ 1 2)) (read-string \"(+ 1 2)\"))" "true"] + ["(= {:a 1 :b 2} (read-string \"{:a 1 :b 2}\"))" "true"] + # core read-string returns the raw set FORM (edn->value builds the real set) + ["(:value (read-string \"#{1 2 3}\"))" "[1 2 3]"] + ["(= :jolt/set (:jolt/type (read-string \"#{1 2 3}\")))" "true"] + ["(= [1 [2 3] {:k :v}] (read-string \"[1 [2 3] {:k :v}]\"))" "true"] + # --- reader macros --- + ["(= (quote (quote x)) (read-string \"'x\"))" "true"] + ["(= (quote (clojure.core/deref a)) (read-string \"@a\"))" "true"] + ["(= (quote (syntax-quote (a (unquote b)))) (read-string \"`(a ~b)\"))" "true"] + ["(= (quote (unquote-splicing xs)) (read-string \"~@xs\"))" "true"] + # --- whitespace / comments / discard --- + ["(= 42 (read-string \"; comment\\n42\"))" "true"] + ["(= [1 2] (read-string \"[1 #_ 9 2]\"))" "true"] + ["(nil? (read-string \"\"))" "true"] + ["(nil? (read-string \" , ,\"))" "true"] + # --- metadata ^ on a symbol --- + ["(:tag (meta (read-string \"^String x\")))" "String"] + ["(:foo (meta (read-string \"^:foo x\")))" "true"] + # --- *in* reader family: read / read+string / with-in-str --- + ["(= 42 (with-in-str \"42\" (read)))" "true"] + ["(= (quote (+ 1 2)) (with-in-str \"(+ 1 2)\" (read)))" "true"] + ["(with-in-str \"1 2\" [(read) (read)])" "[1 2]"] + ["(= :done (with-in-str \"\" (read *in* false :done)))" "true"] + ["(let [[v s] (with-in-str \"42 rest\" (read+string))] (and (= v 42) (string? s)))" "true"] + ["(= [1 2] (with-in-str \"1 2\" [(first (read+string)) (first (read+string))]))" "true"] + # --- clojure.edn (set/tagged forms built into real values) --- + ["(do (require (quote [clojure.edn :as e0])) (= #{1 2} (e0/read-string \"#{1 2}\")))" "true"] + ["(do (require (quote [clojure.edn :as e0])) (uuid? (e0/read-string \"#uuid \\\"550e8400-e29b-41d4-a716-446655440000\\\"\")))" "true"] + ["(do (require (quote [clojure.edn :as e0])) (inst? (e0/read-string \"#inst \\\"2020-01-01T00:00:00Z\\\"\")))" "true"] + ["(do (require (quote [clojure.edn :as e0])) (= :end (e0/read-string {:eof :end} \"\")))" "true"] + ["(do (require (quote [clojure.edn :as e0])) (= [:custom 5] (e0/read-string {:readers {(quote custom) (fn [v] [:custom v])}} \"#custom 5\")))" "true"] + ["(do (require (quote clojure.edn)) (= {:a 1 :b 2} (clojure.edn/read-string \"{:a 1\\n :b 2}\")))" "true"]]) + +(defn run-capture [bin expr] + (def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe})) + (def out (ev/read (proc :out) 0x100000)) + (def err (ev/read (proc :err) 0x100000)) + (def code (os/proc-wait proc)) + (def lines (filter (fn [l] (not (empty? l))) + (string/split "\n" (string/trim (if out (string out) ""))))) + [code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))]) + +(var pass 0) +(def fails @[]) +(each [expr expected] cases + (def [ocode oracle _] (run-capture "build/jolt" expr)) + (def [code got err] (run-capture jolt-bin expr)) + (cond + (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) + (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) + (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) + (= got expected) (++ pass) + (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) + +(printf "\n_reader parity [%s]: %d/%d passed" jolt-bin pass (length cases)) +(when (> (length fails) 0) + (printf "%d FAIL(s):" (length fails)) + (each [e m] fails (printf " FAIL %s\n %s" e m))) +(flush) +(os/exit (if (empty? fails) 0 1)) diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index 4ead9b1..a3c5ca1 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -269,8 +269,14 @@ # offsets, = / hash / pr-str / get-as-overlay-seam) plus the DateTimeFormatter # pattern engine + Instant/ZoneId/LocalDateTime/FormatStyle/Locale/Date shims. # This cleared the whole "unsupported form" emit-fail bucket) 2238. +# jolt-r8ku inc Y (Chez data reader — host/chez/reader.ss, a recursive-descent +# Clojure reader producing the same forms as the Janet reader, behind the +# read-string / __parse-next / __read-tagged seams) + clojure.edn loaded into the +# prelude. Lights up read / read+string / with-in-str (read) / read-string and +# clojure.edn/read-string. (eval / load-string / runtime defmacro stay Phase-3 — +# they need the compiler at runtime.) 2259. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2238"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2259"))) (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor)) (when (or (> (length diverged) 0) (< pass floor)) (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))