diff --git a/jolt-core/jolt/backend_scheme.clj b/jolt-core/jolt/backend_scheme.clj new file mode 100644 index 0000000..2ea1083 --- /dev/null +++ b/jolt-core/jolt/backend_scheme.clj @@ -0,0 +1,322 @@ +(ns jolt.backend-scheme + "Portable Clojure IR -> Chez Scheme emitter (Chez Phase 3, jolt-cf1q.4). + + The no-Janet replacement for host/chez/emit.janet: consumes the same + host-neutral IR (jolt.ir, see jolt-core/jolt/ir.clj) the analyzer produces and + emits Chez Scheme source TEXT. Pure jolt-core (clojure.core + clojure.string + only) so that, once cross-compiled, it runs ON Chez and the analyzer can emit + its own code with no Janet in the loop — the bootstrap spine. + + Output is a STRING of Scheme source; `host/compile` on Chez is `(eval (read + ...))`. Mirrors emit.janet op-for-op so the value-parity gate holds against the + Janet emitter while the port is in flight. + + INCREMENT 1 (jolt-hg7z): const/local/var/the-var/if/do/let/loop/recur/invoke + (+ native-ops)/fn/def + the escaping/flonum/munge helpers — enough to compile + fib/mandelbrot-shaped code end to end. Quote, collection literals, try/throw, + host interop, regex/inst/uuid and program assembly land in later increments + (they throw `:not-yet-ported` here so an accidental hit is loud)." + (:require [clojure.string :as str])) + +;; Hot clojure.core primitives lowered to native Scheme, mirroring the Janet +;; backend's native-ops. `=` is the exactness-aware jolt= from values.ss; inc/dec/ +;; not are rt shims; mod/rem/quot map to Scheme's (Scheme has all three). +(def ^:private native-ops + {"+" "+" "-" "-" "*" "*" "/" "/" + "<" "<" ">" ">" "<=" "<=" ">=" ">=" + "=" "jolt=" "inc" "jolt-inc" "dec" "jolt-dec" "not" "jolt-not" + "min" "min" "max" "max" + "mod" "modulo" "rem" "remainder" "quot" "quotient" + "vector" "jolt-vector" "hash-map" "jolt-hash-map" "hash-set" "jolt-hash-set" + "conj" "jolt-conj" "get" "jolt-get" "nth" "jolt-nth" "count" "jolt-count" + "assoc" "jolt-assoc" "dissoc" "jolt-dissoc" "contains?" "jolt-contains?" + "empty?" "jolt-empty?" "peek" "jolt-peek" "pop" "jolt-pop" + "first" "jolt-first" "rest" "jolt-rest" "next" "jolt-next" "seq" "jolt-seq" + "cons" "jolt-cons" "list" "jolt-list" "reverse" "jolt-reverse" "last" "jolt-last" + "map" "jolt-map" "filter" "jolt-filter" "remove" "jolt-remove" + "reduce" "jolt-reduce" "into" "jolt-into" "concat" "jolt-concat" "apply" "jolt-apply" + "range" "jolt-range" "take" "jolt-take" "drop" "jolt-drop" + "keys" "jolt-keys" "vals" "jolt-vals" + "even?" "jolt-even?" "odd?" "jolt-odd?" "pos?" "jolt-pos?" "neg?" "jolt-neg?" + "zero?" "jolt-zero?" "identity" "jolt-identity" + "ex-info" "jolt-ex-info"}) + +;; Value-position resolution for a clojure.core ref passed AS A VALUE (to map / +;; filter / reduce / apply). Arithmetic is the exception — Scheme's +/-/*// return +;; EXACT results for exact/zero-arg inputs, breaking the all-double model in +;; higher-order use, so value-position arithmetic routes to the flonum wrappers. +(def ^:private core-value-procs + (merge native-ops {"+" "jolt-add" "-" "jolt-sub" "*" "jolt-mul" "/" "jolt-div"})) + +;; Per-op arity gate: only lower when the Scheme prim and the jolt fn agree at +;; this arity. Ops absent from the table are variadic (legal at any arity). +(def ^:private op-arity + {"inc" #(= % 1) "dec" #(= % 1) "not" #(= % 1) + "count" #(= % 1) "empty?" #(= % 1) "peek" #(= % 1) "pop" #(= % 1) + "mod" #(= % 2) "rem" #(= % 2) "quot" #(= % 2) "contains?" #(= % 2) + "get" #(or (= % 2) (= % 3)) "nth" #(or (= % 2) (= % 3)) + "assoc" #(and (>= % 3) (odd? %)) "dissoc" #(>= % 1) "conj" #(>= % 1) + "first" #(= % 1) "rest" #(= % 1) "next" #(= % 1) "seq" #(= % 1) + "reverse" #(= % 1) "last" #(= % 1) "keys" #(= % 1) "vals" #(= % 1) + "even?" #(= % 1) "odd?" #(= % 1) "pos?" #(= % 1) "neg?" #(= % 1) + "zero?" #(= % 1) "identity" #(= % 1) + "cons" #(= % 2) "filter" #(= % 2) "remove" #(= % 2) "into" #(= % 2) + "take" #(= % 2) "drop" #(= % 2) "map" #(>= % 2) "apply" #(>= % 2) + "reduce" #(or (= % 2) (= % 3)) "range" #(and (>= % 0) (<= % 3)) + "ex-info" #(or (= % 2) (= % 3))}) + +;; jolt's comparison ops are vacuously true at arity 1 and DON'T inspect the arg, +;; but Scheme's < demands a number even there — special-case. +(def ^:private cmp1-ops #{"<" ">" "<=" ">="}) + +;; Native-op Scheme procedures that return a genuine Scheme boolean (#t/#f), so an +;; :if test built from them needs no jolt-truthy? wrapper (jolt-nkcb). +(def ^:private bool-returning-ops + #{"<" "<=" ">" ">=" "jolt=" "jolt-not" + "jolt-even?" "jolt-odd?" "jolt-pos?" "jolt-neg?" + "jolt-zero?" "jolt-empty?" "jolt-contains?"}) + +;; PRELUDE MODE (inc 3d). The default (subset) mode rejects any clojure.core ref +;; that isn't a native-op — a clean "out of subset" signal for user-facing `-e`. +;; When emitting clojure.core ITSELF as a prelude, core fns reference each other +;; constantly; those lower to var-deref (resolved at runtime). +(def prelude-mode? (atom false)) +(defn set-prelude-mode! [on] (reset! prelude-mode? on)) + +;; recur-target and the set of munged local names known to hold a procedure (a +;; named fn's self-recursion name) are lexically scoped — dynamic vars so the +;; recursion auto-restores them (no manual save/restore, no throw-leak). +(def ^:dynamic *recur-target* nil) +(def ^:dynamic *known-procs* #{}) + +(def ^:private gensym-counter (atom 0)) +(defn- fresh-label [prefix] (str prefix (swap! gensym-counter inc))) + +;; Most jolt names are already valid Scheme identifiers. The one that isn't is +;; `#`, which jolt auto-gensyms use as a suffix (p1__0000X4# from #(...)) — `#` +;; starts a datum in Scheme, so replace it with `_`. +(defn- munge-name [s] (str/replace s "#" "_")) + +(declare emit) + +;; A Chez string literal (jolt-x0os). Every char outside printable ASCII becomes a +;; codepoint hex escape \x; ; the named escapes (\n \t \r \" \\) match what +;; Chez's reader accepts. For pure printable ASCII this is byte-identical to %j. +(defn- char-escape [cp] + (cond + (= cp 34) "\\\"" + (= cp 92) "\\\\" + (= cp 10) "\\n" + (= cp 9) "\\t" + (= cp 13) "\\r" + (and (>= cp 32) (< cp 127)) (str (char cp)) + :else (str "\\x" (format "%x" cp) ";"))) + +(defn- chez-str-lit [s] + (str "\"" (apply str (map (fn [c] (char-escape (int c))) s)) "\"")) + +(defn- emit-const [v] + (cond + (nil? v) "jolt-nil" + (boolean? v) (if v "#t" "#f") + ;; jolt models every number as a double. Emit flonums so arithmetic matches + ;; the Janet host and Chez doesn't fall into exploding exact rationals. + ;; ##Inf/##-Inf/##NaN -> Chez's flonum literals (Janet stringifies them as + ;; inf/-inf/nan, unbound symbols in Chez). + (number? v) (cond + (= v ##Inf) "+inf.0" + (= v ##-Inf) "-inf.0" + (not= v v) "+nan.0" + :else (let [s (str v)] + (if (or (str/includes? s ".") (str/includes? s "e")) s (str s ".0")))) + (string? v) (chez-str-lit v) + ;; keyword literal -> (keyword ns name) + (keyword? v) (if-let [kns (namespace v)] + (str "(keyword " (chez-str-lit kns) " " (chez-str-lit (name v)) ")") + (str "(keyword #f " (chez-str-lit (name v)) ")")) + ;; jolt char value {:ch :jolt/type :jolt/char} + (and (map? v) (= :jolt/char (:jolt/type v))) + (str "(integer->char " (:ch v) ")") + :else (throw (ex-info (str "emit-const: unsupported literal " (pr-str v)) {})))) + +;; A def's :meta is a jolt map value. Non-empty? (a plain def carries {}). +(defn- jmeta-nonempty? [m] (and (map? m) (pos? (count m)))) + +(defn- emit-binding [b] + (str "(" (munge-name (nth b 0)) " " (emit (nth b 1)) ")")) + +;; letfn lowers to a :let flagged :letrec (mutually-recursive named local fns): +;; Scheme `letrec*` binds them so each sees its siblings. A plain let uses let*. +(defn- emit-let [node] + (let [kw (if (:letrec node) "letrec*" "let*")] + (str "(" kw " (" (str/join " " (map emit-binding (:bindings node))) ") " + (emit (:body node)) ")"))) + +(defn- emit-loop [node] + (let [label (fresh-label "loop") + pairs (:bindings node) + names (map #(munge-name (nth % 0)) pairs) + ;; inits evaluate in the OUTER scope (recur-target unchanged) and, like + ;; Clojure loop/let, SEQUENTIALLY — wrap a let* around the named let. + inits (map #(emit (nth % 1)) pairs) + seq-bs (str/join " " (map (fn [n i] (str "(" n " " i ")")) names inits)) + rebinds (str/join " " (map (fn [n] (str "(" n " " n ")")) names)) + body (binding [*recur-target* label] (emit (:body node)))] + (str "(let* (" seq-bs ") (let " label " (" rebinds ") " body "))"))) + +(defn- emit-recur [node] + (when-not *recur-target* (throw (ex-info "emit: recur outside a loop/fn target" {}))) + (str "(" *recur-target* " " (str/join " " (map emit (:args node))) ")")) + +;; One arity -> a Scheme lambda param-list + a named-let-wrapped body. The named +;; let lets fn-level `recur` rebind this arity's params. A variadic arity takes a +;; Scheme rest arg coerced to a jolt seq (nil when empty); recur carries the rest +;; seq directly, and the named let's init only runs on first entry. +(defn- emit-arity-clause [a] + (let [params (map munge-name (:params a)) + restp (when-let [r (:rest a)] (munge-name r)) + label (fresh-label "fnrec") + body (binding [*recur-target* label] (emit (:body a))) + paramlist (cond + (and restp (empty? params)) restp + restp (str "(" (str/join " " params) " . " restp ")") + :else (str "(" (str/join " " params) ")")) + binds (if restp + (concat (map (fn [p] (str "(" p " " p ")")) params) + [(str "(" restp " (list->cseq " restp "))")]) + (map (fn [p] (str "(" p " " p ")")) params))] + [paramlist (str "(let " label " (" (str/join " " binds) ") " body ")")])) + +(defn- emit-fn [node] + (let [arities (:arities node) + ;; a named fn binds its own name as a known-procedure local across ALL + ;; arities, so self-calls emit directly rather than via jolt-invoke. + self (when-let [nm (:name node)] (munge-name nm)) + clauses (binding [*known-procs* (if self (conj *known-procs* self) *known-procs*)] + (mapv emit-arity-clause arities)) + lambda (if (= 1 (count clauses)) + (let [c (first clauses)] (str "(lambda " (nth c 0) " " (nth c 1) ")")) + (str "(case-lambda " + (str/join " " (map (fn [c] (str "(" (nth c 0) " " (nth c 1) ")")) clauses)) + ")"))] + ;; A named fn references itself by name — the analyzer binds that name as a + ;; :local in the body. letrec makes the name visible to the lambda. + (if-let [nm (:name node)] + (let [m (munge-name nm)] (str "(letrec ((" m " " lambda ")) " m ")")) + lambda))) + +;; If fnode is a clojure.core (or host) ref to a native-op primitive, return the +;; Scheme op string — only at an arity where the Scheme op and the jolt fn agree. +(defn- native-op [fnode nargs] + (let [nm (case (:op fnode) + :var (when (= "clojure.core" (:ns fnode)) (:name fnode)) + :host (:name fnode) + nil) + op (when nm (native-ops nm)) + arity-ok (when nm (op-arity nm))] + (cond + (nil? op) nil + (and arity-ok (not (arity-ok nargs))) nil + :else op))) + +;; IFn dispatch for a LITERAL callee (Clojure's "value as fn"): a keyword looks +;; itself up in its arg; a map/set/vector literal looks up its arg. +(defn- ifn-kind [fnode] + (case (:op fnode) + :const (when (keyword? (:val fnode)) :keyword) + (:map :set :vector) :coll + nil)) + +;; A reference into the Clojure stdlib (clojure.*) with no impl on Chez yet. +(defn- stdlib-var? [n] + (and (= :var (:op n)) (str/starts-with? (or (:ns n) "") "clojure."))) + +(defn- emit-invoke [node] + (let [fnode (:fn node) + args (mapv emit (:args node)) + nop (native-op fnode (count args)) + kind (ifn-kind fnode) + default (if (> (count args) 1) (str " " (nth args 1)) "")] + (cond + ;; zero-arg + / * : flonum identity to keep the all-double model. + (and nop (empty? args) (= nop "+")) "0.0" + (and nop (empty? args) (= nop "*")) "1.0" + (and nop (= 1 (count args)) (cmp1-ops nop)) (str "(begin " (first args) " #t)") + nop (str "(" nop " " (str/join " " args) ")") + ;; (:k coll [default]) -> (jolt-get coll :k [default]) + (= kind :keyword) (str "(jolt-get " (first args) " " (emit fnode) default ")") + ;; (coll k [default]) -> (jolt-get coll k [default]) + (= kind :coll) (str "(jolt-get " (emit fnode) " " (first args) default ")") + (and (stdlib-var? fnode) (not (deref prelude-mode?))) + (throw (ex-info (str "emit: unsupported stdlib fn `" (:ns fnode) "/" (:name fnode) + "` (no core on Chez yet)") {})) + ;; static method call (Class/method arg*) -> (host-static-call ...). + (= :host-static (:op fnode)) + (str "(host-static-call " (chez-str-lit (:class fnode)) " " (chez-str-lit (:member fnode)) + (if (empty? args) "" (str " " (str/join " " args))) ")") + (= :host (:op fnode)) + (throw (ex-info (str "emit: unsupported host call `" (:name fnode) "`") {})) + ;; a :local callee that isn't a known procedure -> dynamic IFn dispatch. + (and (= :local (:op fnode)) (not (*known-procs* (munge-name (:name fnode))))) + (str "(jolt-invoke " (emit fnode) " " (str/join " " args) ")") + ;; a late-bound :var call head can hold a procedure OR a non-applicable + ;; value the RT dispatches (multimethod, keyword/coll IFn) — route via + ;; jolt-invoke (transparent for a procedure). + (= :var (:op fnode)) + (str "(jolt-invoke " (emit fnode) " " (str/join " " args) ")") + ;; a computed callee can yield ANY IFn — route through jolt-invoke. + :else + (str "(jolt-invoke " (emit fnode) " " (str/join " " args) ")")))) + +;; Does this IR node emit to an expression that yields a Scheme boolean? Used to +;; drop the redundant jolt-truthy? on an :if test. +(defn- returns-scheme-bool? [node] + (cond + (and (= :const (:op node)) (boolean? (:val node))) true + (= :invoke (:op node)) + (let [nop (native-op (:fn node) (count (:args node)))] + (if (and nop (bool-returning-ops nop)) true false)) + :else false)) + +(defn emit [node] + (case (:op node) + :const (emit-const (:val node)) + :local (munge-name (:name node)) + ;; late-bound var: read the cell's current root at use time. A value-position + ;; ref to a clojure.core fn the RT provides lowers to the RT procedure. + :var (let [core-proc (and (= "clojure.core" (:ns node)) (core-value-procs (:name node)))] + (cond + core-proc core-proc + (and (stdlib-var? node) (not (deref prelude-mode?))) + (throw (ex-info (str "emit: unsupported stdlib ref `" (:ns node) "/" (:name node) + "` (no core on Chez yet)") {})) + :else (str "(var-deref " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")"))) + :the-var (str "(jolt-var " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")") + :host (throw (ex-info (str "emit: unsupported host ref `" (:name node) "`") {})) + :host-static (str "(host-static-ref " (chez-str-lit (:class node)) " " + (chez-str-lit (:member node)) ")") + :host-new (str "(host-new " (chez-str-lit (:class node)) + (let [args (map emit (:args node))] + (if (empty? args) "" (str " " (str/join " " args)))) ")") + :if (let [test (:test node) + t (if (returns-scheme-bool? test) (emit test) + (str "(jolt-truthy? " (emit test) ")"))] + (str "(if " t " " (emit (:then node)) " " (emit (:else node)) ")")) + :do (str "(begin " (str/join " " (map emit (:statements node))) + (if (empty? (:statements node)) "" " ") (emit (:ret node)) ")") + :invoke (emit-invoke node) + :let (emit-let node) + :loop (emit-loop node) + :recur (emit-recur node) + :fn (emit-fn node) + ;; (def name) with no init (declare): reserve the cell. A def with non-empty + ;; reader metadata lowers to def-var-with-meta! (ported in a later increment). + :def (cond + (:no-init node) + (str "(declare-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")") + (jmeta-nonempty? (:meta node)) + (throw (ex-info "emit: def with non-empty meta not yet ported (inc 2)" {})) + :else + (str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " " + (emit (:init node)) ")")) + (throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op node))) {})))) diff --git a/test/chez/emit-parity.janet b/test/chez/emit-parity.janet new file mode 100644 index 0000000..ed037d8 --- /dev/null +++ b/test/chez/emit-parity.janet @@ -0,0 +1,138 @@ +# Chez Phase 3 inc 1 (jolt-hg7z) — value-parity gate for the PORTABLE Clojure +# emitter (jolt.backend-scheme) vs the Janet host oracle. +# +# The new emitter is jolt-core Clojure; here it runs interpreted ON THE JANET HOST +# (loaded via bootstrap-load-source) as a drop-in for host/chez/emit.janet. Each +# case is analyzed to IR, emitted to Scheme by the CLOJURE emitter, run on Chez, +# and compared to the same program evaluated by the Janet host (jolt's own oracle). +# This isolates "is the translation correct" from "does it run on Chez" — the +# emitter's logic is validated before it has to execute on Chez itself. +# +# janet test/chez/emit-parity.janet (from repo root) +(import ../../src/jolt/api :as api) +(import ../../src/jolt/backend :as backend) +(import ../../src/jolt/reader :as r) +(import ../../src/jolt/evaluator :as evlr) +(import ../../host/chez/driver :as d) +(import ../../host/chez/emit :as emit) +(import ../../src/jolt/types_ctx :as tctx) +(import ../../src/jolt/types_ns :as tns) +(import ../../src/jolt/types_var :as tvar) + +(unless (d/chez-available?) + (print "skip: chez not on PATH") + (os/exit 0)) + +(var total 0) (var fails 0) +(defn ok [name pred &opt extra] + (++ total) + (if pred (printf "ok: %s" name) + (do (++ fails) (printf "FAIL: %s %s" name (or extra ""))))) + +# ctx with the analyzer pipeline + late-bind (same as the driver), plus the +# Clojure emitter loaded interpreted so we can call jolt.backend-scheme/emit. +(def ctx (d/make-ctx)) +(def bs-src (get (get (ctx :env) :embedded-sources) "jolt.backend-scheme")) +(assert bs-src "jolt.backend-scheme not embedded — check stdlib_embed collect") +(backend/bootstrap-load-source ctx "jolt.backend-scheme" bs-src) +(def emit-clj-var (tns/ns-find (tctx/ctx-find-ns ctx "jolt.backend-scheme") "emit")) +(assert emit-clj-var "jolt.backend-scheme/emit not found after load") +(defn emit-clj [ir] (string ((tvar/var-get emit-clj-var) ir))) + +# Janet host oracle, via the real CLI (-e), exactly like run-corpus.janet: take the +# last non-empty stdout line so collection values use jolt's real printer. +(defn cli-oracle [src] + (def proc (os/spawn ["build/jolt" "-e" src] :p {:out :pipe :err :pipe})) + (def out (ev/read (proc :out) 0x100000)) + (ev/read (proc :err) 0x100000) + (os/proc-wait proc) + (def lines (filter (fn [l] (not (empty? l))) (string/split "\n" (string/trim (if out (string out) ""))))) + (if (empty? lines) "" (last lines))) + +(defn- parse-all [src] + (def out @[]) + (var s src) + (while (> (length (string/trim s)) 0) + (def parsed (r/parse-next s)) + (set s (in parsed 1)) + (def f (in parsed 0)) + (unless (nil? f) (array/push out f))) + out) + +# Drain a pipe to EOF (a stdout side effect can flush in >1 write). +(defn- drain [pipe] + (def b @"") + (var c (ev/read pipe 0x10000)) + (while c (buffer/push b c) (set c (ev/read pipe 0x10000))) + (string b)) + +# Compile `src` to a Chez program using the CLOJURE emitter, run it, return +# [code stdout stderr]. Mirrors driver/compile-program + run-on-chez but swaps +# emit/emit -> emit-clj. +(defn run-clj [src] + (def forms (parse-all src)) + (def n (length forms)) + (def def-scm @[]) + (for i 0 (- n 1) + (def f (in forms i)) + (array/push def-scm (emit-clj (backend/analyze-form ctx f))) + (evlr/eval-form ctx @{} f)) + (def final-scm (emit-clj (backend/analyze-form ctx (in forms (- n 1))))) + (def prog (emit/program def-scm final-scm)) + (def path (string "/tmp/jolt-chez-parity-" (os/getpid) ".ss")) + (spit path prog) + (def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe})) + (def out (drain (proc :out))) + (def err (drain (proc :err))) + (def code (os/proc-wait proc)) + [code (string/trim out) (string/trim err)]) + +# A case passes when the Clojure emitter's Chez output equals the Janet oracle. +(defn check [name src] + (def want (cli-oracle src)) + (def [code out err] (run-clj src)) + (ok name (and (= code 0) (= out want)) + (string "chez=" out " oracle=" want " code=" code " | " err))) + +# --- inc 1 subset: const/local/var/if/do/let/loop/recur/invoke/fn/def ---------- + +(check "(+ 1 2)" "(+ 1 2)") +(check "arith mixed" "(- (* 3 4) (/ 10 2))") +(check "nested let" "(let [a 1 b (+ a 10) c (* b 2)] (- c a))") +(check "let sequential" "(loop [a 1 b (+ a 10)] (+ a b))") +(check "if comparison" "(if (< 3 5) 100 200)") +(check "if =" "(if (= 2 2) :y :n)") +(check "do side-effect ret" "(do 1 2 3)") +(check "fib 30" "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 30)") +(check "factorial loop" "(defn fact [n] (loop [i n acc 1] (if (< i 2) acc (recur (- i 1) (* acc i))))) (fact 10)") +(check "multi-arity" "(defn g ([x] (g x 10)) ([x y] (+ x y))) (g 5)") +(check "variadic" "(defn s [& xs] (reduce + 0 xs)) (s 1 2 3 4)") +(check "higher-order inc" "(reduce + 0 (map inc (range 5)))") +(check "anon fn invoke" "((fn [x] (* x x)) 7)") +(check "shorthand fn" "(#(+ %1 %2) 3 4)") +(check "truthy local" "(defn t [x] (if x 1 2)) (t false)") +(check "mod rem quot" "(+ (mod 17 5) (rem 17 5) (quot 17 5))") +(check "min max" "(+ (min 3 1 2) (max 3 1 2))") +(check "mandelbrot run(20)" + (string `` +(defn count-point [cr ci cap] + (loop [i 0 zr 0.0 zi 0.0] + (if (or (>= i cap) (> (+ (* zr zr) (* zi zi)) 4.0)) + i + (recur (inc i) (+ (- (* zr zr) (* zi zi)) cr) (+ (* 2.0 (* zr zi)) ci))))) +(defn run [n] + (let [cap 200 nd (* 1.0 n)] + (loop [y 0 acc 0] + (if (< y n) + (let [ci (- (/ (* 2.0 y) nd) 1.0) + row (loop [x 0 a 0] + (if (< x n) + (let [cr (- (/ (* 2.0 x) nd) 1.5)] + (recur (inc x) (+ a (count-point cr ci cap)))) + a))] + (recur (inc y) (+ acc row))) + acc)))) +`` "\n(run 20)")) + +(printf "\n%d/%d ok" (- total fails) total) +(when (> fails 0) (os/exit 1))