# Fallback-zero verification (Stage 1 Task 3).
#
# self-host-test.janet checks observable RESULTS but not WHICH path ran — a form
# that silently fell back to the interpreter still "passes" there. This harness
# checks the path: it runs the portable analyzer (jolt.analyzer/analyze, via
# backend/analyze-form) on a corpus of NON-STATEFUL forms and asserts NONE raise
# :jolt/uncompilable — i.e. the self-hosted analyzer actually COMPILED them.
#
# As analyzer↔compiler.janet parity grows (Stage 1), move forms from the
# "intentional fallback" sanity list into the must-compile corpus. The day the
# fallback set equals the frozen intentional stateful set, the Janet bootstrap
# compiler is retireable.
#
# Mechanism: backend/analyze-form throws (a "jolt/uncompilable: …" string) for a
# punted form; (protect …) turns that into [false msg]. [true ir] == compiled.

(import ../../src/jolt/backend :as backend)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)

(def ctx (init-cached))

(defn- analyzes? [s]
  # true if the form COMPILES end to end (analyzer IR + back end emit), false if
  # it punts to the interpreter. Checks emit-ir too, not just analyze-form: letfn
  # and (def x) with no init now ANALYZE to IR, but the Janet back end punts them
  # at emit time (sequential let* can't express mutual recursion; an unbound var
  # is not a compiled value) — so analyze-form alone would miss the real
  # compile-vs-interpret decision that compile-and-eval makes.
  (def r (protect (backend/emit-ir ctx (backend/analyze-form ctx (parse-string s)))))
  (and (r 0) true))

# --- Must compile: pure, non-stateful value production. NONE may punt. ---
(def must-compile
  [# set literals (Task 1)
   "#{1 2 3}" "#{}" "#{:a :b :c}" "#{(inc 0) 2}" "(conj #{1 2} 3)"
   "[#{1 2} {:s #{3}}]" "(let [x 5] #{x (inc x)})"
   # other literals
   "[1 2 3]" "{:a 1 :b 2}" "{:k (inc 0)}" "[[1] [2 3]]" "42" ":kw" "\"str\""
   # control flow + binding
   "(+ 1 2)" "(if true 1 2)" "(do 1 2 3)" "(let [a 1 b 2] (+ a b))"
   "(fn [x] (* x x))" "(fn ([a] a) ([a b] (+ a b)))"
   "(loop [i 0] (if (< i 3) (recur (inc i)) i))"
   "(quote (a b c))" "(throw (ex-info \"x\" {}))"
   "(try (inc 1) (catch :default e e))"
   # def + calls into core
   "(def answer 42)" "(map inc [1 2 3])" "(reduce + 0 [1 2 3])"
   "(get {:a 1} :a)" "(vec (range 5))"
   # set?/disj are plain fns now, not special forms (jolt-g3h)
   "(set? #{1 2})" "(disj #{1 2 3} 2)"
   # Stage 2 (jolt-eaa): stateful forms moved onto the compile path. (binding only
   # compiles over an INTERNED var; the built-in dynamic vars aren't interned yet,
   # so it's exercised end-to-end in the state spec instead.)
   "(require (quote [clojure.string :as s]))" "(in-ns (quote foo.bar))"
   "(ns foo.bar (:require [clojure.string :as s]))"
   "(defprotocol P (m [x]))" "(extend-type Long P (m [x] x))"
   "(reify P (m [this] 1))" "(var map)"
   # Stage 2 tier 5: type/dispatch definitional forms compile too
   "(deftype Pt [x y])" "(deftype Sq [s] P (m [this] s))"
   "(defrecord Rec [a b])" "(defmulti mf :k)" "(defmethod mf :a [x] x)"
   # Stage 2 tier 6: var fns are ordinary invokes now
   "(var-get (var map))" "(var? (var map))" "(var-set (var map) map)"
   "(alter-var-root (var map) identity)" "(find-var (quote clojure.core/map))"
   "(intern (quote user) (quote tier6-sym) 42)"
   "(alter-meta! (var map) assoc :k 1)" "(reset-meta! (var map) {})"
   # Stage 2 tier 6b: ns-introspection fns are ordinary invokes now
   "(find-ns (quote clojure.core))" "(create-ns (quote t6.created))"
   "(remove-ns (quote t6.created))" "(count (all-ns))"
   "(the-ns (quote clojure.core))" "(ns-interns (quote clojure.core))"
   "(ns-aliases (quote user))" "(ns-imports (quote user))"
   "(ns-resolve (quote clojure.core) (quote map))" "(resolve (quote map))"
   "(refer (quote clojure.string))"
   # Stage 2 tier 6c: dispatch-table ops + misc compile as macros/plain invokes
   "(prefer-method mf :a :b)" "(remove-method mf :a)" "(remove-all-methods mf)"
   # get-method/methods take the multimethod VALUE (Clojure semantics), so the
   # arg must resolve — use a real multifn (print-method) rather than the
   # never-defined mf the isolated analyzer can't resolve.
   "(get-method print-method :default)" "(methods print-method)"
   "(satisfies? P 5)" "(instance? String \"x\")" "(locking :x 1)"
   "(defonce fz-once 1)" "(read-string \"[1 2]\")"
   "(macroexpand-1 (quote (when true 1)))"])

