diff --git a/jolt-core/clojure/core/40-lazy.clj b/jolt-core/clojure/core/40-lazy.clj index 4b981b7..655e4be 100644 --- a/jolt-core/clojure/core/40-lazy.clj +++ b/jolt-core/clojure/core/40-lazy.clj @@ -3,17 +3,26 @@ ;; ;; Each fn ported from CLJS core.cljs, stripped of chunked-seq branches. -;; --- distinct --- -(defn distinct [coll] - (let [step (fn step [xs seen] - (lazy-seq - ((fn [[f :as xs] seen] - (when-let [s (seq xs)] - (if (contains? seen f) - (recur (rest s) seen) - (cons f (step (rest s) (conj seen f)))))) - xs seen)))] - (step coll #{}))) +;; --- distinct --- (transducer + lazy collection arity; value-based dedup) +(defn distinct + ([] + (fn [rf] + (let [seen (volatile! #{})] + (fn ([] (rf)) ([result] (rf result)) + ([result input] + (if (contains? @seen input) + result + (do (vswap! seen conj input) (rf result input)))))))) + ([coll] + (let [step (fn step [xs seen] + (lazy-seq + ((fn [[f :as xs] seen] + (when-let [s (seq xs)] + (if (contains? seen f) + (recur (rest s) seen) + (cons f (step (rest s) (conj seen f)))))) + xs seen)))] + (step coll #{})))) ;; --- keep --- @@ -76,7 +85,9 @@ (cstep 0))) ())) -;; --- repeatedly --- +;; --- repeatedly --- ((f) throws on a non-fn; (take n …) throws on a non-number +;; count — both now enforced in the seed (jolt-call / core-take), so the canonical +;; CLJ form matches the repeatedly.cljc exception cases.) (defn repeatedly ([f] (lazy-seq (cons (f) (repeatedly f)))) ([n f] (take n (repeatedly f)))) @@ -91,10 +102,39 @@ (lazy-seq (cons x (iterate f (f x))))) -;; --- partition-all --- +;; --- partition-all --- (transducer + [n coll] + [n step coll]) +;; The collection arities realize EXACTLY n per chunk via a first/rest loop and +;; continue from the advanced cursor (not a re-drop / nthrest), so they realize +;; minimally — matching the Janet pstep the §6.3 laziness counters were written +;; against. (A take/nthrest form is correct but over-realizes.) (defn partition-all - ([n coll] (partition-all n n coll)) + ([n] + (fn [rf] + (let [a (volatile! [])] + (fn + ([] (rf)) + ([result] + (let [result (if (zero? (count @a)) + result + (let [v @a] (vreset! a []) (unreduced (rf result v))))] + (rf result))) + ([result input] + (vswap! a conj input) + (if (= n (count @a)) + (let [v @a] (vreset! a []) (rf result v)) + result)))))) + ([n coll] + (letfn [(go [s] + (lazy-seq + (when (seq s) + (loop [i 0 chunk [] cur s] + (if (and (< i n) (seq cur)) + (recur (inc i) (conj chunk (first cur)) (rest cur)) + (cons chunk (go cur)))))))] + (go coll))) ([n step coll] - (lazy-seq - (when-let [s (seq coll)] - (cons (take n s) (partition-all n step (nthrest coll step))))))) + (letfn [(go [s] + (lazy-seq + (when (seq s) + (cons (take n s) (go (nthrest s step))))))] + (go coll)))) diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index d5d016d..d820318 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -15,12 +15,12 @@ declared — the bootstrap compiles forward refs through var cells, but keeping them to one keeps the compiled namespace simple." (:require [jolt.ir :refer [const local var-ref host-ref if-node do-node invoke - def-node let-node fn-node vector-node map-node + def-node let-node fn-node vector-node map-node set-node quote-node throw-node]] [jolt.host :refer [form-sym? form-sym-name form-sym-ns form-list? form-vec? form-map? form-set? form-char? form-literal? form-elements form-vec-items - form-map-pairs form-special? compile-ns + form-map-pairs form-set-items form-special? compile-ns form-macro? form-expand-1 resolve-global form-sym-meta host-intern! form-syntax-quote-lower]])) @@ -207,6 +207,6 @@ (form-map? form) (map-node (mapv (fn [p] [(analyze ctx (first p) env) (analyze ctx (second p) env)]) (form-map-pairs form))) - (form-set? form) (uncompilable "set literal") + (form-set? form) (set-node (mapv #(analyze ctx % env) (form-set-items form))) (form-list? form) (analyze-list ctx form env) :else (uncompilable "unsupported form")))) diff --git a/src/jolt/api.janet b/src/jolt/api.janet index e3af642..b97fa28 100644 --- a/src/jolt/api.janet +++ b/src/jolt/api.janet @@ -53,7 +53,8 @@ {:ns "clojure.core.00-kernel" :kernel true} {:ns "clojure.core.10-seq" :kernel false} {:ns "clojure.core.20-coll" :kernel false} - {:ns "clojure.core.30-macros" :kernel false}]) + {:ns "clojure.core.30-macros" :kernel false} + {:ns "clojure.core.40-lazy" :kernel false}]) (defn- eval-overlay-source [ctx src] (var s src) diff --git a/src/jolt/backend.janet b/src/jolt/backend.janet index d1d1961..fe797cb 100644 --- a/src/jolt/backend.janet +++ b/src/jolt/backend.janet @@ -230,6 +230,12 @@ (array/push args (emit ctx (in p 1)))) (tuple/slice args)) +# A set literal: build (make-phs e1 e2 …) so each element is evaluated at runtime +# then the persistent set is constructed — mirrors compiler.janet's emit-set-expr. +(defn- emit-set [ctx node] + (def items (map |(emit ctx $) (vview (node :items)))) + (tuple/slice (array/concat @[phm/make-phs] items))) + (set emit (fn emit [ctx raw] (def node (norm-node raw)) @@ -259,6 +265,7 @@ :invoke (emit-invoke ctx node) :vector (emit-vector ctx node) :map (emit-map ctx node) + :set (emit-set ctx node) :quote ['quote (node :form)] (error (string "backend: unhandled op " (node :op)))))) diff --git a/src/jolt/compiler.janet b/src/jolt/compiler.janet index d700472..abd27ca 100644 --- a/src/jolt/compiler.janet +++ b/src/jolt/compiler.janet @@ -163,7 +163,6 @@ "find-ns" "all-ns" "the-ns" "find-var" "intern" "resolve" "ns-resolve" "ns-aliases" "ns-imports" "ns-interns" "alter-var-root" "alter-meta!" "reset-meta!" "locking" "new" - "disj" "set?" # Definitional/host macros that mutate context or build runtime # values the emitter doesn't model. "defrecord" "defprotocol" "definterface" "reify" "proxy" diff --git a/src/jolt/core.janet b/src/jolt/core.janet index 4301997..821ebea 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -508,7 +508,10 @@ (if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f))) (in f k) (error (string "Index " k " out of bounds for vector of length " (length f))))) - (or (struct? f) (and (table? f) (get f :jolt/deftype))) + # Map literal (struct with no :jolt/type marker) or a record: callable as a + # key lookup. A TAGGED struct (char/etc.) is NOT a fn — symbols are handled + # above; everything else with a :jolt/type falls through to the error. + (or (and (struct? f) (nil? (get f :jolt/type))) (and (table? f) (get f :jolt/deftype))) (let [v (get f (get args 0) :jolt/not-found)] (if (= v :jolt/not-found) (get args 1) v)) (error (string "Cannot call " (type f) " as a function")))) @@ -804,9 +807,7 @@ (fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (if (truthy? (pred (a 1))) (rf (a 0) (a 1)) (a 0)))))) (defn td-remove [pred] (td-filter (fn [x] (not (pred x))))) -(defn td-keep [f] - (fn [rf] (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) - (let [v (f (a 1))] (if (nil? v) (a 0) (rf (a 0) v))))))) +# td-keep removed: keep (incl its transducer arity) lives in core/40-lazy.clj. (defn td-take [n] (fn [rf] (var left n) @@ -829,31 +830,11 @@ (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (do (when (and dropping (not (truthy? (pred (a 1))))) (set dropping false)) (if dropping (a 0) (rf (a 0) (a 1)))))))) -(defn td-map-indexed [f] - (fn [rf] - (var i -1) - (fn [& a] (case (length a) 0 (rf) 1 (rf (a 0)) (do (++ i) (rf (a 0) (f i (a 1)))))))) +# td-map-indexed removed: map-indexed (incl transducer arity) lives in core/40-lazy.clj. # Stateful windowing transducers. The 1-arg (completion) arity flushes a partial # trailing window before delegating to rf's completion; matches Clojure. -(defn td-partition-all [n] - (fn [rf] - (var buf @[]) - (fn [& a] - (case (length a) - 0 (rf) - 1 (let [result (if (= 0 (length buf)) (a 0) - (let [v (tuple/slice (tuple ;buf))] - (set buf @[]) - (core-unreduced (rf (a 0) v))))] - (rf result)) - (do - (array/push buf (a 1)) - (if (= n (length buf)) - (let [v (tuple/slice (tuple ;buf))] - (set buf @[]) - (rf (a 0) v)) - (a 0))))))) +# td-partition-all removed: partition-all (incl transducer arity) lives in core/40-lazy.clj. # partition-by's transducer arity lives with its (lazy) collection arity in the # overlay (10-seq tier), written in Clojure with volatiles. @@ -1113,6 +1094,9 @@ (error "Wrong number of args passed to: reduce")))) (defn core-take [n & rest] + # n is a count — reject non-numbers (e.g. a char/string) like Clojure, rather + # than letting Janet's >= silently compare mixed types. + (unless (number? n) (error (string "take: n must be a number, got " (type n)))) (if (= 0 (length rest)) (td-take n) (let [coll (in rest 0)] # Option A: lazy take (returns a seq, not a vector, even over a vector). @@ -1342,22 +1326,7 @@ (sort-by keyfn arr)) (tuple/slice (tuple ;arr)))))) -(defn core-distinct [coll] - # Option A: always lazy. seen-set is captured once and shared across the chain. - (let [seen @{}] - (defn dstep [c] - (fn [] - (var cur c) (var found false) (var result nil) - (while (and (not found) (not (seq-done? cur))) - (let [x (core-first cur)] - (set cur (core-rest cur)) - (when (nil? (seen x)) - (put seen x true) - (set found true) - (set result x)))) - (if found @[result (dstep cur)] nil))) - (make-lazy-seq (dstep (lazy-from coll))))) - +# distinct now lives in the Clojure lazy tier (core/40-lazy.clj). # group-by / frequencies now live in the Clojure collection tier # (core/20-coll.clj). @@ -1384,72 +1353,13 @@ nil))))) (make-lazy-seq (pstep (lazy-from coll))))) -(defn core-partition-by [f coll] - (def f (as-fn f)) - (var result @[]) - (var part @[]) - (var last-k nil) - (each x (realize-for-iteration coll) - (let [k (f x)] - (if (and last-k (deep= k last-k)) - (array/push part x) - (do - (if (> (length part) 0) (array/push result (tuple/slice (tuple ;part)))) - (set part @[x]) - (set last-k k))))) - (if (> (length part) 0) (array/push result (tuple/slice (tuple ;part)))) - result) +# partition-by now lives in the Clojure seq tier (core/10-seq.clj). -(defn core-partition-all [n & rest] - (if (= 0 (length rest)) (td-partition-all n) - (let [coll (in rest 0)] - # Option A: always lazy. - (defn pstep [c] - (fn [] - (if (seq-done? c) nil - (do - (var part @[]) (var cur c) (var i 0) - (while (and (< i n) (not (seq-done? cur))) - (array/push part (core-first cur)) - (set cur (core-rest cur)) - (++ i)) - @[(tuple/slice (tuple ;part)) (pstep cur)])))) - (make-lazy-seq (pstep (lazy-from coll)))))) +# partition-all now lives in the Clojure lazy tier (core/40-lazy.clj). -(defn core-keep-indexed [f coll] - (def f (as-fn f)) - # Option A: always lazy. - (defn kstep [c i] - (fn [] - (var cur c) (var idx i) (var found false) (var result nil) - (while (and (not found) (not (seq-done? cur))) - (let [v (f idx (core-first cur))] - (++ idx) - (set cur (core-rest cur)) - (when (not (nil? v)) - (set found true) - (set result v)))) - (if found @[result (kstep cur idx)] nil))) - (make-lazy-seq (kstep (lazy-from coll) 0))) - -(defn core-map-indexed [f & rest] - (if (= 0 (length rest)) (td-map-indexed f) - (let [coll (in rest 0)] - # Option A: always lazy. - (defn mstep [c i] - (fn [] - (if (seq-done? c) nil - @[(f i (core-first c)) (mstep (core-rest c) (+ i 1))]))) - (make-lazy-seq (mstep (lazy-from coll) 0))))) - -(defn core-cycle [coll] - (let [c (realize-for-iteration coll)] - (if (= 0 (length c)) - (make-lazy-seq (fn [] nil)) - (do - (defn cstep [i] (fn [] @[(in c (% i (length c))) (cstep (+ i 1))])) - (make-lazy-seq (cstep 0)))))) +# keep-indexed / map-indexed / cycle now live in the Clojure lazy tier +# (core/40-lazy.clj). # reduce-kv now lives in the Clojure collection tier (core/20-coll.clj). @@ -1495,30 +1405,9 @@ (+= i step)) (tuple/slice (tuple ;result)))))) -(defn core-repeat - "(repeat x) -> infinite lazy seq of x; (repeat n x) -> n copies of x." - [a & rest] - (if (= 0 (length rest)) - (do (defn rstep [] (fn [] @[a (rstep)])) (make-lazy-seq (rstep))) - (let [n a x (in rest 0)] - (var result @[]) (var i 0) - (while (< i n) (array/push result x) (++ i)) - result))) +# repeat / iterate now live in the Clojure lazy tier (core/40-lazy.clj). -(defn core-iterate [f x] - "Lazy infinite sequence x, (f x), (f (f x)), ..." - (defn istep [v] (fn [] @[v (istep (f v))])) - (make-lazy-seq (istep x))) - -(defn core-repeatedly - "(repeatedly f) -> infinite lazy seq of (f) calls; (repeatedly n f) -> n calls." - [a & rest] - (if (= 0 (length rest)) - (do (defn rstep [] (fn [] @[(a) (rstep)])) (make-lazy-seq (rstep))) - (let [n a f (in rest 0)] - (var result @[]) (var i 0) - (while (< i n) (array/push result (f)) (++ i)) - result))) +# repeatedly now lives in the Clojure lazy tier (core/40-lazy.clj). # ============================================================ # Higher-order functions @@ -2408,26 +2297,7 @@ @[(core-first c) (istep (core-rest c) true)])))) (make-lazy-seq (istep (lazy-from coll) false))))) -(defn core-keep - "(keep f coll) — (f x) for each x, dropping nils. (keep f) is a transducer." - [f & rest] - (def f (as-fn f)) - (if (= 0 (length rest)) - (td-keep f) - (let [coll (in rest 0)] - # Option A: always lazy. - (defn kstep [c] - (fn [] - (var cur c) (var found false) (var result nil) - (while (and (not found) (not (seq-done? cur))) - (let [v (f (core-first cur))] - (set cur (core-rest cur)) - (when (not (nil? v)) - (set found true) - (set result v)))) - (if found @[result (kstep cur)] nil))) - (make-lazy-seq (kstep (lazy-from coll)))))) - +# keep now lives in the Clojure lazy tier (core/40-lazy.clj). (defn core-empty [coll] (cond @@ -2517,14 +2387,7 @@ # Iterator/enumeration seqs — Jolt has no Java iterators, so adapt to plain seq. (defn core-enumeration-seq [x] (core-seq x)) (defn core-iterator-seq [x] (core-seq x)) -(defn core-xml-seq [root] - (def out @[]) - (defn walk [n] - (array/push out n) - (when (and (core-map? n) (core-contains? n :content)) - (each c (realize-for-iteration (core-get n :content)) (walk c)))) - (walk root) - (tuple ;out)) +# xml-seq now lives in the Clojure collection tier (core/20-coll.clj). (defn core-line-seq [rdr] (if (string? rdr) (core-seq (string/split "\n" rdr)) nil)) (defn core-re-matcher [re s] @{:jolt/type :jolt/matcher :re re :s s :pos 0}) @@ -2866,10 +2729,6 @@ "get-in" core-get-in "contains?" core-contains? "count" core-count - "partition-all" core-partition-all - "keep-indexed" core-keep-indexed - "map-indexed" core-map-indexed - "cycle" core-cycle "pop" core-pop "trampoline" core-trampoline "format" core-format @@ -2952,7 +2811,6 @@ "random-uuid" core-random-uuid "interpose" core-interpose "mapcat" core-mapcat - "keep" core-keep "find" core-find "transduce" core-transduce "sequence" core-sequence @@ -2990,13 +2848,8 @@ "nth" core-nth "sort" core-sort "sort-by" core-sort-by - "distinct" core-distinct "partition" core-partition - "partition-by" core-partition-by "range" core-range - "repeat" core-repeat - "iterate" core-iterate - "repeatedly" core-repeatedly "identity" core-identity "constantly" core-constantly "complement" core-complement @@ -3103,7 +2956,6 @@ "test" core-test "enumeration-seq" core-enumeration-seq "iterator-seq" core-iterator-seq - "xml-seq" core-xml-seq "line-seq" core-line-seq "re-matcher" core-re-matcher "bean" core-bean diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index 4c8bcc9..32ce62c 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -26,7 +26,6 @@ (= name "var-get") (= name "var-set") (= name "var?") (= name "alter-var-root") (= name "find-var") (= name "intern") (= name "alter-meta!") (= name "reset-meta!") - (= name "disj") (= name "set?") (= name "satisfies?") (= name "protocol-dispatch") (= name "register-method") (= name "make-reified") (= name "prefer-method") (= name "remove-method") (= name "remove-all-methods") @@ -116,7 +115,9 @@ (if (and (number? k) (= k (math/floor k)) (>= k 0) (< k (length f))) (in f k) (error (string "Index " k " out of bounds for vector of length " (length f))))) - (struct? f) + # Map literal only (struct with no :jolt/type). A tagged struct (char/etc.) + # is not callable — symbols are handled above; chars fall through to the error. + (and (struct? f) (nil? (get f :jolt/type))) (let [v (get f (get args 0) :jolt/not-found)] (if (= v :jolt/not-found) (get args 1) v)) (and (table? f) (get f :jolt/deftype)) @@ -1140,12 +1141,8 @@ val (eval-form ctx bindings (in form 3)) ns (ctx-find-ns ctx (if (struct? ns-name) (ns-name :name) ns-name))] (ns-intern ns (if (struct? sym-name) (sym-name :name) sym-name) val)) - "disj" (let [s (eval-form ctx bindings (in form 1)) - ks (map |(eval-form ctx bindings $) (tuple/slice form 2))] - (if (set? s) - (apply phs-disj s ks) - (error "disj expects a set"))) - "set?" (set? (eval-form ctx bindings (in form 1))) + # set?/disj are plain clojure.core fns now (core-set?/core-disj) — no longer + # special-cased here, the analyzer, or compiler.janet (jolt-g3h). "protocol-dispatch" (let [proto-sym (in form 1) method-sym (in form 2) obj (eval-form ctx bindings (in form 3)) diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index ff1b37e..d2dbd9e 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -74,7 +74,7 @@ "defmacro" "fn*" "let*" "loop*" "recur" "throw" "try" "set!" "var" "locking" "eval" "instance?" "defmulti" "defmethod" "deftype" "new" "." "var-get" "var-set" "var?" "alter-var-root" "find-var" "intern" - "alter-meta!" "reset-meta!" "disj" "set?" "satisfies?" + "alter-meta!" "reset-meta!" "satisfies?" "protocol-dispatch" "register-method" "make-reified" "prefer-method" "remove-method" "remove-all-methods" "get-method" "methods" # ns-management forms dispatched by the interpreter (not core vars) diff --git a/test/integration/clojure-test-suite-test.janet b/test/integration/clojure-test-suite-test.janet index 07bf4ba..e7586d1 100644 --- a/test/integration/clojure-test-suite-test.janet +++ b/test/integration/clojure-test-suite-test.janet @@ -38,9 +38,14 @@ # lazy-from throws on non-seqable like Clojure) recovered + extended the suite. # clean files 45 -> 66 (Option A makes seq?/vector? results match Clojure across # many cross-dialect files). Stable across runs. -(def baseline-pass 3981) +# Raised 3981 -> 4004 migrating 7 lazy seq fns to the Clojure overlay (40-lazy +# tier): the canonical CLJ versions add coverage (e.g. distinct value-equality). +# Raised 4004 -> 4034 / clean 66 -> 67 porting partition-all + repeatedly to the +# overlay, which required fixing two leniencies (a char is not callable; take +# validates its count) — correct beyond those fns, so the suite rose broadly. +(def baseline-pass 4034) # A file is "clean" when it ran with zero failures AND zero errors. -(def baseline-clean-files 66) +(def baseline-clean-files 67) # Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so # this normally only fires on genuinely-infinite-sequence hangs. It's an env var # (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can diff --git a/test/integration/conformance-test.janet b/test/integration/conformance-test.janet index 81fa206..f400793 100644 --- a/test/integration/conformance-test.janet +++ b/test/integration/conformance-test.janet @@ -50,6 +50,18 @@ ["map as fn default" "99" "({:a 1} :z 99)"] ["set as fn" "2" "(#{1 2 3} 2)"] ["set as fn miss" "nil" "(#{1 2 3} 9)"] + # set literals compile (Stage 1 Task 1): computed elements are each evaluated + # then the persistent set is built, matching the interpreter. + ["set literal computed" "true" "(= #{1 2} #{(inc 0) 2})"] + ["empty set literal" "true" "(empty? #{})"] + ["set literal count" "3" "(count #{1 2 3})"] + ["set literal in let" "true" "(let [x 5] (= #{5 6} #{x (inc x)}))"] + # set?/disj compile as plain fns now (jolt-g3h), not special forms + ["set? true" "true" "(set? #{1 2 3})"] + ["set? false" "false" "(set? [1 2])"] + ["disj one" "#{1 3}" "(disj #{1 2 3} 2)"] + ["disj many" "#{1}" "(disj #{1 2 3} 2 3)"] + ["disj absent" "#{1 2}" "(disj #{1 2} 5)"] ["keyword as fn" "1" "(:a {:a 1})"] ["map fn over coll" "(quote (1 3))" "(map {:a 1 :b 3} [:a :b])"] diff --git a/test/integration/fallback-zero-test.janet b/test/integration/fallback-zero-test.janet new file mode 100644 index 0000000..c5bcc50 --- /dev/null +++ b/test/integration/fallback-zero-test.janet @@ -0,0 +1,66 @@ +# 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)) + +(defn- analyzes? [s] + # true if the analyzer produced IR (compiled), false if it punted/uncompilable. + (def r (protect (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)"]) + +# --- Intentional fallback (sanity sample): these SHOULD punt to the interpreter. +# Not the frozen set (that's Task 2) — just a few to confirm the boundary holds +# in the punt direction so the harness can't pass by compiling everything. +(def must-punt + ["(ns foo.bar)" "(defmacro m [x] x)" "(require (quote [clojure.string]))" + "(set! *warn-on-reflection* true)" "(letfn [(f [n] (g n)) (g [n] (f n))] (f 1))"]) + +(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)")