diff --git a/jolt-core/jolt/reader.clj b/jolt-core/jolt/reader.clj index 2d8149c..faf93c2 100644 --- a/jolt-core/jolt/reader.clj +++ b/jolt-core/jolt/reader.clj @@ -19,7 +19,9 @@ (#) land in 5b/5c (they throw not-yet-ported so a hit is loud)." (:require [clojure.string :as str] [jolt.host :refer [form-make-symbol form-make-char form-char-from-name - form-scan-number]])) + form-scan-number form-make-list form-make-vector + form-make-map form-sym-merge-meta + form-sym? form-sym-name form-sym-ns form-char?]])) ;; Source access by CHARACTER codepoint, mirroring the Janet reader's byte access ;; (identical for ASCII). cp = codepoint at i; len = character count. @@ -172,27 +174,135 @@ [(form-char-from-name (subs s (inc pos) end)) end]))) ;; --- dispatcher -------------------------------------------------------------- +;; read-form returns a CONTROL triple [kind payload pos]: +;; :form payload=the form a real datum +;; :skip payload=nil a comment (;) or #_ discard — produced nothing +;; :splice payload=items-vector #?@ — contributes 0+ items to the enclosing coll +;; Out-of-band control (vs the Janet reader's :jolt/skip / :jolt/splice sentinel +;; FORMS) keeps it collision-free and host-neutral — no tagged-struct to build or +;; recognize. Collection readers dispatch on kind; read-next-form skips :skip. +(declare read-form) + (defn- number-start? [s pos c] (or (digit? c) (and (= c 45) (< (inc pos) (len s)) (digit? (cp s (inc pos)))) (and (= c 43) (< (inc pos) (len s)) (digit? (cp s (inc pos)))))) +;; Read items until `close`, dispatching control kinds. Returns [items-vec end]. +(defn- read-delimited [s start-pos close errmsg] + (loop [pos start-pos items []] + (let [pos (skip-whitespace s pos)] + (when (>= pos (len s)) (throw (ex-info errmsg {}))) + (if (= (cp s pos) close) + [items (inc pos)] + (let [[kind payload np] (read-form s pos)] + (case kind + :skip (recur np items) + :splice (recur np (into items payload)) + :form (recur np (conj items payload)))))))) + +(defn- read-list* [s pos] + (let [[items end] (read-delimited s (inc pos) 41 "Unterminated list")] ; ) + [:form (form-make-list items) end])) + +(defn- read-vector* [s pos] + (let [[items end] (read-delimited s (inc pos) 93 "Unterminated vector")] ; ] + [:form (form-make-vector items) end])) + +;; Map: pair up keys and values, skipping comments/#_ in either slot while keeping +;; the pending key (dropping both desyncs the pairing). Splice in a map slot lands +;; in inc 5c; here a key/value is always a single :form (or :skip). +(defn- read-map* [s pos] + (loop [pos (inc pos) kvs []] + (let [pos (skip-whitespace s pos)] + (when (>= pos (len s)) (throw (ex-info "Unterminated map" {}))) + (if (= (cp s pos) 125) ; } + [:form (form-make-map kvs) (inc pos)] + (let [[kk kp knp] (read-form s pos)] + (if (= kk :skip) + (recur knp kvs) + ;; key in hand; read the value slot, skipping trivia but keeping the key + (let [[v vnp] + (loop [vp (skip-whitespace s knp)] + (when (>= vp (len s)) (throw (ex-info "Unterminated map" {}))) + (let [[vk vp2 vnp2] (read-form s vp)] + (if (= vk :skip) (recur (skip-whitespace s vnp2)) [vp2 vnp2])))] + (recur vnp (conj (conj kvs kp) v))))))))) + +;; Read the next REAL form (skip :skip), returning [form pos]. Used wherever a +;; single datum is needed (quote/meta/top level). +(defn- read-next-form [s pos] + (let [[kind payload np] (read-form s pos)] + (case kind + :skip (recur s np) + :form [payload np] + :splice (throw (ex-info "splice (#?@) not inside a collection" {}))))) + +;; syntax-quote of a self-evaluating literal collapses to the literal at read time +;; (so nested backticks over literals are inert). NOT symbols (they qualify) or +;; collections (they template). +(defn- self-evaluating-literal? [form] + (or (nil? form) (true? form) (false? form) (number? form) + (string? form) (keyword? form) (form-char? form))) + +(defn- read-quote* [s newpos token-sym] + (let [[form finalpos] (read-next-form s newpos)] + (if (and (= "syntax-quote" (form-sym-name token-sym)) (self-evaluating-literal? form)) + [:form form finalpos] + [:form (form-make-list [token-sym form]) finalpos]))) + +;; Normalize a metadata reader form: keyword -> {kw true}; symbol/string -> {:tag …} +;; (a symbol tag keeps its ns qualifier); else nil (a map-literal meta). +(defn- meta-form->map [meta-form] + (cond + (keyword? meta-form) {meta-form true} + (form-sym? meta-form) {:tag (if (form-sym-ns meta-form) + (str (form-sym-ns meta-form) "/" (form-sym-name meta-form)) + (form-sym-name meta-form))} + (string? meta-form) {:tag meta-form} + :else nil)) + +(defn- read-meta* [s pos] + ;; pos at ^ + (let [[meta-form np] (read-next-form s (inc pos)) + [form np2] (read-next-form s np) + m (meta-form->map meta-form)] + (if (and m (form-sym? form)) + ;; attach to the symbol itself (^Type x / ^:dynamic) — stays a bare symbol + [:form (form-sym-merge-meta form m) np2] + ;; non-symbol target -> a runtime with-meta form (normalized map, or the + ;; raw map-literal meta when m is nil) + [:form (form-make-list [(form-make-symbol "with-meta") form (if m m meta-form)]) np2]))) + (defn read-form [s pos] (let [pos (skip-whitespace s pos)] (if (>= pos (len s)) - [nil pos] + [:form nil pos] (let [c (cp s pos)] (cond - (= c 59) (read-form s (read-until-newline s pos)) ; ; comment: skip + reread - (= c 34) (read-string* s pos) - (= c 58) (read-keyword* s pos) - (= c 92) (read-char* s pos) - (number-start? s pos c) (read-number* s pos) - (symbol-start? c) (read-symbol* s pos) - :else (throw (ex-info (str "read-form: not yet ported (inc 5a atoms): '" - (char c) "' (" c ")") {}))))))) + (= c 59) [:skip nil (read-until-newline s pos)] ; ; comment + (= c 34) (let [r (read-string* s pos)] [:form (nth r 0) (nth r 1)]) + (= c 58) (let [r (read-keyword* s pos)] [:form (nth r 0) (nth r 1)]) + (= c 92) (let [r (read-char* s pos)] [:form (nth r 0) (nth r 1)]) + (= c 40) (read-list* s pos) ; ( + (= c 91) (read-vector* s pos) ; [ + (= c 123) (read-map* s pos) ; { + (= c 39) (read-quote* s (inc pos) (form-make-symbol "quote")) ; ' + (= c 96) (read-quote* s (inc pos) (form-make-symbol "syntax-quote")) ; ` + (= c 126) (if (and (< (inc pos) (len s)) (= (cp s (inc pos)) 64)) ; ~ / ~@ + (read-quote* s (+ pos 2) (form-make-symbol "unquote-splicing")) + (read-quote* s (inc pos) (form-make-symbol "unquote"))) + (= c 64) (read-quote* s (inc pos) (form-make-symbol "clojure.core/deref")) ; @ + (= c 94) (read-meta* s pos) ; ^ + (= c 41) (throw (ex-info "Unmatched delimiter: )" {})) + (= c 93) (throw (ex-info "Unmatched delimiter: ]" {})) + (= c 125) (throw (ex-info "Unmatched delimiter: }" {})) + (= c 35) (throw (ex-info "read-form: dispatch (#) not yet ported (inc 5c)" {})) ; # + (number-start? s pos c) (let [r (read-number* s pos)] [:form (nth r 0) (nth r 1)]) + (symbol-start? c) (let [r (read-symbol* s pos)] [:form (nth r 0) (nth r 1)]) + :else (throw (ex-info (str "read-form: unexpected char '" (char c) "' (" c ")") {}))))))) (defn read-one "Read the first form of `s` (skipping leading trivia). Returns the form." [s] - (first (read-form s 0))) + (first (read-next-form s 0))) diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index 693e402..9463e63 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -22,6 +22,7 @@ (use ./evaluator) (use ./core) (import ./phm :as phm) +(import ./pv :as pv) (import ./reader :as rdr) # --------------------------------------------------------------------------- @@ -296,10 +297,27 @@ # (Janet scan-number; Chez string->number). Returns nil on a non-number. (defn h-scan-number [str] (scan-number str)) +# Collection form constructors. The portable reader accumulates items in a jolt +# vector and hands it here; the host builds its native form representation. +(defn- jvec->array [v] + (cond + (pv/pvec? v) (pv/pv->array v) + (indexed? v) (array ;v) + (array))) +(defn h-make-list [items] (jvec->array items)) # list form = Janet array +(defn h-make-vector [items] (tuple/slice (jvec->array items))) # vector form = Janet tuple +(defn h-make-map [kvs] (rdr/reader-map (jvec->array kvs))) # map form (+ kv-order) +# Attach/merge reader metadata onto a symbol FORM (^hint sym): keeps it a bare +# symbol carrying :meta, so type hints are transparent in every position. +(defn h-sym-merge-meta [sym m] + (struct ;(kvs sym) :meta (merge (or (sym :meta) {}) m))) + (def- exports {"form-sym?" h-sym? "form-sym-name" h-sym-name "form-sym-ns" h-sym-ns "form-make-symbol" h-make-symbol "form-make-char" h-make-char "form-char-from-name" h-char-from-name "form-scan-number" h-scan-number + "form-make-list" h-make-list "form-make-vector" h-make-vector + "form-make-map" h-make-map "form-sym-merge-meta" h-sym-merge-meta "ref-put!" h-ref-put! "ref-get" h-ref-get "tagged-table" h-tagged-table diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet index bb26d1f..8fe95b6 100644 --- a/src/jolt/reader.janet +++ b/src/jolt/reader.janet @@ -334,7 +334,9 @@ # common nil-free case stays a struct: fast, and what the downstream map-form # handling (evaluator/analyzer) already expects. Collection keys are left to # eval-time construction (build-map-literal/eval-form), which phm-ifies them. -(defn- reader-map [kvs] +# Public so the jolt.host contract (host_iface form-make-map) can build a map FORM +# with the same source-order kv tracking the portable Clojure reader relies on. +(defn reader-map [kvs] (var has-nil false) (var i 0) (while (< i (length kvs)) (when (nil? (in kvs i)) (set has-nil true) (break)) (++ i)) # Source order rides along out-of-band (jolt-p3c): struct iteration is hash diff --git a/test/chez/reader-parity.janet b/test/chez/reader-parity.janet index 2e5fdf9..f3a5d26 100644 --- a/test/chez/reader-parity.janet +++ b/test/chez/reader-parity.janet @@ -79,5 +79,26 @@ # characters (each i [`\a` `\Z` `\0` `\newline` `\tab` `\space` `\return` `\\` `\(` `\{` `\%` `A` `\o101`] (check i)) +# --- inc 5b: collections + quote/deref/meta ----------------------------------- +# lists +(each i ["(1 2 3)" "(a b c)" "()" "(foo (bar baz) qux)" "(+ 1 (* 2 3))"] (check i)) +(check "(1 ; c\n 2 3)") # comment inside a list +# vectors +(each i ["[1 2 3]" "[]" "[a [b c]]" "[1 [2 [3]]]" "[:a :b :c]"] (check i)) +# maps +(each i ["{:a 1 :b 2}" "{}" "{:a {:b 1}}" "{:x [1 2] :y {:z 3}}" "{1 2 3 4}"] (check i)) +(check "{:a 1 ; c\n :b 2}") # comment inside a map (key/value slots) +# mixed / nested forms (real code shapes) +(each i ["(defn f [x] (+ x 1))" "{:list (1 2) :vec [3 4]}" "(let [a 1 b 2] (+ a b))"] (check i)) +# quote / syntax-quote / unquote / deref +(each i ["'foo" "'(1 2 3)" "''x" "'[a b]" "'{:a 1}"] (check i)) +(each i ["`foo" "`(a b c)" "`[x y]"] (check i)) +(check "`\"meow\"") # syntax-quote of a literal collapses +(each i ["~x" "~@xs" "@x" "@(atom 1)"] (check i)) +(check "`(a ~b ~@c)") +# metadata +(each i ["^:dynamic x" "^String s" "^:private foo" "^{:a 1} v" "^t/Ray r"] (check i)) +(check "(defn ^:private g [x] x)") + (printf "\n%d/%d ok" (- total fails) total) (when (> fails 0) (os/exit 1))