From 0d841ef83da1522a59a3c1de257a3fd292b1d1cc Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 4 Jun 2026 15:40:59 -0400 Subject: [PATCH] =?UTF-8?q?feat:=20proper=20char=20type=20({:jolt/type=20:?= =?UTF-8?q?jolt/char=20:ch=20N})=20=E2=80=94=20reader=20literals,=20char?= =?UTF-8?q?=3F/char/int/str,=20=3D,=20seq/first/rest/nth=20of=20strings=20?= =?UTF-8?q?yield=20chars,=20char=20printing;=20fix=20REPL=20multi-line=20i?= =?UTF-8?q?nput=20accumulation?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/jolt/core.janet | 39 ++++++++++++++++++++++++++++++--------- src/jolt/evaluator.janet | 4 +++- src/jolt/main.janet | 36 ++++++++++++++++++++++++++++-------- src/jolt/reader.janet | 6 ++++-- src/jolt/types.janet | 18 ++++++++++++++++++ test/conformance.janet | 17 +++++++++++++++++ test/reader-test.janet | 8 ++++---- 7 files changed, 104 insertions(+), 24 deletions(-) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 9a19450..8f78a8b 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -9,6 +9,10 @@ # Predicates # ============================================================ +(defn core-char? [x] (and (struct? x) (= :jolt/char (x :jolt/type)))) +(defn char-code [c] (c :ch)) +(defn char->string [c] (string/from-bytes (c :ch))) + (defn core-nil? [x] (nil? x)) (defn core-not [x] (if x false true)) (defn core-some? [x] (not (nil? x))) @@ -302,15 +306,16 @@ (core-sorted-set? coll) (let [i (coll :items)] (if (empty? i) nil (in i 0))) (lazy-seq? coll) (ls-first coll) (or (nil? coll) (= 0 (length coll))) nil + (string? coll) (make-char (in coll 0)) (in coll 0))) (defn core-rest [coll] - (if (lazy-seq? coll) (ls-rest coll) - (if (or (nil? coll) (= 0 (length coll))) - @[] - (if (tuple? coll) - (tuple/slice coll 1) - (array/slice coll 1))))) + (cond + (lazy-seq? coll) (ls-rest coll) + (or (nil? coll) (= 0 (length coll))) @[] + (string? coll) (tuple ;(map make-char (string/bytes (string/slice coll 1)))) + (tuple? coll) (tuple/slice coll 1) + (array/slice coll 1))) (defn core-next [coll] (let [r (core-rest coll)] @@ -329,7 +334,7 @@ (set? coll) (phs-seq coll) (phm? coll) (tuple ;(phm-entries coll)) (tuple? coll) (tuple/slice coll) - (string? coll) (map |(string/from-bytes $) (string/bytes coll)) + (string? coll) (if (= 0 (length coll)) nil (tuple ;(map make-char (string/bytes coll)))) (struct? coll) (tuple ;(keys coll)) coll)) @@ -662,7 +667,7 @@ (do (var c (if (lazy-seq? coll) (realize-ls coll) coll)) (if (and (>= idx 0) (< idx (length c))) - (in c idx) + (if (string? c) (make-char (in c idx)) (in c idx)) (if (nil? default) (error (string "Index " idx " out of bounds, length: " (length c))) default))))) @@ -1022,6 +1027,12 @@ (string? v) (do (buffer/push-string buf "\"") (buffer/push-string buf v) (buffer/push-string buf "\"")) (buffer? v) (do (buffer/push-string buf "\"") (buffer/push-string buf (string v)) (buffer/push-string buf "\"")) (keyword? v) (do (buffer/push-string buf ":") (buffer/push-string buf (string v))) + (core-char? v) (do (buffer/push-string buf "\\") + (buffer/push-string buf + (case (v :ch) + 10 "newline" 32 "space" 9 "tab" 13 "return" + 12 "formfeed" 8 "backspace" 0 "nul" + (char->string v)))) (regex? v) (do (buffer/push-string buf "#\"") (buffer/push-string buf (v :source)) (buffer/push-string buf "\"")) (number? v) (buffer/push-string buf (string v)) (and (struct? v) (= :symbol (v :jolt/type))) @@ -1046,6 +1057,7 @@ (nil? v) "" (string? v) v (buffer? v) (string v) + (core-char? v) (char->string v) (keyword? v) (string ":" (string v)) (and (struct? v) (= :symbol (v :jolt/type))) (if (v :ns) (string (v :ns) "/" (v :name)) (v :name)) @@ -1156,7 +1168,14 @@ # Integer coercion # ============================================================ -(def core-int (fn [x] (math/trunc x))) +(def core-int (fn [x] (if (core-char? x) (x :ch) (math/trunc x)))) +(defn core-char [x] + "(char code-or-char) -> a character value." + (cond + (core-char? x) x + (number? x) (make-char (math/trunc x)) + (string? x) (make-char (in x 0)) + (error "char expects a number or character"))) (def core-unchecked-inc (fn [x] (+ x 1))) (def core-unchecked-dec (fn [x] (- x 1))) (def core-unchecked-add (fn [& xs] (+ ;xs))) @@ -2487,6 +2506,8 @@ "unsigned-bit-shift-right" core-unsigned-bit-shift-right # Integer coercion / unchecked math "int" core-int + "char" core-char + "char?" core-char? "unchecked-inc" core-unchecked-inc "unchecked-dec" core-unchecked-dec "unchecked-add" core-unchecked-add diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index d7e448f..ba8f086 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -1139,6 +1139,8 @@ (struct? form) (if (= :symbol (form :jolt/type)) (resolve-sym ctx bindings form) + (if (= :jolt/char (form :jolt/type)) + form (if (= :jolt/set (form :jolt/type)) (apply make-phs (form :value)) (if (= :jolt/tagged (form :jolt/type)) @@ -1152,7 +1154,7 @@ (error (string "No reader function for tag " tag)))) (if (get form :jolt/type) (error (string "Unexpected tagged form: " (form :jolt/type))) - form)))) + form))))) (array? form) (if (= 0 (length form)) @[] diff --git a/src/jolt/main.janet b/src/jolt/main.janet index f38eeeb..5cad7b0 100644 --- a/src/jolt/main.janet +++ b/src/jolt/main.janet @@ -4,6 +4,7 @@ (use ./api) (use ./types) (use ./phm) +(use ./reader) (def ctx (init)) (ctx-set-current-ns ctx "user") @@ -140,6 +141,12 @@ (number? v) (push-str buf (string v)) (string? v) (push-str buf v) (keyword? v) (do (push-str buf ":") (push-str buf (string v))) + (and (struct? v) (= :jolt/char (get v :jolt/type))) + (do (push-str buf "\\") + (push-str buf (case (v :ch) + 10 "newline" 32 "space" 9 "tab" 13 "return" + 12 "formfeed" 8 "backspace" 0 "nul" + (string/from-bytes (v :ch))))) (and (struct? v) (= :symbol (get v :jolt/type))) (let [ns (get v :ns) name (get v :name)] (if ns @@ -161,12 +168,25 @@ (print "Type (exit) to quit.\n") (var running true) + (var pending "") # accumulates a form split across multiple input lines (while running - (let [line (read-line (string (ctx-current-ns ctx) "=> "))] - (if (nil? line) (set running false) - (if (= line "(exit)") (set running false) - (if (not (= "" line)) - (try - (print-value (eval-string ctx line)) - ([err] - (eprint "Error: " err))))))))) + (let [prompt (if (= pending "") (string (ctx-current-ns ctx) "=> ") " #_=> ") + line (read-line prompt)] + (cond + (nil? line) (set running false) + (let [input (if (= pending "") line (string pending "\n" line)) + trimmed (string/trim input)] + (cond + (= trimmed "(exit)") (set running false) + (= trimmed "") (set pending "") + # Try to parse the accumulated input; if it's an incomplete form + # (unterminated list/vector/map/string), keep reading more lines. + (let [parsed (protect (parse-string input))] + (if (and (= (parsed 0) false) + (string/find "nterminated" (string (parsed 1)))) + (set pending input) + (do + (set pending "") + (try + (print-value (eval-string ctx input)) + ([err] (eprint "Error: " err)))))))))))) diff --git a/src/jolt/reader.janet b/src/jolt/reader.janet index 3d96457..de0e8ff 100644 --- a/src/jolt/reader.janet +++ b/src/jolt/reader.janet @@ -8,6 +8,8 @@ # Maps {:a 1} → Janet struct {:a 1} # Sets #{1 2} → tagged struct {:jolt/type :jolt/set :value [1 2]} +(use ./types) + # Forward declaration for mutual recursion (var read-form nil) @@ -274,10 +276,10 @@ pos)) (defn read-char [s pos] - # pos is at backslash + # pos is at backslash; produce a char value directly (self-evaluating) (let [end (read-char-name-end s (+ pos 1)) char-name (string/slice s (+ pos 1) end)] - [{:jolt/type :char :name char-name} end])) + [(char-from-name char-name) end])) (defn read-anon-fn [s pos] # pos is at #, next char is ( diff --git a/src/jolt/types.janet b/src/jolt/types.janet index 40f4d2d..459d0de 100644 --- a/src/jolt/types.janet +++ b/src/jolt/types.janet @@ -9,6 +9,24 @@ # Symbols are represented as {:jolt/type :symbol :ns :name } # as produced by the reader. +# Characters are {:jolt/type :jolt/char :ch }, distinct from strings. +(defn make-char [code] {:jolt/type :jolt/char :ch code}) + +(def- char-named @{"newline" 10 "space" 32 "tab" 9 "return" 13 + "formfeed" 12 "backspace" 8 "newpage" 12 "nul" 0}) + +(defn char-from-name + "Resolve a reader char-literal name (\\a, \\newline, \\uNNNN, \\oNNN) to a char value." + [name] + (cond + (= 1 (length name)) (make-char (in name 0)) + (get char-named name) (make-char (get char-named name)) + (and (> (length name) 1) (= (in name 0) (get "u" 0))) + (make-char (scan-number (string "16r" (string/slice name 1)))) + (and (> (length name) 1) (= (in name 0) (get "o" 0))) + (make-char (scan-number (string "8r" (string/slice name 1)))) + (error (string "Unsupported character: \\" name)))) + # ============================================================ # Symbol helpers # ============================================================ diff --git a/test/conformance.janet b/test/conformance.janet index 2b79417..b264f83 100644 --- a/test/conformance.janet +++ b/test/conformance.janet @@ -226,6 +226,23 @@ ### ==== printing ==== ["pr-str vec" "\"[1 2 3]\"" "(pr-str [1 2 3])"] ["prn-str" "\"1\\n\"" "(prn-str 1)"] + + ### ==== characters ==== + ["char?" "true" "(char? \\a)"] + ["char not string" "false" "(= \\a \"a\")"] + ["char eq" "true" "(= \\a \\a)"] + ["int of char" "97" "(int \\a)"] + ["char of int" "true" "(= \\A (char 65))"] + ["str of chars" "\"abc\"" "(str \\a \\b \\c)"] + ["seq of string" "(quote (\\a \\b))" "(seq \"ab\")"] + ["first of string" "\\h" "(first \"hello\")"] + ["nth of string" "\\e" "(nth \"hello\" 1)"] + ["char newline" "10" "(int \\newline)"] + ["char space" "32" "(int \\space)"] + ["char unicode" "65" "(int \\u0041)"] + ["pr-str char" "\"\\\\a\"" "(pr-str \\a)"] + ["chars in vec" "[\\a \\b]" "[\\a \\b]"] + ["apply str chars" "\"hi\"" "(apply str [\\h \\i])"] ]) (var pass 0) diff --git a/test/reader-test.janet b/test/reader-test.janet index 596f02a..55959a6 100644 --- a/test/reader-test.janet +++ b/test/reader-test.janet @@ -128,13 +128,13 @@ (assert (deep= @[(sym "+") 1 3] (parse-string "(+ 1 #?(:clj 3 :cljs 4))")) "#? inside list picks :clj") -# Characters +# Characters — the reader now produces char values {:jolt/type :jolt/char :ch N} (let [form (parse-string "\\newline")] (assert (struct? form) "char is struct") - (assert (= :char (form :jolt/type)) "char type") - (assert (= "newline" (form :name)) "char name")) + (assert (= :jolt/char (form :jolt/type)) "char type") + (assert (= 10 (form :ch)) "newline codepoint")) (let [form (parse-string "\\a")] - (assert (= "a" (form :name)) "simple char name")) + (assert (= 97 (form :ch)) "simple char codepoint")) (print "All reader tests passed!")