diff --git a/docs/spec/03-special-forms.md b/docs/spec/03-special-forms.md index 7f46804..e90a02d 100644 --- a/docs/spec/03-special-forms.md +++ b/docs/spec/03-special-forms.md @@ -66,7 +66,8 @@ reference; it differs from Scheme. S1–S3, E1–E2 → 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). --- diff --git a/jolt-core/clojure/core/20-coll.clj b/jolt-core/clojure/core/20-coll.clj index e2d776b..287914d 100644 --- a/jolt-core/clojure/core/20-coll.clj +++ b/jolt-core/clojure/core/20-coll.clj @@ -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 diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index b036650..bf3e9a8 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -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) - (analyze ctx (nth items 2) env) - (if (> (count items) 3) - (analyze ctx (nth items 3) env) - (const nil))) + "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)))) "do" (analyze-seq ctx (rest items) env) "throw" (throw-node (analyze ctx (nth items 1) env)) "def" (let [name-sym (nth items 1)] diff --git a/jolt-core/jolt/passes.clj b/jolt-core/jolt/passes.clj index 1d73b07..e60e23b 100644 --- a/jolt-core/jolt/passes.clj +++ b/jolt-core/jolt/passes.clj @@ -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)))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 8870304..4ae22d5 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -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 diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 15608cd..f26edcf 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -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 (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" (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)))) "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 diff --git a/test/spec/forms-spec.janet b/test/spec/forms-spec.janet index b08f135..dab5fb8 100644 --- a/test/spec/forms-spec.janet +++ b/test/spec/forms-spec.janet @@ -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)"]) diff --git a/test/spec/numbers-spec.janet b/test/spec/numbers-spec.janet index 1c83e9a..8cf89b2 100644 --- a/test/spec/numbers-spec.janet +++ b/test/spec/numbers-spec.janet @@ -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)"]) diff --git a/test/spec/sets-spec.janet b/test/spec/sets-spec.janet index c1d301f..cc99124 100644 --- a/test/spec/sets-spec.janet +++ b/test/spec/sets-spec.janet @@ -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))"])