core: variadic bit ops, set? covers sorted sets, if rejects extra forms

Three canonical-conformance fixes from the post-shrink batch:

- bit-and/bit-or/bit-xor/bit-and-not get Clojure's variadic arities as
  20-coll shells folding the binary host ops (now __bit-* seams). 2-arg call
  sites still compile to the native janet op via the backend's native-ops
  table. The passes.clj constant-fold table now names the seams — the public
  fns are overlay and don't exist when the compiler loads (this briefly broke
  every compile-mode init).

- core-set? recognizes the :jolt/sorted-set representation (jolt-dpn):
  (set? (sorted-set 1)) was false, and ifn? on sorted sets inherited the bug.

- (if) / (if test) / (if test then else extra) throw in both the analyzer
  and the interpreter — spec 03-special-forms X1, now marked verified.

Suite 4704 -> 4706; bench and the greeter example benchmark are flat.
This commit is contained in:
Yogthos 2026-06-11 17:04:26 -04:00
parent 621dc8e310
commit c6f6b7deb7
9 changed files with 84 additions and 16 deletions

View file

@ -66,7 +66,8 @@ reference; it differs from Scheme.
S1S3, E1E2 → jolt `forms-spec` "if/do/def" group; truthiness group in
`truthiness-spec`; clojure-test-suite `core_test/if.cljc`. S4 → `forms-spec`
fn/loop recur cases. X1 → UNVERIFIED (arity-error case to add).
fn/loop recur cases. X1 → `forms-spec` "if arity (X1)" (0/1/4-arg forms throw
in both the analyzer and the interpreter).
---

View file

@ -17,6 +17,25 @@
;; even?/odd? stay in the seed: (filter even? ...) is idiomatic-hot and the
;; overlay versions cost an extra call layer per element (seq-pipe bench 4x).
;; Variadic bit ops — canonical Clojure arities folding the binary host op
;; (__bit-* seams). 2-arg call sites still compile to the native janet op via
;; the backend's native-ops table, so the binary fast path is unchanged.
(defn bit-and
([x y] (__bit-and x y))
([x y & more] (reduce __bit-and (__bit-and x y) more)))
(defn bit-or
([x y] (__bit-or x y))
([x y & more] (reduce __bit-or (__bit-or x y) more)))
(defn bit-xor
([x y] (__bit-xor x y))
([x y & more] (reduce __bit-xor (__bit-xor x y) more)))
(defn bit-and-not
([x y] (__bit-and-not x y))
([x y & more] (reduce __bit-and-not (__bit-and-not x y) more)))
;; The printing family, over two host seams: __write (push a string to *out*)
;; and __pr-str1 (render ONE value readably). The renderer itself stays host —
;; it's representation-coupled (pvec/phm/phs/sorted internals) and shared with

View file

@ -133,11 +133,15 @@
(defn- analyze-special [ctx op items env]
(case op
"quote" (quote-node (second items))
"if" (if-node (analyze ctx (nth items 1) env)
"if" (do
;; 2 or 3 argument forms only (spec 03-special-forms X1)
(when (or (< (count items) 3) (> (count items) 4))
(throw (str "Wrong number of args (" (dec (count items)) ") passed to: if")))
(if-node (analyze ctx (nth items 1) env)
(analyze ctx (nth items 2) env)
(if (> (count items) 3)
(analyze ctx (nth items 3) env)
(const nil)))
(const nil))))
"do" (analyze-seq ctx (rest items) env)
"throw" (throw-node (analyze ctx (nth items 1) env))
"def" (let [name-sym (nth items 1)]

View file

@ -17,7 +17,10 @@
"<" < ">" > "<=" <= ">=" >= "=" =
"inc" inc "dec" dec
"mod" mod "rem" rem "quot" quot
"bit-and" bit-and "bit-or" bit-or "bit-xor" bit-xor})
;; the __bit-* seams: the PUBLIC bit fns are 20-coll variadic shells now,
;; which don't exist yet when this ns loads. Folding stays 2-arg (a 3+-arg
;; constant call throws arity inside the fold and is left for runtime).
"bit-and" __bit-and "bit-or" __bit-or "bit-xor" __bit-xor})
(defn- const? [n] (= :const (get n :op)))
(defn- const-num? [n] (and (const? n) (number? (get n :val))))

View file

