;; clojure.core — syntax tier. The control macros the compiler and every later
;; tier depend on (when/cond/and/or/...), expressed as defmacro. Loaded FIRST
;; (before 00-kernel), interpreted, so the macros exist before any code that uses
;; them is compiled — including the kernel tier, the self-hosted analyzer, and the
;; seq/coll tiers.
;;
;; CONSTRAINT: code here may use ONLY special forms (if/do/let*/fn*/not) and
;; SEED primitives (first/next/rest/nth/count/seq/...), plus earlier defs in
;; THIS file. It must NOT use kernel-tier fns (second/peek/subvec/...) or
;; anything defined later — those don't exist yet when this tier loads. Raw
;; fn*/let* (no destructuring) and no when/cond/and/or above their defmacros.
;;
;; This tier's defns load interpreted and are recompiled by the staged pass
;; (backend/recompile-defns!) once the analyzer is alive — same lifecycle as
;; the defmacro expanders.

;; zero?/pos?/every? live HERE (not 20-coll): empty? below calls zero?, and
;; the self-hosted analyzer — compiled right after the kernel tier — uses all
;; three. Raw def+fn* per the file constraint. zero? checks number? itself
;; (= doesn't throw); pos? inherits throwing from >.
(def zero?
  (fn* zero? [x]
    (if (number? x)
      (= x 0)
      (throw (str "zero? requires a number, got: " x)))))

;; pos? checks number? explicitly: this tier is recompiled by the staged pass,
;; where a bare (> x 0) emits the native janet op that happily orders strings
;; (the documented native-ops relaxation) — the guard keeps Clojure's throw.
(def pos?
  (fn* pos? [x]
    (if (number? x)
      (> x 0)
      (throw (str "pos? requires a number, got: " x)))))

;; Canonical every?: short-circuits on the first falsey result, so infinite
;; seqs with an early counterexample terminate.
(def every?
  (fn* every? [pred coll]
    (if (nil? (seq coll))
      true
      (if (pred (first coll))
        (recur pred (next coll))
        false))))

;; empty?/keys/vals live HERE (not 20-coll) because the expanders below call
;; them at expansion time, which first happens during the kernel-tier compile.
;; empty? keeps O(1) dispatch for counted things; only the lazy/list fallback
;; goes through seq's cell check.
(def empty?
  (fn* empty? [coll]
    (if (nil? coll)
      true
      (if (vector? coll)
        (zero? (count coll))
        (if (map? coll)
          (zero? (count coll))
          (if (set? coll)
            (zero? (count coll))
            (if (string? coll)
              (zero? (count coll))
              (nil? (seq coll)))))))))

;; Canonical: the seq of entries/elements, projected. (keys {}) is nil; sorted
;; maps iterate in comparator order ((seq sm) is the value's own :seq op).
(def keys
  (fn* keys [m]
    (let* [s (seq m)]
      (if s (map (fn* [e] (nth e 0)) s) nil))))

(def vals
  (fn* vals [m]
    (let* [s (seq m)]
      (if s (map (fn* [e] (nth e 1)) s) nil))))

(defmacro when [test & body]
  `(if ~test (do ~@body)))

(defmacro when-not [test & body]
  `(if (not ~test) (do ~@body)))

(defmacro and [& exprs]
  (if (empty? exprs)
    true
    (if (empty? (rest exprs))
      (first exprs)
      `(let* [and# ~(first exprs)] (if and# (and ~@(rest exprs)) and#)))))

(defmacro or [& exprs]
  (if (empty? exprs)
    nil
    (if (empty? (rest exprs))
      (first exprs)
      `(let* [or# ~(first exprs)] (if or# or# (or ~@(rest exprs)))))))

;; :else (any truthy value) is just a test, so no special case — (if :else e ...)
;; takes e.
(defmacro cond [& clauses]
  (if (empty? clauses)
    nil
    `(if ~(first clauses) ~(nth clauses 1) (cond ~@(drop 2 clauses)))))

;; ns is sugar over the namespace-op fns (in-ns/require/use/import/refer-clojure,
;; all ctx-capturing clojure.core fns) — matching Clojure, where require is a fn and
;; the ns macro expands its clauses into require calls. Each spec is quoted
;; individually and passed as data; non-list clauses (docstring, attr-map,
;; :gen-class, …) are ignored. So ns compiles to a plain (do …) of invokes.
;; MUST live in this first tier: the self-hosted analyzer build (triggered while
;; 10-seq loads) processes jolt.analyzer's own (ns …) form, so ns has to exist by
;; then. Its body resolves fn/map/reduce/cond at EXPANSION time, by which point all
;; of 00-syntax has loaded, so using them here is fine.
(defmacro ns [nm & clauses]
  (let [calls (reduce
                (fn [acc clause]
                  (if (seq? clause)
                    (let [head (first clause) args (rest clause)]
                      (cond
                        (= head :require) (conj acc `(require ~@(map (fn [s] `(quote ~s)) args)))
                        (= head :use)     (conj acc `(use ~@(map (fn [s] `(quote ~s)) args)))
                        (= head :import)  (conj acc `(import ~@(map (fn [s] `(quote ~s)) args)))
                        (= head :refer-clojure)
                          (conj acc `(refer-clojure ~@(map (fn [s] `(quote ~s)) args)))
                        :else acc))
                    acc))
                [] clauses)]
    `(do (in-ns (quote ~nm)) ~@calls)))

;; Threading: a list form threads x in as the first (->) or last (->>) arg; a bare
;; symbol becomes (form x). Recursive; the expand-once cache makes that free.
(defmacro -> [x & forms]
  (if (empty? forms)
    x
    (let [form (first forms)
          threaded (if (seq? form)
                     `(~(first form) ~x ~@(rest form))
                     `(~form ~x))]
      `(-> ~threaded ~@(rest forms)))))

(defmacro ->> [x & forms]
  (if (empty? forms)
    x
    (let [form (first forms)
          threaded (if (seq? form)
                     `(~(first form) ~@(rest form) ~x)
                     `(~form ~x))]
      `(->> ~threaded ~@(rest forms)))))

;; Forward declaration interns unbound vars (Clojure semantics). The interpreter
;; resolves forward refs lazily either way, but the COMPILER classifies globals at
;; compile time: without the var, a declared name that collides with a Janet root
;; binding (parse, hash, …) would compile to the host fn instead of the var.
(defmacro declare [& syms]
  `(do ~@(map (fn* [s] `(def ~s)) syms)))

;; destructure — Clojure's binding-vector expander, ported from the Janet seed
;; (was core-destructure). Turns a binding vector that may contain destructuring
;; patterns into a plain binding vector (alternating symbol / init-form) built from
;; nth/nthnext/get, so the COMPILER only ever sees plain symbols (analyze-bindings
;; rejects patterns). `let` consumes it directly; `loop`/`fn` reuse it transitively
;; through `let`. Written with let*/fn* and seed primitives only — it never uses
;; let/loop/fn, so expanding its own body can't recurse back into destructure.
;; Note map? is true for symbol structs too, so the symbol? clause must come first.
;; def+fn* (not defn) because the defn macro is not defined until later in the tier.
(def destructure
 (fn* destructure [bindings]
  (let* [find-or
           (fn* [or-map nm]
             (reduce (fn* [acc k]
                       (if (and (symbol? k) (= nm (name k)))
                         [true (get or-map k)]
                         acc))
                     [false nil]
                     (if or-map (keys or-map) [])))
         amp? (fn* [x] (and (symbol? x) (= "&" (name x))))
         proc
           (fn* proc [pat init acc]
             (cond
               (symbol? pat) (conj (conj acc pat) init)
               (vector? pat)
                 (let* [g (symbol (str (gensym)))
                        n (count pat)
                        vloop
                          (fn* vloop [i idx a]
                            (if (< i n)
                              (let* [elem (nth pat i)]
                                (cond
                                  (amp? elem)
                                    (vloop (+ i 2) idx (proc (nth pat (inc i)) `(nthnext ~g ~idx) a))
                                  (= elem :as)
                                    (vloop (+ i 2) idx (proc (nth pat (inc i)) g a))
                                  :else
                                    (vloop (inc i) (inc idx) (proc elem `(nth ~g ~idx nil) a))))
                              a))]
                   (vloop 0 0 (conj (conj acc g) init)))
               (map? pat)
                 (let* [g (symbol (str (gensym)))
                        gm (symbol (str (gensym)))
                        ;; kwargs: a map pattern may bind against the sequential rest
                        ;; of a fn — (& {:keys [...]}) — which is a seq of alternating
                        ;; k/v args, or a single trailing map. Coerce like Clojure (and
                        ;; like the interpreter's destructure-bind, so interpret/compile
                        ;; agree): a sequential value with one map element is that map,
                        ;; otherwise (apply hash-map). A real map value is used as-is, so
                        ;; ordinary map destructuring is unaffected. g holds init once;
                        ;; gm is the coerced map every lookup (and :as) reads from.
                        coerce `(if (sequential? ~g)
                                  (if (and (= 1 (count ~g)) (map? (first ~g)))
                                    (first ~g)
                                    (apply hash-map ~g))
                                  ~g)
                        or-map (get pat :or)
                        as-sym (get pat :as)
                        bound (conj (conj (conj (conj acc g) init) gm) coerce)
                        base (if as-sym (conj (conj bound as-sym) gm) bound)
                        group
                          (fn* [a kw kind]
                            (let* [names (get pat kw)]
                              (if names
                                (reduce
                                  ;; s is a symbol (a b) or a keyword (:a :b); name/
                                  ;; namespace handle both, so :keys [:major] binds
                                  ;; `major` looking up :major (str would keep the colon).
                                  (fn* [aa s]
                                    (let* [local (name s)
                                           nsp (namespace s)
                                           keyform (cond
                                                     (= kind :kw) (keyword (if nsp (str nsp "/" local) local))
                                                     (= kind :str) local
                                                     :else `(quote ~(symbol nsp local)))
                                           fo (find-or or-map local)]
                                      (conj (conj aa (symbol local))
                                            (if (nth fo 0)
                                              `(get ~gm ~keyform ~(nth fo 1))
                                              `(get ~gm ~keyform)))))
                                  a names)
                                a)))
                        g1 (group base :keys :kw)
                        g2 (group g1 :strs :str)
                        g3 (group g2 :syms :sym)]
                   (reduce (fn* [a k]
                             (if (keyword? k)
                               a
                               (proc k `(get ~gm ~(get pat k)) a)))
                           g3 (keys pat)))
               :else (throw (str "unsupported destructuring pattern"))))
         ploop
           (fn* ploop [i acc]
             (if (< i (count bindings))
               (ploop (+ i 2) (proc (nth bindings i) (nth bindings (inc i)) acc))
               acc))]
    (ploop 0 []))))

;; let desugars destructuring patterns to plain bindings (via destructure) so the
;; COMPILER sees only plain symbols — analyze-bindings rejects patterns as
;; uncompilable, relying on this macro to have expanded them. (The interpreter
;; could destructure let* directly, but the compiler can't.) let* is sequential, so
;; a later init can reference an earlier destructured name. Splice via [~@..] so the
;; binding vector is a tuple form (destructure returns a pvec), not a pvec literal.
(defmacro let [bindings & body]
  `(let* [~@(destructure bindings)] ~@body))

;; loop binds destructuring forms like let, but recur must target the loop* vars,
;; whose count can't change. So (matching Clojure): gensym one loop var per binding,
;; loop* over those, and destructure them via an inner let each iteration; an outer
;; let establishes the destructured names so later inits can see them. Plain loops
;; (no patterns) pass straight through to loop*.
(defmacro loop [bindings & body]
  (let [d (destructure bindings)]
    (if (= d bindings)
      `(loop* ~bindings ~@body)
      (let [bs (take-nth 2 bindings)
            vs (take-nth 2 (drop 1 bindings))
            gs (map (fn [b] (if (symbol? b) b (symbol (str (gensym))))) bs)
            outer (reduce (fn [acc t]
                            (let [b (nth t 0) v (nth t 1) g (nth t 2)]
                              (if (symbol? b) (conj (conj acc g) v)
                                  (conj (conj (conj (conj acc g) v) b) g))))
                          [] (map vector bs vs gs))
            inner (reduce (fn [acc t] (conj (conj acc (nth t 0)) (nth t 1)))
                          [] (map vector bs gs))
            loopv (reduce (fn [acc g] (conj (conj acc g) g)) [] gs)]
        ;; splice via [~@..] so the binding vectors are tuple forms, not pvecs.
        `(let [~@outer] (loop* [~@loopv] (let [~@inner] ~@body)))))))

;; fn: desugar destructuring params to plain symbols + a body let (matching
;; Clojure's maybe-destructured), so fn* only ever sees plain params (the compiler's
;; analyze-fn requires that). Plain params pass through untouched. Handles an
;; optional name and single- or multi-arity. md/mk are fn* (not fn) to avoid a cycle.
;; md walks a param seq, replacing non-symbol patterns with gensyms and recording
;; [pattern gensym] let-bindings; mk turns one arity (params . body) into a rewritten
;; arity. Output: single arity splices the arity's elements straight into fn*; multi
;; arity splices the rewritten clauses.
(defmacro fn [& raw]
  (let [nm (if (symbol? (first raw)) (first raw) nil)
        aftn (if nm (next raw) raw)
        ;; a return-type hint (defn f ^bytes [x] ...) reaches us as a
        ;; (with-meta [x] {:tag ...}) FORM in params position — unwrap it
        ;; (the hint means nothing on jolt; ring-codec carries several).
        unhint (fn* [x]
                 (if (if (seq? x) (= 'with-meta (first x)) false)
                   (nth x 1)
                   x))
        md (fn* go [ps nps lets]
             (if (seq ps)
               (if (symbol? (first ps))
                 (go (next ps) (conj nps (first ps)) lets)
                 ;; bare (gensym) here is Janet's (a Janet symbol the destructurer
                 ;; rejects); round-trip through str for a jolt symbol.
                 (let [g (symbol (str (gensym)))]
                   (go (next ps) (conj nps g) (conj (conj lets (first ps)) g))))
               [nps lets]))
        mk (fn* [sig]
             (let [ps (unhint (first sig))
                   hinted (not (= ps (first sig)))
                   r (md (seq ps) [] [])]
               (if (if (empty? (nth r 1)) (not hinted) false)
                 sig
                 ;; build the params/let vectors via [~@..] so they are tuple forms
                 ;; (the accumulators are plain seqs, the wrong representation).
                 ;; A hinted-but-undestructured arity also rebuilds, to shed the
                 ;; with-meta wrapper without changing the clause representation.
                 (let [pv `[~@(nth r 0)]
                       lv `[~@(nth r 1)]]
                   (if (empty? (nth r 1))
                     `(~pv ~@(rest sig))
                     `(~pv (let ~lv ~@(rest sig))))))))]
    (if (vector? (unhint (first aftn)))
      (let [a (mk aftn)]
        (if nm `(fn* ~nm ~@a) `(fn* ~@a)))
      (let [as (vec (map mk aftn))]
        (if nm `(fn* ~nm ~@as) `(fn* ~@as))))))

;; defn: drop an optional leading docstring and attr-map, then (def name (fn ...)).
;; Emits the fn MACRO (not the fn* primitive) so destructuring params desugar — fn*
;; requires plain symbols (like Clojure). Unnamed (as before): self-recursion
;; resolves through the def'd var, so this only adds the desugaring step.
;; Both single- and multi-arity reduce to (fn ~@body) — fn takes either a params
;; vector + body or a sequence of ([params] body) clauses, so no arity branching is
;; needed. (map? is true for symbol forms too, so guard the attr-map with symbol?.)
;; Defined before fresh-sym below, which is a defn-.
(defmacro defn [fn-name & body]
  (let [body (if (and (seq body) (string? (first body))) (rest body) body)
        body (if (and (seq body) (map? (first body)) (not (symbol? (first body))))
               (rest body) body)]
    ;; pass the name through to fn: the compiled fn's janet name carries it,
    ;; so stack traces read app.deep/level3 instead of a gensym (jolt-2o7.1)
    `(def ~fn-name (fn ~fn-name ~@body))))

;; Jolt doesn't enforce privacy, so defn- is just defn (matching how Clojure's own
;; defn- delegates to defn with :private metadata).
(defmacro defn- [fn-name & body] `(defn ~fn-name ~@body))

;; A fresh jolt symbol inside a macro body (a bare (gensym) returns a Janet symbol
;; the destructurer rejects). This defn compiles fine: by the time a tier triggers
;; the analyzer build the kernel is in place (the build is gated until then).
(defn- fresh-sym [] (symbol (str (gensym))))

;; cond->: thread expr through each (test form) pair, only when the test is truthy.
;; Linear nested let*, a distinct fresh symbol per step.
(defmacro cond-> [expr & clauses]
  (let [step (fn step [prev cls]
               (if (empty? cls)
                 prev
                 (let [t (first cls)
                       f (nth cls 1)
                       gn (fresh-sym)
                       call (if (seq? f) `(~(first f) ~prev ~@(rest f)) `(~f ~prev))]
                   `(let* [~gn (if ~t ~call ~prev)] ~(step gn (drop 2 cls))))))
        g0 (fresh-sym)]
    `(let* [~g0 ~expr] ~(step g0 clauses))))

;; case: nested =/or tests (no jump table). Test constants are NOT evaluated —
;; symbols and list constants are quoted; a list in test position is a set (or).
(defmacro case [expr & clauses]
  (let [g (fresh-sym)
        mk-const (fn [c] (if (or (symbol? c) (seq? c)) `(quote ~c) c))
        mk-test (fn [c]
                  (if (seq? c)
                    `(or ~@(map (fn [v] `(= ~g ~(mk-const v))) c))
                    `(= ~g ~(mk-const c))))
        ;; Collect test constants pairwise (so a trailing unpaired default is
        ;; excluded), flattening list/or-group tests into individual constants.
        ;; seed-only fns (reduce/conj/first/rest/drop/empty?/seq?) — analyzer.clj
        ;; uses case during its own build, before some/distinct load.
        collect (fn* collect [cls acc]
                  (if (or (empty? cls) (empty? (rest cls)))
                    acc
                    (let [t (first cls)
                          acc (if (seq? t) (reduce conj acc t) (conj acc t))]
                      (collect (drop 2 cls) acc))))
        ;; first duplicate constant, wrapped in [x] (so a duplicate nil is detected);
        ;; nil = none. Clojure rejects duplicate case constants at compile time.
        first-dup (fn* fd [items seen]
                    (if (empty? items)
                      nil
                      (let [x (first items)]
                        (if (reduce (fn [f s] (or f (= s x))) false seen)
                          [x]
                          (fd (rest items) (conj seen x))))))
        dup (first-dup (collect clauses []) [])
        build (fn build [cls]
                (if (empty? cls)
                  ;; no clause matched and no default — Clojure throws here.
                  `(throw (ex-info (str "No matching clause: " ~g) {}))
                  (if (empty? (rest cls))
                    (first cls)
                    `(if ~(mk-test (first cls)) ~(nth cls 1) ~(build (drop 2 cls))))))]
    (if dup
      (throw (str "Duplicate case test constant: " (first dup)))
      `(let* [~g ~expr] ~(build clauses)))))

;; for: list comprehension, desugared to nested map/mapcat over the binding colls.
;; Per binding group: :when wraps the inner form in (if test (list inner) []) so
;; mapcat drops it when false; :let wraps it in a let*; :while wraps the coll in
;; take-while. The last group with no modifiers is a plain map (no flatten needed).
;; Faithful port of the prior Janet macro (single body expr). The body uses only
;; kernel/seed fns so it runs at analyzer-build time. `fn` (not fn*) carries the
;; binding so destructuring forms work.
(defmacro for [bindings body]
  (let [scan (fn scan [bvec i bind coll mods]
               (if (and (< i (count bvec)) (keyword? (nth bvec i)))
                 (let [k (nth bvec i)
                       v (nth bvec (inc i))]
                   (cond
                     (= k :when)  (scan bvec (+ i 2) bind coll (conj mods [:when v]))
                     (= k :let)   (scan bvec (+ i 2) bind coll (conj mods [:let v]))
                     (= k :while) (scan bvec (+ i 2) bind `(take-while (fn [~bind] ~v) ~coll) mods)
                     :else        (scan bvec (inc i) bind coll mods)))
                 [i bind coll mods]))
        parse-groups (fn parse-groups [bvec i groups]
                       (if (>= i (count bvec))
                         groups
                         (let [r (scan bvec (+ i 2) (nth bvec i) (nth bvec (inc i)) [])]
                           (parse-groups bvec (nth r 0)
                                         (conj groups [(nth r 1) (nth r 2) (nth r 3)])))))
        ;; Apply the group's modifiers around a contribution that is ALREADY a seq
        ;; (a (list body) for the last group, an inner comprehension otherwise), so
        ;; :when just returns it or [] — no extra (list ...) that mapcat couldn't
        ;; flatten. :let binds around it; mods apply outer-to-inner (left to right).
        wrap-mods (fn wrap-mods [mods inner]
                    (if (empty? mods)
                      inner
                      (let [m (first mods)
                            sub (wrap-mods (rest mods) inner)]
                        (if (= (first m) :when)
                          `(if ~(nth m 1) ~sub [])
                          `(let* ~(nth m 1) ~sub)))))
        build (fn build [idx groups]
                (let [g (nth groups idx)
                      my-bind (nth g 0)
                      my-coll (nth g 1)
                      my-mods (nth g 2)
                      is-last (= idx (dec (count groups)))]
                  (if (and is-last (empty? my-mods))
                    ;; fast path: last group, no modifiers -> a plain map of body
                    `(map (fn [~my-bind] ~body) ~my-coll)
                    ;; general: mapcat over a seq contribution (wrap a last-group
                    ;; body in a one-element list so mapcat yields the bodies).
                    (let [base (if is-last `(list ~body) (build (inc idx) groups))]
                      `(mapcat (fn [~my-bind] ~(wrap-mods my-mods base)) ~my-coll)))))]
    (if (>= (count bindings) 2)
      (build 0 (parse-groups bindings 0 []))
      body)))

;; doseq runs body for side effects across the bindings, returning nil. Same
;; shortcut as the prior Janet macro: realize a `for` comprehension with count
;; (for handles :when/:let/:while and multiple bindings).
(defmacro doseq [bindings & body]
  `(do (count (for ~bindings (do ~@body nil))) nil))

;; when-let must live in this (early) tier, not 30-macros with its if-let/if-some/
;; when-some siblings: 20-coll uses it (not-empty), and 20-coll loads before 30. The
;; name binds only in the taken branch (temp# tests the value); via `let` so the
;; binding form may itself destructure, matching Clojure.
(defmacro when-let [bindings & body]
  (let [form (bindings 0) tst (bindings 1)]
    `(let [temp# ~tst]
       (if temp# (let [~form temp#] ~@body) nil))))

;; lazy-seq / lazy-cat live here (not 30-macros) because the seq/coll tiers use
;; them and compile-as-they-load: the macro must be registered before those tiers
;; or (lazy-seq …) compiles to a call of the macro-as-function and leaks its
;; expansion at runtime (jolt-r81). They use only seed fns (make-lazy-seq/
;; coll->cells/concat) + map, all available from the start.
;; lazy-seq defers its body: make-lazy-seq holds a thunk that realizes the body
;; to cells when forced. lazy-cat wraps each coll in a lazy-seq and concats.
(defmacro lazy-seq [& body]
  `(make-lazy-seq (fn* [] (coll->cells (do ~@body)))))

(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))