diff --git a/jolt-core/clojure/core/00-syntax.clj b/jolt-core/clojure/core/00-syntax.clj index 4a7af14..ed85a2d 100644 --- a/jolt-core/clojure/core/00-syntax.clj +++ b/jolt-core/clojure/core/00-syntax.clj @@ -445,3 +445,13 @@ (defmacro lazy-cat [& colls] `(concat ~@(map (fn [c] `(lazy-seq ~c)) colls))) + +;; not= here (not 20-coll): the kernel tier uses it, and the kernel +;; bootstrap-compiles right after this file loads. Canonical Clojure arities. +(defn not= + ([x] false) + ([x y] (not (= x y))) + ([x y & more] (not (apply = x y more)))) + +;; unreduced here: the seq tier's reduce machinery unwraps with it. +(defn unreduced [x] (if (reduced? x) (deref x) x)) diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index 293f937..a0717ce 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -6,6 +6,23 @@ ;; Same migration rule as the seq tier (see 10-seq.clj): not in core-renames, no ;; internal Janet callers, not used by the self-hosted compiler. +;; Tiny leaves first — fns below in this tier (and 25-sorted) use them. +(defn identity [x] x) + +(defn constantly [x] (fn [& args] x)) + +;; neg? throws on non-numbers via <, as Clojure's Numbers.isNeg does. +(defn neg? [x] (< x 0)) + +;; even?/odd? accept any integral number (jolt has one number type, so 2.0 +;; counts) and throw otherwise — Clojure's IllegalArgumentException wording. +(defn even? [n] + (if (integer? n) + (zero? (rem n 2)) + (throw (str "Argument must be an integer: " n)))) + +(defn odd? [n] (not (even? n))) + ;; Base is (hash-map), not the {} literal: a literal map is a struct that doesn't ;; canonicalize collection keys across representations (a {:a 1} literal vs ;; (hash-map :a 1) key), whereas a PHM does — so counting/grouping by collection @@ -373,6 +390,17 @@ ([keyfn comp coll] (sort (fn [x y] (comp (keyfn x) (keyfn y))) coll))) +;; parse-uuid: nil unless s is a canonical 8-4-4-4-12 hex UUID string; throws +;; on a non-string (Clojure 1.11). __make-uuid is the host constructor for the +;; tagged value (overlay source can't write :jolt/type map literals — the +;; reader treats them as tagged forms). +(defn parse-uuid [s] + (if (string? s) + (when (re-matches + #"[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}" s) + (__make-uuid s)) + (throw (str "parse-uuid requires a string, got: " s)))) + ;; Version-4 UUID (RFC 4122): zero-padded hex groups 8-4-4-4-12, version ;; nibble 4, variant 8-b — built over rand-int and validated by parse-uuid. (defn random-uuid [] @@ -882,3 +910,65 @@ ;; num: Clojure coerces to java.lang.Number; jolt just checks. (defn num [x] (if (number? x) x (throw (str "num requires a number, got: " x)))) + +;; == numeric equality: 1-arity is trivially true without inspecting the value +;; (Clojure's shape); 2+ args must be numbers, as Numbers.equiv throws. +(defn == + ([x] true) + ([x y] + (if (and (number? x) (number? y)) + (= x y) + (throw (str "Cannot cast to number: " (if (number? x) y x))))) + ([x y & more] + (if (== x y) + (apply == y more) + false))) + +;; ensure-reduced / halt-when: canonical Clojure. halt-when smuggles the halt +;; value through reduce in a ::halt-keyed map and unwraps it in the completion +;; arity, so the halt REPLACES the whole reduction result. +(defn ensure-reduced [x] (if (reduced? x) x (reduced x))) + +(defn halt-when + ([pred] (halt-when pred nil)) + ([pred retf] + (fn [rf] + (fn + ([] (rf)) + ([result] + (if (and (map? result) (contains? result ::halt)) + (get result ::halt) + (rf result))) + ([result input] + (if (pred input) + (reduced (hash-map ::halt (if retf (retf (rf result) input) input))) + (rf result input))))))) + +;; parse-boolean: exact "true"/"false" only; nil on anything else, throw on a +;; non-string (Clojure 1.11). +(defn parse-boolean [s] + (if (string? s) + (cond (= s "true") true (= s "false") false :else nil) + (throw (str "parse-boolean requires a string, got: " s)))) + +(defn newline [] (print "\n") nil) + +;; seque: jolt is single-threaded eager here — the queue is a no-op and the +;; coll passes through. +(defn seque + ([s] s) + ([n-or-q s] s)) + +(defn array-seq [arr & _] (seq arr)) + +(defn to-array-2d [coll] (to-array (map to-array coll))) + +;; Masking integer coercions (not aliases): byte/short wrap to their width. +;; unchecked-char keeps jolt's historical NUMBER result (Clojure returns a +;; char) — the char wrapper is a different value type here. int handles chars, +;; so (unchecked-byte \a) works as on the JVM. +(defn unchecked-byte [x] (bit-and (int x) 0xff)) +(defn unchecked-short [x] (bit-and (int x) 0xffff)) +(defn unchecked-char [x] (bit-and (int x) 0xffff)) +(defn unchecked-float [x] (double x)) +(defn unchecked-double [x] (double x)) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 8747a09..2fd1be6 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -407,3 +407,10 @@ ;; loads — so the macro must be registered BEFORE those tiers, else (lazy-seq …) ;; compiles as a call to the macro-as-function and leaks its expansion at runtime ;; (jolt-r81). They only need seed fns (make-lazy-seq/coll->cells/concat). + +;; memfn: a fn wrapping a method call, (memfn toUpperCase) => #(.toUpperCase %). +;; The method symbol is rewritten to jolt's .method call sugar; extra arg names +;; become fn params, as in Clojure. +(defmacro memfn [method-name & args] + `(fn [target# ~@args] + (~(symbol (str "." (name method-name))) target# ~@args))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 0e4ccbf..f4cb37f 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -231,9 +231,7 @@ (defn core-zero? [x] (= (need-num x "zero?") 0)) (defn core-pos? [x] (> (need-num x "pos?") 0)) -(defn core-neg? [x] (< (need-num x "neg?") 0)) -(defn core-even? [n] (= 0 (% (need-int n "even?") 2))) -(defn core-odd? [n] (not= 0 (% (need-int n "odd?") 2))) +# neg? / even? / odd? live in the Clojure collection tier (core/20-coll.clj). # Finite integral number: NaN and the infinities are NOT integers (floor of # inf is inf, so the naive floor check wrongly accepted them). @@ -401,7 +399,7 @@ (++ i)) ok))) -(defn core-not= [& args] (not (apply core-= args))) +# not= lives in the syntax tier (core/00-syntax.clj) — the kernel uses it. # Comparisons are variadic: (< a b c) means a < b < c. (defn- chain-cmp [op opname xs] @@ -818,7 +816,7 @@ (defn core-reduced [x] @{:jolt/type :jolt/reduced :val x}) (defn core-reduced? [x] (and (table? x) (= :jolt/reduced (x :jolt/type)))) -(defn core-unreduced [x] (if (core-reduced? x) (x :val) x)) +# unreduced lives in the syntax tier (core/00-syntax.clj) over reduced?/deref. (defn- ensure-reduced [x] (if (core-reduced? x) x (core-reduced x))) (defn td-map [f] @@ -1402,9 +1400,7 @@ # Higher-order functions # ============================================================ -(def core-identity (fn [x] x)) - -(def core-constantly (fn [x] (fn [& _] x))) +# identity / constantly live in the Clojure collection tier (core/20-coll.clj). # complement now lives in the Clojure collection tier (core/20-coll.clj). @@ -1686,7 +1682,7 @@ (prin "\n") nil) -(defn core-newline [] (prin "\n") nil) +# newline lives in the Clojure collection tier (core/20-coll.clj). # Clojure 1.11 string->scalar parsers: nil on malformed input, throw on a # non-string. Validation is strict (scan-number alone accepts 0x10 etc.). @@ -1717,9 +1713,7 @@ (def pat (peg/compile ~(sequence (opt (set "+-")) (choice (sequence (some :d) (opt (sequence "." (any :d)))) (sequence "." (some :d))) (opt (sequence (set "eE") (opt (set "+-")) (some :d))) -1))) (if (peg/match pat str*) (scan-number str*) nil)))) -(defn core-parse-boolean [s] - (def str* (parse-arg-str s "parse-boolean")) - (case str* "true" true "false" false nil)) +# parse-boolean lives in the Clojure collection tier (core/20-coll.clj). # Host time source for the `time` macro (monotonic, milliseconds). (defn core-current-time-ms [] (* 1000 (os/clock :monotonic))) @@ -1933,8 +1927,7 @@ (defn core-to-array [coll] (def arr @[]) (each x (realize-for-iteration coll) (array/push arr x)) arr) -(defn core-to-array-2d [coll] - (def arr @[]) (each row (realize-for-iteration coll) (array/push arr (core-to-array row))) arr) +# to-array-2d lives in the Clojure collection tier (core/20-coll.clj). # Array-element casts — identity on arrays; `bytes` coerces to a byte buffer. (defn core-bytes [x] (if (buffer? x) x (core-byte-array x))) @@ -1949,11 +1942,8 @@ # Scalar numeric coercions (defn core-byte [x] (let [b (band (math/trunc x) 0xff)] (if (>= b 128) (- b 256) b))) (defn core-short [x] (let [s (band (math/trunc x) 0xffff)] (if (>= s 0x8000) (- s 0x10000) s))) -(defn core-unchecked-byte [x] (band (math/trunc x) 0xff)) -(defn core-unchecked-short [x] (band (math/trunc x) 0xffff)) -(defn core-unchecked-char [x] (band (math/trunc x) 0xffff)) -(defn core-unchecked-float [x] (* 1.0 x)) -(defn core-unchecked-double [x] (* 1.0 x)) +# The masking unchecked-byte/short/char and float/double coercions live in +# the Clojure collection tier (core/20-coll.clj). # 64-bit integers (Janet int/s64 — C-backed) (defn core-bigint [x] (int/s64 x)) @@ -1982,8 +1972,7 @@ # reader-conditional? now lives in the Clojure collection tier (tagged-value predicate). # sorted-map-by / sorted-set-by (and all other sorted-coll constructors and # semantics) now live in the Clojure sorted tier (core/25-sorted.clj). -(defn core-array-seq [arr & _] (core-seq arr)) -(defn core-seque [& args] (in args (- (length args) 1))) +# array-seq / seque live in the Clojure collection tier (core/20-coll.clj). # supers now lives in the Clojure collection tier (no class hierarchy: #{}). (defn core-class [x] (cond @@ -2429,13 +2418,8 @@ (defn core-proxy-call-with-super [f proxy meth] (f)) (defn core-proxy-mappings [proxy] {}) (defn core-update-proxy [proxy mappings] proxy) -(defn core-numeric= [& args] - (if (< (length args) 2) true - (do (var ok true) (var i 0) - (while (and ok (< i (dec (length args)))) - (unless (= (in args i) (in args (+ i 1))) (set ok false)) (++ i)) - ok))) -(defn core-memfn [& args] (error "memfn: JVM method handles are not supported in Jolt")) +# == lives in the Clojure collection tier (core/20-coll.clj); memfn is an +# overlay macro (core/30-macros.clj) over the .method call sugar. (defn core-eduction [& args] # (eduction xform* coll): apply the composed transducers eagerly to coll (let [n (length args) @@ -2505,17 +2489,8 @@ (defn core-deliver [p v] (core-reset! p v) p) (defn core-tagged-literal [tag form] @{:jolt/type :jolt/tagged-literal :tag tag :form form}) -(defn core-ensure-reduced [x] (if (core-reduced? x) x (core-reduced x))) -(defn core-halt-when [pred & rest] - (let [retf (if (> (length rest) 0) (in rest 0) nil)] - (fn [rf] - (fn [& a] - (case (length a) - 0 (rf) - 1 (rf (in a 0)) - (if (truthy? (pred (in a 1))) - (core-reduced (if retf (retf (rf (in a 0)) (in a 1)) (in a 1))) - (rf (in a 0) (in a 1)))))))) +# ensure-reduced / halt-when live in the Clojure collection tier +# (core/20-coll.clj) — halt-when is the canonical ::halt-map version there. (defn core-re-groups [m] (error "re-groups: stateful matchers are not supported in Jolt")) # Transients — real mutable scratch collections backed by Janet's native arrays @@ -2640,28 +2615,8 @@ -(defn- hex-digit? [c] - (or (and (>= c 48) (<= c 57)) # 0-9 - (and (>= c 97) (<= c 102)) # a-f - (and (>= c 65) (<= c 70)))) # A-F - -(defn core-parse-uuid - "(parse-uuid s) -> the UUID, or nil when s is not a canonical 8-4-4-4-12 hex - UUID string. Throws when s is not a string (Clojure 1.11)." - [s] - (when (not (or (string? s) (buffer? s))) - (error (string "parse-uuid requires a string, got " (type s)))) - (def dash-at {8 true 13 true 18 true 23 true}) - (if (and (= 36 (length s)) - (do - (var ok true) - (for i 0 36 - (if (get dash-at i) - (when (not= 45 (in s i)) (set ok false)) # 45 = "-" - (when (not (hex-digit? (in s i))) (set ok false)))) - ok)) - (make-uuid s) - nil)) +# parse-uuid lives in the Clojure collection tier (core/20-coll.clj) over +# re-matches + the __make-uuid host constructor (types.janet). (def- core-bindings "Map of symbol name → function for all core functions." @@ -2678,9 +2633,6 @@ "identical?" core-identical? "zero?" core-zero? "pos?" core-pos? - "neg?" core-neg? - "even?" core-even? - "odd?" core-odd? "integer?" core-integer? "list?" core-list? "every?" core-every? @@ -2695,7 +2647,6 @@ "quot" core-quot "rand" core-rand "=" core-= - "not=" core-not= "<" core-< ">" core-> "<=" core-<= @@ -2733,9 +2684,6 @@ "future?" core-future? "future-cancel" core-future-cancel "tagged-literal" core-tagged-literal - "ensure-reduced" core-ensure-reduced - "unreduced" core-unreduced - "halt-when" core-halt-when "re-groups" core-re-groups "transient" core-transient "transient?" core-transient? @@ -2748,6 +2696,7 @@ "hash-ordered-coll" core-hash-ordered-coll "hash-unordered-coll" core-hash-unordered-coll "gensym" gensym + "__make-uuid" make-uuid "compare" core-compare "type" core-type "slurp" core-slurp @@ -2759,10 +2708,7 @@ "__list-dir" core-list-dir "parse-long" core-parse-long "parse-double" core-parse-double - "parse-boolean" core-parse-boolean - "newline" core-newline "current-time-ms" core-current-time-ms - "parse-uuid" core-parse-uuid "mapcat" core-mapcat "transduce" core-transduce "sequence" core-sequence @@ -2785,8 +2731,6 @@ "sort" core-sort "partition" core-partition "range" core-range - "identity" core-identity - "constantly" core-constantly "vector" core-vector "hash-map" core-hash-map "array-map" core-array-map @@ -2845,7 +2789,6 @@ "make-array" core-make-array "into-array" core-into-array "to-array" core-to-array - "to-array-2d" core-to-array-2d "bytes" core-bytes "booleans" core-booleans "ints" core-ints @@ -2856,11 +2799,6 @@ "chars" core-chars "byte" core-byte "short" core-short - "unchecked-byte" core-unchecked-byte - "unchecked-short" core-unchecked-short - "unchecked-char" core-unchecked-char - "unchecked-float" core-unchecked-float - "unchecked-double" core-unchecked-double "bigint" core-bigint "biginteger" core-biginteger "chunk-buffer" core-chunk-buffer @@ -2874,8 +2812,6 @@ "cat" core-cat "disj!" core-disj! "reader-conditional" core-reader-conditional - "array-seq" core-array-seq - "seque" core-seque "class" core-class "enumeration-seq" core-enumeration-seq "iterator-seq" core-iterator-seq @@ -2886,8 +2822,6 @@ "proxy-call-with-super" core-proxy-call-with-super "proxy-mappings" core-proxy-mappings "update-proxy" core-update-proxy - "==" core-numeric= - "memfn" core-memfn "eduction" core-eduction "->Eduction" core->Eduction "proxy-super" core-proxy-super diff --git a/test/spec/numbers-spec.janet b/test/spec/numbers-spec.janet index 38cb1b9..1c83e9a 100644 --- a/test/spec/numbers-spec.janet +++ b/test/spec/numbers-spec.janet @@ -192,3 +192,15 @@ ["num passes a number through" "5" "(num 5)"] ["num on a double" "5.5" "(num 5.5)"] ["num throws on non-number" :throws "(num \"x\")"]) + +# == is numeric equality: single arg is trivially true (Clojure's 1-arity +# never inspects the value); 2+ args must be numbers. +(defspec "numbers / == numeric equality" + ["== single arg" "true" "(== :a)"] + ["== equal" "true" "(== 2 2)"] + ["== unequal" "false" "(== 2 3)"] + ["== chained" "true" "(== 2 2 2)"] + ["== chained unequal" "false" "(== 2 2 3)"] + ["== int and double" "true" "(== 1 1.0)"] + ["== throws on non-number" :throws "(== 1 :a)"] + ["== throws on two keywords" :throws "(== :a :a)"]) diff --git a/test/spec/transducers-spec.janet b/test/spec/transducers-spec.janet index 727581f..2b38908 100644 --- a/test/spec/transducers-spec.janet +++ b/test/spec/transducers-spec.janet @@ -28,6 +28,19 @@ ["eduction" "[2 3 4]" "(into [] (eduction (map inc) [1 2 3]))"] ["completing" "9" "(transduce (map inc) (completing +) 0 [1 2 3])"]) +# halt-when replaces the WHOLE reduction result with the halting input (or +# with (retf acc input)) — Clojure's ::halt map protocol, unwrapped by the +# transducer's completion arity. +(defspec "transducers / halt-when" + ["halt returns the halting input" "7" + "(transduce (halt-when (fn [x] (> x 5))) conj [1 2 7 3])"] + ["no halt is a plain reduction" "[1 2 3]" + "(transduce (halt-when (fn [x] (> x 5))) conj [1 2 3])"] + ["retf combines acc and input" "[[1 2] 7]" + "(transduce (halt-when (fn [x] (> x 5)) (fn [r i] [r i])) conj [1 2 7 3])"] + ["halt-when through into" "3" + "(into [] (halt-when odd?) [2 4 3 6])"]) + # A `take`/`take-while` transducer returns `reduced`, which must short-circuit # the reduction so transducing over an INFINITE seq terminates rather than # realizing it eagerly. diff --git a/test/spec/untested-vars-spec.janet b/test/spec/untested-vars-spec.janet index db2991c..a9a99ee 100644 --- a/test/spec/untested-vars-spec.janet +++ b/test/spec/untested-vars-spec.janet @@ -114,7 +114,11 @@ ["update-proxy" "nil" "(update-proxy nil {})"] ["proxy-mappings" "{}" "(proxy-mappings nil)"] ["proxy-call-with-super calls" "1" "(proxy-call-with-super (fn [] 1) nil \"m\")"] - ["memfn throws" :throws "((memfn count) \"abc\")"] + ["memfn upper" "\"ABC\"" "((memfn toUpperCase) \"abc\")"] + ["memfn with args" "2" "((memfn indexOf needle) \"hello\" \"l\")"] + ["memfn length" "3" "((memfn length) \"abc\")"] + ["array-seq" "(quote (1 2 3))" "(array-seq (to-array [1 2 3]))"] + ["array-seq empty" "nil" "(array-seq (to-array []))"] ["proxy-super throws" :throws "(proxy-super count [1])"] ["re-groups throws" :throws "(re-groups (re-matcher #\"a\" \"b\"))"] ["re-matcher builds" "false" "(nil? (re-matcher #\"a\" \"abc\"))"]