@ -1450,7 +1450,8 @@
(defn core-hash-set [& xs]
(apply make-phs xs))
(defn core-set? [x] (set? x))
# sorted sets are tagged tables the host set? predicate misses (jolt-dpn)
(defn core-set? [x] (or (set? x) (core-sorted-set? x)))
(defn core-disj [s & ks]
(cond
(core-sorted-set? s) ((sorted-op s :disj) s ks)
@ -2782,9 +2783,9 @@
"init-proxy" core-init-proxy
"get-proxy-class" core-get-proxy-class
# Bit operations
"bit-and" core-bit-and
"bit-or" core-bit-or
"bit-xor" core-bit-xor
"__bit-and" core-bit-and
"__bit-or" core-bit-or
"__bit-xor" core-bit-xor
"bit-not" core-bit-not
"bit-shift-left" core-bit-shift-left
"bit-shift-right" core-bit-shift-right
@ -2792,7 +2793,7 @@
"bit-set" core-bit-set
"bit-flip" core-bit-flip
"bit-test" core-bit-test
"bit-and-not" core-bit-and-not
"__bit-and-not" core-bit-and-not
"unsigned-bit-shift-right" core-unsigned-bit-shift-right
# Integer coercion / unchecked math
"int" core-int

View file

@ -1531,10 +1531,14 @@
(set result (eval-form ctx bindings (in form i)))
(++ i)))
result)
"if" (let [test-val (eval-form ctx bindings (in form 1))]
"if" (do
# 2 or 3 argument forms only (spec 03-special-forms X1)
(when (or (< (length form) 3) (> (length form) 4))
(error (string "Wrong number of args (" (dec (length form)) ") passed to: if")))
(let [test-val (eval-form ctx bindings (in form 1))]
(if (and (not (nil? test-val)) (not (= false test-val)))
(eval-form ctx bindings (in form 2))
(if (> (length form) 3) (eval-form ctx bindings (in form 3)) nil)))
(if (> (length form) 3) (eval-form ctx bindings (in form 3)) nil))))
"def" (let [raw-name (in form 1)
name-sym (unwrap-meta-name raw-name)
# Metadata on the name: keyword/type-hint metadata rides on the

View file

@ -81,3 +81,12 @@
["call literal fn" "1" "((fn* [] 1))"]
["call nested" "6" "(+ ((fn* [] 1)) ((fn* [] 2)) ((fn* [] 3)))"]
["call nil" :throws "(nil)"])
# if takes two or three argument forms — anything else is a compile-time
# error (spec 03-special-forms X1).
(defspec "forms / if arity (X1)"
["bare if throws" :throws "(if)"]
["one-arg if throws" :throws "(if true)"]
["four-arg if throws" :throws "(if true 1 2 3)"]
["two-arg if ok" "nil" "(if false 1)"]
["three-arg if ok" "2" "(if false 1 2)"])

View file

@ -204,3 +204,17 @@
["== int and double" "true" "(== 1 1.0)"]
["== throws on non-number" :throws "(== 1 :a)"]
["== throws on two keywords" :throws "(== :a :a)"])
# Variadic bit ops (canonical Clojure arities: binary host op folded over the
# rest). Shift/clear/set/flip/test stay 2-arg, as in Clojure.
(defspec "numbers / variadic bit ops"
["bit-and 2" "4" "(bit-and 12 6)"]
["bit-and 3" "4" "(bit-and 12 6 7)"]
["bit-and 4" "0" "(bit-and 12 6 7 3)"]
["bit-or 3" "7" "(bit-or 1 2 4)"]
["bit-xor 3" "7" "(bit-xor 1 2 4)"]
["bit-xor folds left" "1" "(bit-xor 5 6 2)"]
["bit-and-not 2" "8" "(bit-and-not 12 6)"]
["bit-and-not 3" "8" "(bit-and-not 12 6 3)"]
["bit-and single arg throws" :throws "(bit-and 5)"]
["bit-or keeps binary fast path" "3" "(bit-or 1 2)"])

View file

@ -43,3 +43,16 @@
["join" "#{{:a 1, :b 2, :c 3}}" "(do (require (quote [clojure.set :as s])) (s/join #{{:a 1 :b 2}} #{{:b 2 :c 3}}))"]
["map-invert" "{1 :a}" "(do (require (quote [clojure.set :as s])) (s/map-invert {:a 1}))"]
["rename-keys" "{:b 1}" "(do (require (quote [clojure.set :as s])) (s/rename-keys {:a 1} {:a :b}))"])
# set? recognizes every set representation (jolt-dpn: sorted sets are tagged
# tables the host set? predicate missed).
(defspec "set / set? across representations"
["literal" "true" "(set? #{1})"]
["empty literal" "true" "(set? #{})"]
["sorted-set" "true" "(set? (sorted-set 1 2))"]
["sorted-set-by" "true" "(set? (sorted-set-by > 1 2))"]
["empty sorted" "true" "(set? (sorted-set))"]
["map is not" "false" "(set? {})"]
["vector is not" "false" "(set? [1])"]
["coll? still true" "true" "(coll? (sorted-set 1))"]
["ifn? sorted-set" "true" "(ifn? (sorted-set 1))"])