From d161e16df6a1bf816615e55f818476237034932e Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 11 Jun 2026 00:11:04 -0400 Subject: [PATCH] core: java shims for yogthos/config + three conformance fixes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit yogthos/config now loads and runs end to end: config.edn/.lein-env deep merge, env vars keywordized and type-converted, PushbackReader over io/reader, reload-env via alter-var-root. New shims: java.io.PushbackReader (read/unread), Long/parseLong, BigInteger., Boolean/parseBoolean, System/getProperties; clojure.edn/read now drains an actual reader (it used to read one LINE from a raw janet file handle, so multi-line config files and shim readers both broke). Three real bugs shaken out, each with regression specs: - An empty rest arg bound () instead of nil. ((fn [& r] (if r 1 2))) returned 1; the truthy () sent config's (or (.exists f) required) down the wrong branch. Fixed in the interpreter and the compiled-fn emission. Internal apply boundaries (protocol dispatch, core-apply) now accept a nil seq like Clojure's (apply f x nil). - seq/map over a raw janet table (System/getenv, os/environ) yielded nothing, so config's read-system-env came back empty. Raw host tables now seq as kv entries like any map, in core-seq, realize-for-iteration, and coll->cells. The old spec row hid this behind a vacuous (every? pred empty) — replaced with one that asserts non-emptiness. - edn/read single-line limitation, as above. test/integration/config-lib-test.janet runs the real library from ~/src/config (skips when absent). --- src/jolt/backend.janet | 4 +- src/jolt/clojure/edn.clj | 20 +++++-- src/jolt/core.janet | 15 +++++- src/jolt/evaluator.janet | 32 +++++++++-- src/jolt/javatime.janet | 37 +++++++++++++ test/integration/config-lib-test.janet | 75 ++++++++++++++++++++++++++ test/spec/functions-spec.janet | 13 +++++ test/spec/host-interop-spec.janet | 31 +++++++++++ 8 files changed, 215 insertions(+), 12 deletions(-) create mode 100644 test/integration/config-lib-test.janet diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet index d895fd8..5f13505 100644 --- a/src/jolt/backend.janet +++ b/src/jolt/backend.janet @@ -137,7 +137,9 @@ (def nfixed (length (vview (ar :params)))) (def call @[(emit-arity-fn ctx ar)]) (for i 0 nfixed (array/push call ['in jargs i])) - (when (ar :rest) (array/push call ['tuple/slice jargs nfixed])) + # empty rest binds to NIL, not () — (f) with [& r] gives r = nil in Clojure + (when (ar :rest) + (array/push call ['if ['> ['length jargs] nfixed] ['tuple/slice jargs nfixed]])) (tuple/slice call)) (defn- emit-loop [ctx node] diff --git a/src/jolt/clojure/edn.clj b/src/jolt/clojure/edn.clj index 46566e6..e1ace9c 100644 --- a/src/jolt/clojure/edn.clj +++ b/src/jolt/clojure/edn.clj @@ -50,8 +50,20 @@ ([s] (read-edn {} s)) ([opts s] (read-edn opts s))) -(defn read - "Reads the next line from reader and parses one EDN object from it." +(defn- drain-reader + "All remaining content of a reader as a string. Shim readers (StringReader, + PushbackReader, io/reader results) expose char-wise .read; a raw janet file + handle is read whole." [reader] - (let [line ((get (dyn :current-env) (symbol "file/read")) reader :line)] - (when line (read-string line)))) + (if (= :core/file (janet/type reader)) + (janet.file/read reader :all) + (loop [acc (transient []) c (.read reader)] + (if (== -1 c) + (apply str (map char (persistent! acc))) + (recur (conj! acc c) (.read reader)))))) + +(defn read + "Reads one EDN object from reader (a PushbackReader or any jolt reader). + Returns the :eof option value (default nil) at end of input." + ([reader] (read {} reader)) + ([opts reader] (read-edn opts (drain-reader reader)))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index f7fc66b..4663240 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -132,6 +132,9 @@ (buffer? c) (let [a @[]] (each x c (array/push a x)) a) # struct map literal (no :jolt/type marker — not a symbol/char) -> entries (and (struct? c) (nil? (get c :jolt/type))) (map (fn [k] (tuple k (get c k))) (keys c)) + # raw host table (System/getenv, os/environ) — also a map: entries + (and (table? c) (nil? (get c :jolt/type)) (nil? (get c :jolt/deftype))) + (map (fn [k] (tuple k (get c k))) (keys c)) (lazy-seq? c) (do (var items @[]) @@ -619,7 +622,8 @@ (jolt-call f) (let [fixed (array/slice args 0 (- n 1)) t (in args (- n 1)) - tail (cond (set? t) (phs-seq t) (phm? t) (tuple ;(phm-entries t)) + tail (cond (nil? t) [] # (apply f x nil) == (f x), as in Clojure + (set? t) (phs-seq t) (phm? t) (tuple ;(phm-entries t)) (realize-for-iteration t))] (jolt-call f ;fixed ;tail))))) @@ -758,6 +762,10 @@ (struct? coll) (if (= 0 (length coll)) nil (tuple ;(map (fn [k] (tuple k (get coll k))) (keys coll)))) (array? coll) (tuple ;coll) (and (table? coll) (get coll :jolt/deftype)) coll + # raw host table (System/getenv result) seqs like a map: kv entries + (and (table? coll) (nil? (get coll :jolt/type))) + (if (= 0 (length coll)) nil + (tuple ;(map (fn [k] (tuple k (get coll k))) (keys coll)))) # scalars/functions aren't seqable (error (string "seq not supported on " (type coll))))) @@ -978,7 +986,10 @@ # Other concrete seqables (set/map/sorted coll/string/buffer): coerce # to a tuple seq via core-seq, then recurse. (lazy/indexed above.) (if (or (set? c) (phm? c) (buffer? c) (string? c) (core-sorted? c) - (and (struct? c) (nil? (get c :jolt/type)))) + (and (struct? c) (nil? (get c :jolt/type))) + # raw host table (System/getenv) — a map: kv entries + (and (table? c) (nil? (get c :jolt/type)) + (nil? (get c :jolt/deftype)))) (coll->cells (core-seq c)) nil))))))))) diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 5c8f002..8beacac 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -453,13 +453,27 @@ "user.home" (os/getenv "HOME") "java.io.tmpdir" (or (os/getenv "TMPDIR") "/tmp") dflt)) - "getenv" (fn [&opt k] (if k (os/getenv k) (os/environ)))}) + "getenv" (fn [&opt k] (if k (os/getenv k) (os/environ))) + # the property subset getProperty serves, as an iterable map + "getProperties" (fn [] + {"os.name" (case (os/which) + :windows "Windows" :macos "Mac OS X" "Linux") + "line.separator" "\n" + "file.separator" "/" + "user.dir" (os/cwd) + "user.home" (or (os/getenv "HOME") "") + "java.io.tmpdir" (or (os/getenv "TMPDIR") "/tmp")})}) # Long statics: sentinels portable code compares against. jolt numbers are # doubles, so these are the f64 approximations. (def- long-statics {"MAX_VALUE" 9223372036854775807 - "MIN_VALUE" -9223372036854775808}) + "MIN_VALUE" -9223372036854775808 + "parseLong" (fn [s &opt radix] + (def n (scan-number (string/trim (string s)) (or radix 10))) + (if (and n (= n (math/floor n))) + n + (error (string "NumberFormatException: For input string: \"" s "\""))))}) # Pluggable host-class shims (java.time etc. register here at module load): # class-statics: "ClassName" -> {"member" value-or-fn} (Foo/bar resolution) @@ -667,6 +681,12 @@ (do (array/push fixed a) (+= i 1))))) {:fixed (tuple/slice (tuple ;fixed)) :rest rest-pat}) +(defn- rest-args-val + "What a rest param binds to: nil when no args remain (Clojure semantics — + (fn [& r]) called with nothing gives r = nil, never an empty seq)." + [args i] + (when (> (length args) i) (tuple/slice args i))) + (defn- plain-sym? [p] (and (struct? p) (= :symbol (p :jolt/type)))) (defn- require-symbol-params @@ -850,6 +870,8 @@ # longer a special-form handler for them. proto/method/type names arrive as # STRINGS (the defprotocol/extend-type macros pass (name sym), not the symbol). (defn protocol-dispatch-impl [ctx proto-name method-name obj rest-args] + # an empty jolt rest arg is NIL (Clojure semantics); janet apply needs a tuple + (default rest-args []) (def type-tag (if (and (table? obj) (get obj :jolt/deftype)) (get obj :jolt/deftype) (if (get obj :jolt/protocol-methods) (get obj :jolt/deftype)))) @@ -1545,7 +1567,7 @@ (destructure-bind ctx new-bindings pat (macro-args i)) (++ i)) (when rest-pat - (destructure-bind ctx new-bindings rest-pat (tuple/slice macro-args i))) + (destructure-bind ctx new-bindings rest-pat (rest-args-val macro-args i))) # Use defining namespace for symbol resolution (def saved-ns (ctx-current-ns ctx)) (ctx-set-current-ns ctx defining-ns) @@ -1646,7 +1668,7 @@ (destructure-bind ctx fn-bindings pat (fn-args i)) (++ i)) (when rest-pat - (destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i))) + (destructure-bind ctx fn-bindings rest-pat (rest-args-val fn-args i))) (run-clause fn-bindings))] (if rest-pat (do @@ -1705,7 +1727,7 @@ (destructure-bind ctx fn-bindings pat (fn-args i)) (++ i)) (when rest-pat - (destructure-bind ctx fn-bindings rest-pat (tuple/slice fn-args i))) + (destructure-bind ctx fn-bindings rest-pat (rest-args-val fn-args i))) (run-body fn-bindings))) # recur re-enters here: for a variadic fn it takes n-fixed + 1 # args, the LAST bound DIRECTLY as the rest seq (Clojure) — going diff --git a/src/jolt/javatime.janet b/src/jolt/javatime.janet index 84f2ca5..1c22c5e 100644 --- a/src/jolt/javatime.janet +++ b/src/jolt/javatime.janet @@ -177,7 +177,34 @@ (and (struct? x) (= :jolt/char (get x :jolt/type))) (string/from-bytes (x :ch)) (string x))) +# Read one unit from any reader-ish value: our shims dispatch through their +# tagged "read"; a janet core/file reads one byte. -1 at EOF. +(defn- read-unit [r] + (cond + (and (or (table? r) (struct? r)) (get r :jolt/type)) + (((get tagged-methods (r :jolt/type)) "read") r) + (= :core/file (type r)) + (let [b (file/read r 1)] (if (or (nil? b) (= 0 (length b))) -1 (b 0))) + (error (string "not a reader: " (type r))))) + +(defn- pushback-reader [rdr] + # java.io.PushbackReader: read delegates to the wrapped reader unless + # something was unread; unread takes a char (or char code) and pushes it back + (def self @{:jolt/type :jolt/pushback-reader :rdr rdr :pushed @[] + :close (fn [] nil)}) + self) + (defn install-io! [] + (register-tagged-methods! :jolt/pushback-reader + @{"read" (fn [self] + (if (> (length (self :pushed)) 0) + (array/pop (self :pushed)) + (read-unit (self :rdr)))) + "unread" (fn [self ch] + (array/push (self :pushed) + (if (number? ch) ch (get ch :ch))) + nil) + "close" (fn [self] nil)}) (register-tagged-methods! :jolt/jio-string-reader @{"read" (fn [self] (if (>= (self :pos) (length (self :s))) @@ -202,6 +229,9 @@ "charAt" (fn [self i] {:jolt/type :jolt/char :ch ((self :buf) i)})}) (each nm ["File" "java.io.File"] (register-class-statics! nm @{"separator" "/" "separatorChar" {:jolt/type :jolt/char :ch 47}})) + (register-class-statics! "Boolean" + @{"parseBoolean" (fn [s] (= "true" (string/ascii-lower (string s)))) + "TRUE" true "FALSE" false}) (register-class-statics! "Class" @{"forName" (fn [nm] @{:jolt/type :jolt/class :name nm})}) (each nm ["StringReader" "java.io.StringReader"] @@ -230,6 +260,13 @@ (string/find "/" (string/slice s 0 colon))) (error (string "MalformedURLException: no protocol: " s)) @{:jolt/type :jolt/url :spec s})))) + (each nm ["PushbackReader" "java.io.PushbackReader"] + (register-class-ctor! nm (fn [rdr &opt size] (pushback-reader rdr)))) + (each nm ["BigInteger" "java.math.BigInteger"] + (register-class-ctor! nm + (fn [v] + (or (scan-number (string/trim (string v))) + (error (string "NumberFormatException: For input string: \"" v "\"")))))) (each nm ["Locale" "java.util.Locale"] (register-class-ctor! nm (fn [id &opt _country] @{:jolt/type :jolt/locale :id (string id)})))) diff --git a/test/integration/config-lib-test.janet b/test/integration/config-lib-test.janet new file mode 100644 index 0000000..30e0bba --- /dev/null +++ b/test/integration/config-lib-test.janet @@ -0,0 +1,75 @@ +# yogthos/config acceptance: load the real library from ~/src/config and run +# its whole surface — PushbackReader over io/reader, edn/read from a reader, +# Long/parseLong + BigInteger. + Boolean/parseBoolean, System/getenv + +# System/getProperties as iterable maps, str->value, keywordize, deep-merge, +# and the defonce env built at load. SKIPS cleanly when the checkout is +# absent (CI); the shim surface itself is covered by host-interop-spec. + +(import ../../src/jolt/api :as api) +(use ../../src/jolt/reader) + +(def config-src (string (os/getenv "HOME") "/src/config/src")) + +(if (nil? (os/stat (string config-src "/config/core.clj"))) + (print "config-lib-test: ~/src/config not present, skipping") + (do + (reader-features-set! ["jolt" "clj" "default"]) + + # run from a temp project dir so config.edn/.lein-env are controlled + (def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-config-lib-" (os/time))) + (defn rmrf [p] + (when (os/stat p) + (if (= :directory (os/stat p :mode)) + (do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p)) + (os/rm p)))) + (rmrf base) + (os/mkdir base) + (spit (string base "/config.edn") + "{:db {:host \"localhost\"\n :port 5432}\n :app-name \"demo\"}\n") + (spit (string base "/.lein-env") "{:db {:port 9999}}") + (os/cd base) + (os/setenv "CONFIG_TEST_NUM" "42") + (os/setenv "CONFIG_TEST_FLAG" "true") + (os/setenv "CONFIG_TEST_EDN" "{:x 1}") + + (def ctx (api/init {:paths [config-src]})) + + (print "loading config.core (defonce env runs load-env at require)...") + (api/eval-string ctx "(require (quote [config.core :as cfg]))") + (print " ok") + + (var fails 0) + (defn check [label expr expected] + (def r (protect (api/eval-string ctx expr))) + (def got (if (r 0) (r 1) (string "ERR " (r 1)))) + (if (deep= got expected) (print " ok " label) + (do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got)))) + + (print "config.edn + .lein-env deep merge...") + (check "nested value from config.edn" "(get-in cfg/env [:db :host])" "localhost") + (check ".lein-env overrides nested" "(get-in cfg/env [:db :port])" 9999) + (check "top-level value" "(:app-name cfg/env)" "demo") + (print "env vars keywordized + converted...") + (check "numeric env var is a number" "(:config-test-num cfg/env)" 42) + (check "boolean env var" "(:config-test-flag cfg/env)" true) + (check "edn env var parses" "(= {:x 1} (:config-test-edn cfg/env))" true) + (print "library fns directly...") + (check "str->value number" "(cfg/str->value \"17\")" 17) + (check "str->value bool" "(cfg/str->value \"false\")" false) + (check "str->value word" "(cfg/str->value \"hello\")" "hello") + (check "str->value edn vec" "(= [1 2] (cfg/str->value \"[1 2]\"))" true) + (check "str->value symbol stays str" "(cfg/str->value \"foo/bar\")" "foo/bar") + (check "keywordize" "(cfg/keywordize \"FOO_BAR__BAZ_QMARK_\")" :foo-bar/baz?) + (check "read-config-file" "(get-in (cfg/read-config-file \"config.edn\") [:db :port])" 5432) + (check "deep-merge-with" + "(= {:a {:b 3}} (cfg/deep-merge-with + {:a {:b 1}} {:a {:b 2}}))" true) + (print "reload-env...") + (check "reload-env returns merged map" + "(do (cfg/reload-env) (get-in cfg/env [:db :host]))" "localhost") + + (os/cd "/") + (rmrf base) + + (if (> fails 0) + (error (string "config-lib-test: " fails " failing check(s)")) + (print "\nconfig-lib-test: all passed")))) diff --git a/test/spec/functions-spec.janet b/test/spec/functions-spec.janet index 9bb3d12..8b53c0d 100644 --- a/test/spec/functions-spec.janet +++ b/test/spec/functions-spec.janet @@ -181,3 +181,16 @@ "((fn f [acc & xs] (if (seq xs) (recur acc (rest xs)) :empty)) 0 1)"] ["fixed-arity recur untouched" "10" "((fn f [n acc] (if (pos? n) (recur (dec n) (+ acc 2)) acc)) 5 0)"]) + +# An EMPTY rest arg binds nil, never () — Clojure semantics. (f) with [& r] +# giving a truthy () sent yogthos/config's (or (.exists f) required) down the +# wrong branch and broke its load. +(defspec "functions / empty rest arg is nil" + ["no args" ":nil" "((fn [& r] (if r :truthy :nil)))"] + ["after fixed" ":nil" "((fn [a & r] (if r :truthy :nil)) 1)"] + ["via apply" ":nil" "(apply (fn [& r] (if r :truthy :nil)) [])"] + ["defn no args" ":nil" "(do (defn er-f [& r] (if r :truthy :nil)) (er-f))"] + ["non-empty unchanged" "'(1 2)" "((fn [& r] r) 1 2)"] + ["one extra" "'(2)" "((fn [a & r] r) 1 2)"] + ["rest destructure with no args" ":nil" + "((fn [& [a]] (if a :truthy :nil)))"]) diff --git a/test/spec/host-interop-spec.janet b/test/spec/host-interop-spec.janet index ad1e0ff..5397ef7 100644 --- a/test/spec/host-interop-spec.janet +++ b/test/spec/host-interop-spec.janet @@ -109,3 +109,34 @@ "(with-open [r (StringReader. \"a\")] (.read r))"] ["vector :import shares deftype ctor" "\"hi!\"" "(do (ns spec.nodea) (defprotocol SpecP (spec-pm [this])) (deftype SpecTN [t] SpecP (spec-pm [this] (str t \"!\"))) (ns spec.nodeb (:import [spec.nodea SpecTN])) (.spec-pm (SpecTN. \"hi\")))"]) + +# Shims for yogthos/config: PushbackReader, numeric/boolean parse statics, +# System/getenv + getProperties as iterable maps, edn/read from a reader. +(defspec "interop / PushbackReader & parse statics" + ["PushbackReader read" "[97 98]" + "(let [r (java.io.PushbackReader. (java.io.StringReader. \"ab\"))] [(.read r) (.read r)])"] + ["unread pushes back" "[97 97 98]" + "(let [r (PushbackReader. (StringReader. \"ab\")) a (.read r)] (.unread r a) [a (.read r) (.read r)])"] + ["unread accepts a char" "[120 97]" + "(let [r (PushbackReader. (StringReader. \"a\"))] (.unread r \\x) [(.read r) (.read r)])"] + ["edn/read from reader" "5432" + "(do (require (quote clojure.edn)) (clojure.edn/read (java.io.PushbackReader. (java.io.StringReader. \"{:db {:port 5432}}\\nrest\"))) (get-in (clojure.edn/read-string \"{:db {:port 5432}}\") [:db :port]))"] + ["edn/read multi-line" "true" + "(do (require (quote clojure.edn)) (= {:a 1 :b 2} (clojure.edn/read (PushbackReader. (StringReader. \"{:a 1\\n :b 2}\")))))"] + ["Long/parseLong" "42" "(Long/parseLong \"42\")"] + ["parseLong rejects non-numeric" :throws "(Long/parseLong \"4x\")"] + ["BigInteger." "123" "(BigInteger. \"123\")"] + ["Boolean/parseBoolean" "[true false false]" + "[(Boolean/parseBoolean \"true\") (Boolean/parseBoolean \"false\") (Boolean/parseBoolean \"yes\")]"] + ["System/getenv is a map" "true" + "(string? (get (System/getenv) \"HOME\"))"] + # NOT every? alone — it held vacuously while seq over a raw host table + # yielded nothing, hiding that read-system-env came back empty + ["getenv entries destructure (non-empty)" "true" + "(let [es (map (fn [[k v]] [k v]) (System/getenv))] (and (pos? (count es)) (every? vector? es)))"] + ["seq over a raw host table" "true" + "(pos? (count (seq (System/getenv))))"] + ["into {} from host table" "true" + "(string? (get (into {} (map (fn [[k v]] [k v]) (System/getenv))) \"HOME\"))"] + ["System/getProperties" "true" + "(string? (get (System/getProperties) \"os.name\"))"])