core: move the pure-leaf fns to the overlay; memfn is a real macro now
Round 3 of the seed shrink. To the overlay: identity, constantly, neg?,
even?, odd? (20-coll, ahead of their first in-tier uses), not= and unreduced
(00-syntax — the kernel and seq tiers use them), ==, ensure-reduced,
halt-when, parse-boolean, parse-uuid, newline, seque, array-seq, to-array-2d,
and the masking unchecked-byte/short/char/float/double coercions. parse-uuid
validates via re-matches over a new __make-uuid host binding (overlay source
can't write :jolt/type map literals). memfn moves to 30-macros as a working
macro over the .method call sugar instead of a fn that throws.
Behavior fixes toward Clojure, each with spec rows: == now throws on
non-numbers instead of comparing them, and halt-when is the canonical
::halt-map version (the halt value replaces the whole reduction result, no
double completion). list? and map-entry? stay in the seed — both are
representation-coupled (plist/tuple checks).
clojure-test-suite goes 4701 -> 4700: update.cljc expects
(update {:k 1} :k identity 1 2 3 4) to throw an arity error, and jolt fns
don't enforce fixed arity anywhere (pre-existing, language-wide — the seed's
Janet identity threw natively). Filed as jolt-6xn; fixing it should flip
several suite rows at once.
This commit is contained in:
parent
65687c69ae
commit
7ca88ab2b5
7 changed files with 154 additions and 84 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue