diff --git a/host/chez/collections.ss b/host/chez/collections.ss index 14ddfbf..dfe61f3 100644 --- a/host/chez/collections.ss +++ b/host/chez/collections.ss @@ -192,6 +192,9 @@ (define (jolt-conj1 coll x) (cond ((pvec? coll) (pvec-conj coll x)) ; nil is a valid vector/set element ((pset? coll) (pset-conj coll x)) + ;; a list/seq conjs by PREPENDING (seq.ss: cseq / empty-list) + ((cseq? coll) (cseq-realized x coll)) + ((empty-list-t? coll) (cseq-realized x jolt-nil)) ((pmap? coll) (cond ((jolt-nil? x) coll) ; (conj m nil) = m ((pmap? x) (pmap-fold x (lambda (k v m) (pmap-assoc m k v)) coll)) ; merge @@ -199,11 +202,10 @@ (pmap-assoc coll (pvec-nth-d x 0 jolt-nil) (pvec-nth-d x 1 jolt-nil))) (else (error 'conj "conj on a map expects a [k v] pair or a map")))) (else (error 'conj "unsupported collection")))) -;; (conj nil a b ...) builds a list in Clojure, conj prepending -> (b a). We have -;; no list type until inc 3b; a reversed pvec is = to that list (sequential =). +;; (conj nil a b ...) builds a list in Clojure, conj prepending -> (b a). (define (jolt-conj coll . xs) (if (jolt-nil? coll) - (make-pvec (list->vector (reverse xs))) + (fold-left jolt-conj1 jolt-empty-list xs) (fold-left jolt-conj1 coll xs))) (define jolt-get @@ -225,11 +227,13 @@ (if (and (fx>=? i 0) (fxidx i))) (cond ((pvec? coll) (pvec-nth-d coll i d)) ((string? coll) (if (and (fx>=? i 0) (fx rt prims in seq.ss + "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"}) + +# Value-position resolution for a clojure.core ref passed AS A VALUE (to map / +# filter / reduce / apply). Each native-op already names a usable Scheme +# procedure; 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-coercing rt wrappers. +(def- 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 (arith/compare/=, the @@ -44,7 +61,15 @@ "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)}) + "assoc" |(and (>= $ 3) (odd? $)) "dissoc" |(>= $ 1) "conj" |(>= $ 1) + # seq tier arities the shims support + "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))}) # 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. @@ -61,6 +86,10 @@ op)) (var- recur-target nil) +# Munged local names known to hold a procedure (a named fn's self-recursion name). +# Calls to these stay DIRECT; any other :local callee routes through jolt-invoke +# (dynamic IFn dispatch) — keeps the fib self-call off the invoke fallback. +(def- known-procs @{}) (var- gensym-n 0) (defn- fresh-label [prefix] (string prefix (++ gensym-n))) @@ -133,7 +162,13 @@ (def label (fresh-label "fnrec")) (def prev recur-target) (set recur-target label) + # a named fn binds its own name as a known-procedure local in the body, so + # self-calls emit directly rather than via the jolt-invoke fallback. + (def self (when-let [nm (get node :name)] (munge nm))) + (def had-self (and self (get known-procs self))) + (when self (put known-procs self true)) (def body (emit (get a :body))) + (unless had-self (when self (put known-procs self nil))) (set recur-target prev) (def lambda (string "(lambda (" (string/join params " ") ") " @@ -161,8 +196,9 @@ # IFn dispatch for a LITERAL callee (Clojure's "value as fn"): a keyword looks # itself up in its arg ((:k m) = (get m :k)); a map/set/vector literal looks up -# its arg ((m :k) = (get m :k)). The general dynamic case — a local/var holding a -# keyword — is runtime IFn dispatch, a later increment, and stays out of subset. +# its arg ((m :k) = (get m :k)). This static lowering avoids the jolt-invoke +# dispatch overhead; the dynamic case (a local holding a keyword/coll/fn) routes +# through jolt-invoke in the emit-invoke fallback below. (defn- ifn-kind [fnode] (case (get fnode :op) :const (when (keyword? (get fnode :val)) :keyword) @@ -190,6 +226,10 @@ (errorf "emit: unsupported stdlib fn `%s/%s` (no core on Chez yet)" (get fnode :ns) (get fnode :name)) (= :host (get fnode :op)) (errorf "emit: unsupported host call `%s` (no host interop on Chez yet)" (get fnode :name)) + # a :local callee that isn't a known procedure (a let/param binding holding a + # keyword/coll/fn) -> dynamic IFn dispatch. Excludes the named-fn self-call. + (and (= :local (get fnode :op)) (not (get known-procs (munge (get fnode :name))))) + (string "(jolt-invoke " (emit fnode) " " (string/join args " ") ")") (string "(" (emit fnode) " " (string/join args " ") ")"))) (set emit (fn emit [node] @@ -198,12 +238,17 @@ :const (emit-const (get node :val)) :local (munge (get node :name)) # late-bound var: read the cell's current root at use time. A value-position - # ref to a stdlib var (e.g. passing `inc` to (map inc xs)) needs a real fn, - # which native-op lowering doesn't provide — so it's out of subset regardless. - :var (if (stdlib-var? node) - (errorf "emit: unsupported stdlib ref `%s/%s` (no core on Chez yet)" (get node :ns) (get node :name)) - (string "(var-deref " (string/format "%j" (get node :ns)) " " - (string/format "%j" (get node :name)) ")")) + # ref to a clojure.core fn the RT provides (e.g. passing `inc`/`even?`/`:k` to + # (map inc xs)) lowers to the RT procedure — native-ops names a real Scheme + # procedure for each. Any OTHER stdlib var (clojure.string, an unimplemented + # core fn) has no impl on Chez yet, so it's out of subset. + :var (let [core-proc (and (= "clojure.core" (get node :ns)) (get core-value-procs (get node :name)))] + (cond + core-proc core-proc + (stdlib-var? node) + (errorf "emit: unsupported stdlib ref `%s/%s` (no core on Chez yet)" (get node :ns) (get node :name)) + (string "(var-deref " (string/format "%j" (get node :ns)) " " + (string/format "%j" (get node :name)) ")"))) :host (errorf "emit: unsupported host ref `%s` (no host interop on Chez yet)" (get node :name)) :if (string "(if (jolt-truthy? " (emit (get node :test)) ") " (emit (get node :then)) " " (emit (get node :else)) ")") @@ -237,4 +282,4 @@ "(import (chezscheme))\n" "(load \"host/chez/rt.ss\")\n" (string/join forms-scheme "\n") "\n" - "(printf \"~a\\n\" (jolt-pr-str " final "))\n")) + "(printf \"~a\\n\" (jolt-final-str " final "))\n")) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 655a5e2..190e9b0 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -12,6 +12,7 @@ (load "host/chez/values.ss") (load "host/chez/collections.ss") +(load "host/chez/seq.ss") ;; --- rt arithmetic / logic shims (named in emit.janet's native-ops) ---------- (define (jolt-inc x) (+ x 1)) @@ -53,6 +54,10 @@ (define (jolt-char->string c) (string-append "\\" (case c ((#\newline) "newline") ((#\space) "space") ((#\tab) "tab") ((#\return) "return") (else (string c))))) +;; Program-final printer: jolt's `-e` is str-style at the top level, where a +;; bare nil renders as the empty string (a nil ELEMENT inside a collection still +;; prints "nil", which jolt-pr-str handles). +(define (jolt-final-str x) (if (jolt-nil? x) "" (jolt-pr-str x))) (define (jolt-pr-str x) (cond ((jolt-nil? x) "nil") @@ -72,4 +77,10 @@ ((pset? x) (string-append "#{" (jolt-str-join (pset-fold x (lambda (e a) (cons (jolt-pr-str e) a)) '())) "}")) ((pmap? x) (string-append "{" (jolt-str-join (pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '())) "}")) + ;; lists / cons / lazy seqs all print as (...) — forces a finite seq. + ((empty-list-t? x) "()") + ((cseq? x) (string-append "(" (jolt-str-join + (let loop ((s x) (acc '())) + (if (jolt-nil? s) (reverse acc) + (loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")")) (else (format "~a" x)))) diff --git a/host/chez/seq.ss b/host/chez/seq.ss new file mode 100644 index 0000000..781a1dd --- /dev/null +++ b/host/chez/seq.ss @@ -0,0 +1,211 @@ +;; Phase 1 (jolt-cf1q.2, inc 3b) — the seq tier on the Chez RT. +;; +;; One lazy-capable node (cseq) models Clojure's list, cons, and lazy seq — all +;; print as (...), all sequential-= to each other AND to vectors. `jolt-seq` +;; coerces any seqable (vector/map/set/string/list/seq/nil) to a cseq or nil. +;; The empty seq is a distinct value (jolt-empty-list) that prints "()" — Clojure +;; (rest [1]) is () not nil, (seq []) is nil. The higher-order fns +;; (map/filter/reduce/into/remove) apply their fn argument through `jolt-invoke`, +;; so a procedure, a keyword, or a collection all work as the fn (IFn dispatch). +;; +;; Loaded by rt.ss after collections.ss. values.ss / collections.ss reach the +;; jolt-sequential? / seq=? / seq-hash hooks defined here as forward refs (nothing +;; is CALLED during load). + +;; ============================================================================ +;; the seq node + the empty-seq sentinel +;; ============================================================================ +;; head : the realized first element. tail : EITHER a realized seq (cseq | +;; jolt-nil) when forced? is #t, OR a 0-arg thunk producing one when forced? is +;; #f. Forcing memoizes (set the tail to the produced seq, flip forced?). +(define-record-type cseq (fields head (mutable tail) (mutable forced?)) (nongenerative chez-cseq-v1)) +(define (cseq-realized head tail) (make-cseq head tail #t)) ; tail already a seq +(define (cseq-lazy head tail-thunk) (make-cseq head tail-thunk #f)) +(define (seq-first s) (cseq-head s)) +(define (seq-more s) ; force the tail; returns a seq (cseq | jolt-nil) + (if (cseq-forced? s) (cseq-tail s) + (let ((t ((cseq-tail s)))) (cseq-tail-set! s t) (cseq-forced?-set! s #t) t))) + +;; The empty seq (Clojure's empty list ()), distinct from nil. +(define-record-type empty-list-t (fields) (nongenerative empty-list-v1)) +(define jolt-empty-list (make-empty-list-t)) + +;; ============================================================================ +;; jolt-seq — coerce a seqable to a non-empty seq, or jolt-nil when empty +;; ============================================================================ +(define (list->cseq xs) ; Scheme list -> realized cseq chain (jolt-nil if empty) + (if (null? xs) jolt-nil (cseq-realized (car xs) (list->cseq (cdr xs))))) +(define (vec->seq v i) ; lazy index seq over a persistent vector + (if (fx>=? i (pvec-count v)) jolt-nil + (cseq-lazy (pvec-nth-d v i jolt-nil) (lambda () (vec->seq v (fx+ i 1)))))) +(define (str->seq s i) + (if (fx>=? i (string-length s)) jolt-nil + (cseq-lazy (string-ref s i) (lambda () (str->seq s (fx+ i 1)))))) +(define (jolt-seq x) + (cond + ((jolt-nil? x) jolt-nil) + ((empty-list-t? x) jolt-nil) + ((cseq? x) x) + ((pvec? x) (vec->seq x 0)) + ((pmap? x) (list->cseq (pmap-fold x (lambda (k v a) (cons (jolt-vector k v) a)) '()))) + ((pset? x) (list->cseq (pset-fold x cons '()))) + ((string? x) (str->seq x 0)) + (else (error 'seq "not seqable" x)))) + +(define (jolt-sequential? x) (or (pvec? x) (cseq? x) (empty-list-t? x))) +(define (seq->list s) ; force a finite seq to a Scheme list + (let loop ((s (jolt-seq s)) (acc '())) + (if (jolt-nil? s) (reverse acc) (loop (jolt-seq (seq-more s)) (cons (seq-first s) acc))))) + +;; ============================================================================ +;; the seq leaf ops the emitter lowers core fns to +;; ============================================================================ +(define (jolt-first x) (let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-nil (seq-first s)))) +(define (jolt-rest x) ; () when the seq has 0/1 elements (NOT nil) + (let ((s (jolt-seq x))) + (if (jolt-nil? s) jolt-empty-list + (let ((m (seq-more s))) (if (jolt-nil? m) jolt-empty-list m))))) +(define (jolt-next x) ; nil when the rest is empty + (let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-nil (seq-more s)))) +(define (jolt-cons x coll) (cseq-realized x (jolt-seq coll))) +(define (jolt-list . xs) (if (null? xs) jolt-empty-list (list->cseq xs))) +(define (jolt-reverse coll) (let loop ((s (jolt-seq coll)) (acc jolt-empty-list)) + (if (jolt-nil? s) acc + (loop (jolt-seq (seq-more s)) (cseq-realized (seq-first s) (if (empty-list-t? acc) jolt-nil acc)))))) +(define (jolt-last coll) (let loop ((s (jolt-seq coll)) (last jolt-nil)) + (if (jolt-nil? s) last (loop (jolt-seq (seq-more s)) (seq-first s))))) +;; nth over a seq (walks; forces lazily). default? selects the 3-arg behavior. +(define (seq-nth coll i default? d) + (if (fxinexact (apply + xs))) +(define (jolt-sub . xs) (exact->inexact (apply - xs))) +(define (jolt-mul . xs) (exact->inexact (apply * xs))) +(define (jolt-div . xs) (exact->inexact (apply / xs))) + +;; ============================================================================ +;; IFn dispatch — the dynamic "value as fn" fallback. A callee that the emitter +;; can't statically resolve to a procedure (a keyword/coll/proc held in a local) +;; routes here. Off the arithmetic/self-recursion hot path by construction. +;; ============================================================================ +(define (jolt-invoke f . args) + (cond + ((procedure? f) (apply f args)) + ((keyword? f) (apply jolt-get (car args) f (cdr args))) ; (:k m [d]) -> (get m :k [d]) + ((jolt-coll? f) (apply jolt-get f args)) ; (coll k [d]) -> (get coll k [d]) + (else (error 'invoke "not a fn" f)))) + +;; ============================================================================ +;; map / filter / reduce / into / remove + range / take / concat / apply +;; ============================================================================ +(define (any-nil? seqs) (and (pair? seqs) (or (jolt-nil? (car seqs)) (any-nil? (cdr seqs))))) +(define (map-seq f s) + (if (jolt-nil? s) jolt-nil + (cseq-lazy (jolt-invoke f (seq-first s)) (lambda () (map-seq f (jolt-seq (seq-more s))))))) +(define (map-seq* f seqs) ; multi-collection map; stops at the shortest + (if (any-nil? seqs) jolt-nil + (cseq-lazy (apply jolt-invoke f (map seq-first seqs)) + (lambda () (map-seq* f (map (lambda (s) (jolt-seq (seq-more s))) seqs)))))) +(define (jolt-map f . colls) + (if (null? (cdr colls)) + (map-seq f (jolt-seq (car colls))) + (map-seq* f (map jolt-seq colls)))) + +(define (filter-seq pred s keep) + (let loop ((s s)) + (cond ((jolt-nil? s) jolt-nil) + ((eq? keep (jolt-truthy? (jolt-invoke pred (seq-first s)))) + (cseq-lazy (seq-first s) (lambda () (filter-seq pred (jolt-seq (seq-more s)) keep)))) + (else (loop (jolt-seq (seq-more s))))))) +(define (jolt-filter pred coll) (filter-seq pred (jolt-seq coll) #t)) +(define (jolt-remove pred coll) (filter-seq pred (jolt-seq coll) #f)) + +(define (reduce-seq f acc s) + (if (jolt-nil? s) acc (reduce-seq f (jolt-invoke f acc (seq-first s)) (jolt-seq (seq-more s))))) +(define jolt-reduce + (case-lambda + ((f coll) (let ((s (jolt-seq coll))) + (if (jolt-nil? s) (jolt-invoke f) ; (reduce f []) -> (f) + (reduce-seq f (seq-first s) (jolt-seq (seq-more s)))))) + ((f init coll) (reduce-seq f init (jolt-seq coll))))) + +(define (jolt-into to from) (reduce-seq (lambda (acc x) (jolt-conj1 acc x)) to (jolt-seq from))) + +(define (range-from n) (cseq-lazy n (lambda () (range-from (+ n 1.0))))) +(define (range-bounded n end step) + (if (if (> step 0.0) (< n end) (> n end)) + (cseq-lazy n (lambda () (range-bounded (+ n step) end step))) + jolt-nil)) +(define jolt-range + (case-lambda + (() (range-from 0.0)) + ((end) (range-bounded 0.0 end 1.0)) + ((start end) (range-bounded start end 1.0)) + ((start end step) (range-bounded start end step)))) + +(define (jolt-take n coll) + (let ((n (->idx n))) + (let loop ((n n) (s (jolt-seq coll))) + (if (or (fx<=? n 0) (jolt-nil? s)) jolt-nil + (cseq-lazy (seq-first s) (lambda () (loop (fx- n 1) (jolt-seq (seq-more s))))))))) +(define (jolt-drop n coll) + (let loop ((n (->idx n)) (s (jolt-seq coll))) + (if (or (fx<=? n 0) (jolt-nil? s)) (if (jolt-nil? s) jolt-empty-list s) + (loop (fx- n 1) (jolt-seq (seq-more s)))))) + +(define (concat2 a b) ; lazily append seq a then seqable b + (if (jolt-nil? a) (jolt-seq b) + (cseq-lazy (seq-first a) (lambda () (concat2 (jolt-seq (seq-more a)) b))))) +(define (jolt-concat . colls) + (cond ((null? colls) jolt-empty-list) + ((null? (cdr colls)) (jolt-seq (car colls))) + (else (let loop ((c (jolt-seq (car colls))) (rest (cdr colls))) + (if (null? rest) (if (jolt-nil? c) jolt-empty-list c) + (concat2 c (apply jolt-concat rest))))))) + +;; (apply f a b ... coll): spread the trailing seqable into the call. +(define (jolt-apply f . args) + (let* ((r (reverse args)) (spread (seq->list (jolt-seq (car r)))) (fixed (reverse (cdr r)))) + (apply jolt-invoke f (append fixed spread)))) + +;; ============================================================================ +;; numeric predicates / identity — usable in fn AND value position (map/filter). +;; Return Scheme #t/#f (= jolt true/false). All-flonum model: coerce to an exact +;; integer for the parity tests. +;; ============================================================================ +(define (jolt-even? n) (fx=? 0 (fxand (->idx n) 1))) +(define (jolt-odd? n) (fx=? 1 (fxand (->idx n) 1))) +(define (jolt-pos? n) (> n 0)) +(define (jolt-neg? n) (< n 0)) +(define (jolt-zero? n) (= n 0)) +(define (jolt-identity x) x) + +;; ============================================================================ +;; keys / vals — return seqs (nil on the empty map), HAMT-iteration order +;; ============================================================================ +(define (jolt-keys m) (if (jolt-nil? m) jolt-nil (list->cseq (pmap-fold m (lambda (k v a) (cons k a)) '())))) +(define (jolt-vals m) (if (jolt-nil? m) jolt-nil (list->cseq (pmap-fold m (lambda (k v a) (cons v a)) '())))) + +;; ============================================================================ +;; sequential equality + hash (hooks called from values.ss / collections.ss); +;; consistent with the persistent vector's element-wise =/hash so a vector and a +;; list of the same elements are jolt= and hash alike. +;; ============================================================================ +(define (seq=? a b) + (let loop ((sa (jolt-seq a)) (sb (jolt-seq b))) + (cond ((and (jolt-nil? sa) (jolt-nil? sb)) #t) + ((or (jolt-nil? sa) (jolt-nil? sb)) #f) + ((jolt= (seq-first sa) (seq-first sb)) (loop (jolt-seq (seq-more sa)) (jolt-seq (seq-more sb)))) + (else #f)))) +(define (seq-hash x) + (let loop ((s (jolt-seq x)) (h 1)) + (if (jolt-nil? s) (bitwise-and h hmask) + (loop (jolt-seq (seq-more s)) (bitwise-and (+ (* 31 h) (key-hash (seq-first s))) hmask))))) diff --git a/host/chez/values.ss b/host/chez/values.ss index 687d7e2..3f95c0c 100644 --- a/host/chez/values.ss +++ b/host/chez/values.ss @@ -56,7 +56,11 @@ ((and (char? a) (char? b)) (char=? a b)) ((and (string? a) (string? b)) (string=? a b)) ((and (boolean? a) (boolean? b)) (eq? a b)) - ;; collections: forward to collections.ss (loaded after this file by rt.ss). + ;; sequential (vector / list / lazy seq) compare element-wise, cross-type: + ;; (= [1 2 3] (list 1 2 3)) is true. Forward to seq.ss (loaded by rt.ss). + ((and (jolt-sequential? a) (jolt-sequential? b)) (seq=? a b)) + ((or (jolt-sequential? a) (jolt-sequential? b)) #f) + ;; other collections (map/set): forward to collections.ss. ((and (jolt-coll? a) (jolt-coll? b)) (jolt-coll=? a b)) (else (eq? a b)))) (define (jolt= a . rest) @@ -80,5 +84,6 @@ ((string? x) (string-hash x)) ((char? x) (char->integer x)) ((boolean? x) (if x 1 2)) - ((jolt-coll? x) (jolt-coll-hash x)) ; forward to collections.ss + ((jolt-sequential? x) (seq-hash x)) ; vector/list/seq hash alike (forward to seq.ss) + ((jolt-coll? x) (jolt-coll-hash x)) ; map/set; forward to collections.ss (else (equal-hash x)))) diff --git a/test/chez/README.md b/test/chez/README.md index c886462..ce26841 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -48,14 +48,16 @@ compile-time signal) and are counted "out of subset", not as divergences. JOLT_CHEZ_CORPUS=1 janet test/chez/run-corpus-chez.janet -Baseline after inc 3a (persistent collections, jolt-wgbz): **433/436 compiled -cases pass**, 3 known divergences, 0 NEW; 2219/2655 out of subset (await the seq -tier + core on Chez). The 3 known divergences are dynamic IFn dispatch — a -keyword/vector held in a LOCAL and called as a fn (`(let [k :a] (k m))`); the -STATIC literal forms (`(:a m)`, `({:a 1} :a)`) are supported. They're -allowlisted in the probe; it exits non-zero on a NEW divergence. +Baseline after inc 3b (seq tier + dynamic IFn, jolt-5pso): **595/595 compiled +cases pass**, 0 divergences; 2060/2655 out of subset (await clojure.core on Chez). +The seq tier brought up a list/lazy-seq type with first/rest/next/seq/cons/list, +map/filter/reduce/into/remove, range/take/drop/concat/apply, keys/vals, and +nth/peek/pop over seqs; dynamic IFn dispatch (a keyword/vector/coll held in a +local and called as a fn) now routes through the `jolt-invoke` fallback, closing +the 3 ex-known divergences. The probe exits non-zero on any NEW divergence. -(Prior, inc 2 baseline: 182/182 compiled, 0 divergences, 2473 out of subset.) +(Prior, inc 3a: 433/436 compiled, 3 known IFn divergences, 2219 out of subset. +Inc 2: 182/182 compiled, 0 divergences, 2473 out of subset.) It's a slow report (a Chez subprocess per case), so it's gated behind `JOLT_CHEZ_CORPUS` out of the default suite, like the benches. diff --git a/test/chez/emit-test.janet b/test/chez/emit-test.janet index 8e59aa7..c8c6d07 100644 --- a/test/chez/emit-test.janet +++ b/test/chez/emit-test.janet @@ -121,6 +121,70 @@ (ok (string "coll: " src) (and (= code 0) (= out want)) (string "chez=" out " janet=" want " | " err)))) +# 3d) dynamic IFn dispatch (inc 3b): a keyword/vector/coll held in a LOCAL (let +# binding or fn param) and called as a fn. The 3 ex-known-divergences. The +# callee is a :local that's NOT the fn's self-name, so emit routes it through +# the jolt-invoke fallback (procedure? -> apply; keyword/coll -> lookup). +(each [src want] [["(let [v [10 20 30]] (v 1))" "20"] + ["(let [k :a] (k {:a 7}))" "7"] + ["((fn [f] (f {:a 1})) :a)" "1"]] + (let [[code out err] (d/run-on-chez ctx src)] + (ok (string "ifn: " src) (and (= code 0) (= out want)) + (string "chez=" out " want=" want " | " err)))) + +# 3e) seq tier (inc 3b): jolt list type, first/rest/next/seq/cons/list, lazy-seq +# (range/take over an infinite seq), map/filter/reduce/into/remove, keys/vals. +# Lists and lazy seqs print as (...) and are sequential-= to vectors. Ordered +# shapes -> printed-form parity vs the CLI oracle. +(each src ["(first [1 2 3])" + "(rest [1 2 3])" + "(rest [1])" + "(rest [])" + "(next [1 2 3])" + "(next [1])" + "(cons 0 [1 2 3])" + "(cons 1 nil)" + "(list 1 2 3)" + "(list)" + "(seq [])" + "(conj (list 2 3) 1)" + "(conj nil 1 2)" + "(map inc [1 2 3])" + "(map + [1 2 3] [10 20 30])" + "(map :a [{:a 1} {:a 2}])" + "(filter even? [1 2 3 4])" + "(remove even? [1 2 3 4])" + "(reduce + 0 [1 2 3])" + "(reduce + [1 2 3])" + "(reduce + (map inc (range 4)))" + "(into [] [1 2 3])" + "(into [1] (list 2 3))" + "(take 3 (range))" + "(reverse [1 2 3])" + "(apply + [1 2 3])" + "(count (map inc [1 2 3]))"] + (let [[code out err] (d/run-on-chez ctx src) + want (cli-oracle src)] + (ok (string "seq: " src) (and (= code 0) (= out want)) + (string "chez=" out " janet=" want " | " err)))) + +# 3f) seq tier — unordered / cross-type, equality-wrapped (prints true/false): +# keys/vals order is HAMT order, into-map / into-set unordered; sequential = +# across vector and list. +(each src ["(= 2 (count (keys {:a 1 :b 2})))" + "(= 3 (reduce + (vals {:a 1 :b 2})))" + "(= {:a 1 :b 2} (into {} [[:a 1] [:b 2]]))" + "(= #{1 2 3} (into #{} [1 2 3]))" + "(= [1 2 3] (list 1 2 3))" + "(= [1 2 3] (map inc [0 1 2]))" + # jolt returns a vector for (seq vec) / bounded (range); Chez returns a + # Clojure-canonical lazy seq. Values are sequential-=, printed forms differ. + "(= [1 2 3] (seq [1 2 3]))" + "(= [0 1 2 3 4] (range 5))"] + (let [[code out err] (d/run-on-chez ctx src)] + (ok (string "seq=: " src) (and (= code 0) (= out "true")) + (string "chez=" out " | " err)))) + # 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to # track against the spike ceiling (hand-Scheme fib ~5ms). Informational — the # jolt-truthy? wrapper (~3x) and flonum modeling are known Phase-4 levers. diff --git a/test/chez/run-corpus-chez.janet b/test/chez/run-corpus-chez.janet index ff2698e..fae093e 100644 --- a/test/chez/run-corpus-chez.janet +++ b/test/chez/run-corpus-chez.janet @@ -28,15 +28,13 @@ corpus)) # Known subset divergences: cases that compile but need a feature beyond the -# current increment. Dynamic IFn dispatch — a keyword/vector held in a LOCAL or -# var then called as a fn ((let [k :a] (k m))) — is runtime dispatch on the -# invoke mechanism, deferred to the IFn/protocol increment. The STATIC literal -# forms ((:a m), ({:a 1} :a)) ARE supported. Allowlisted by label; the gate fails -# only on a NEW divergence. +# current increment. None as of inc 3b — dynamic IFn dispatch (a keyword/vector +# held in a LOCAL then called as a fn, (let [k :a] (k m))) now routes through the +# jolt-invoke fallback, and the seq tier closed the rest. Add a label here if a +# future increment surfaces a case that compiles but needs deferred semantics; +# the gate fails only on a NEW (un-allowlisted) divergence. (def known-divergences - {"param holding a keyword (IFn leftover)" true - "vector-in-local as fn" true - "keyword-in-local as fn" true}) + {}) (def ctx (d/make-ctx)) (var compiled 0) (var pass 0) (var out-of-subset 0)