# --- THE FROZEN PUNT SET (Stage 2 complete) ---------------------------------
# These are the ONLY heads that may reach the interpreter, exhaustively:
#   defmacro          — definitional host seam (the EXPANDERS are compiled;
#                       see backend/recompile-macros!)
#   set!              — host var-cell mutation special
#   letfn             — analyzes to a :letrec IR node now (inc 3g), but the Janet
#                       back end still punts it at emit: its sequential let* can't
#                       express the mutual recursion. The Chez back end DOES
#                       compile it (letrec*). Janet stays interpret until emit-let
#                       gains a letrec lowering.
#   eval              — compile-and-run entry (also loader stateful-head?)
#   . / new / Foo. /  — thin host-interop heads the back end doesn't model
#   .method           — analyzes to a :host-call IR node now (inc 3h), but the
#                       Janet back end punts it at emit (no interop model). The
#                       Chez back end DOES lower it (jolt-host-call). Same shape as
#                       letfn: compiles on Chez, interprets on Janet.
#   .-field           — field access stays punted at analyze (form-special?)
#   gen-class, monitor-enter, monitor-exit — JVM-compat stubs
# Growing this list is a REGRESSION: a new punt means the compiler lost
# coverage. Shrinking it (e.g. letfn via letrec IR) is progress — move the
# form to must-compile.
(def must-punt
  ["(defmacro m [x] x)"
   "(set! *warn-on-reflection* true)"
   "(letfn [(f [n] (g n)) (g [n] (f n))] (f 1))"
   "(eval (quote (+ 1 2)))"
   # .method analyzes to :host-call now; a resolvable target ("x") makes it punt
   # at EMIT (the interop reason), not at analyze (an unresolved target).
   "(.toUpperCase \"x\")"
   "(.-field obj)"
   "(new Foo 1)"
   "(Foo. 1)"
   "(gen-class :name X)"
   "(monitor-enter x)"
   "(monitor-exit x)"])

(var fails @[])
(each s must-compile
  (unless (analyzes? s) (array/push fails (string "FALLBACK (should compile): " s))))
(each s must-punt
  (when (analyzes? s) (array/push fails (string "COMPILED (should punt): " s))))

(printf "fallback-zero: %d must-compile + %d must-punt — %d failures"
        (length must-compile) (length must-punt) (length fails))
(when (> (length fails) 0)
  (print "\nFailures:")
  (each f fails (printf "  %s" f))
  (os/exit 1))
(print "fallback-zero: OK (analyzer compiled the full non-stateful corpus)")
