Chez Phase 1 (increment 3b): seq tier + dynamic IFn dispatch on the Chez RT
Brings up the seq layer on the Chez runtime. host/chez/seq.ss adds one lazy-capable node (cseq) that models Clojure's list, cons, and lazy seq - all print as (...), all sequential-= to each other and to vectors. seq coerces any seqable (vector/map/set/string/list/seq/nil) to a cseq or nil; the empty seq is a distinct value printing () (rest of a 1-elem coll is () not nil, seq of empty is nil). Leaf ops: first/rest/next/seq/cons/list, reverse/last, map/filter/remove/reduce/into, range/take/drop/concat/apply, keys/vals, plus nth/peek/pop extended over seqs. map/filter/reduce apply their fn arg through jolt-invoke, so a procedure, keyword, or collection all work as the fn. Dynamic IFn dispatch: a keyword/vector/coll held in a local (let binding or fn param) and called as a fn now routes through the jolt-invoke fallback (procedure? -> apply; keyword/coll -> lookup). The emitter only routes a :local callee that isn't a known procedure - a named fn's self-recursion name stays a direct call, so the fib hot path is untouched. Closes the 3 ex-known IFn divergences. emit.janet: seq/pred ops added to native-ops with arity gates; value-position clojure.core refs resolve to the RT procedure (native-ops names one for each), with +/-/*// routed to flonum-coercing wrappers so higher-order arithmetic ((reduce + [])) keeps the all-double model. values.ss: cross-type sequential =/hash so a vector and a list of the same elements are jolt= and hash alike. rt.ss: printer learns seqs; top-level nil prints as the empty string (jolt -e str-style). Fixed latent bug: (conj nil ...) now builds a list, not a vector. Gates: emit-test 69/69 (fib/mandelbrot/collections/seq/IFn parity vs the jolt oracle, fib(30) ~24ms unchanged). Subset probe 433/436 -> 595/595 compiled, 0 divergences (was 3 known), 2060/2655 out of subset. Full run-tests green (125 files, conformance + suites included).
This commit is contained in:
Yogthos
parent
5c5d2cd1fc
commit
cb3cfaf0c2
8 changed files with 383 additions and 33 deletions
|
|
@ -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) (fx<? i (vector-length v))) (vector-ref v i)
|
||||
(error 'nth "index out of bounds"))))
|
||||
((string? coll) (string-ref coll i))
|
||||
((or (cseq? coll) (empty-list-t? coll)) (seq-nth coll i #f jolt-nil))
|
||||
(else (error 'nth "unsupported collection")))))
|
||||
((coll i d)
|
||||
(let ((i (->idx i)))
|
||||
(cond ((pvec? coll) (pvec-nth-d coll i d))
|
||||
((string? coll) (if (and (fx>=? i 0) (fx<? i (string-length coll))) (string-ref coll i) d))
|
||||
((or (cseq? coll) (empty-list-t? coll)) (seq-nth coll i #t d))
|
||||
(else d))))))
|
||||
|
||||
;; jolt models every number as a double, so a count is a flonum — else
|
||||
|
|
@ -241,6 +245,9 @@
|
|||
((pset? coll) (pset-count coll))
|
||||
((string? coll) (string-length coll))
|
||||
((jolt-nil? coll) 0)
|
||||
((empty-list-t? coll) 0)
|
||||
((cseq? coll) (let loop ((s coll) (n 0)) ; walk (forces a finite seq)
|
||||
(if (jolt-nil? s) n (loop (jolt-seq (seq-more s)) (fx+ n 1)))))
|
||||
(else (error 'count "uncountable")))))
|
||||
|
||||
(define (jolt-assoc1 coll k v)
|
||||
|
|
@ -272,12 +279,19 @@
|
|||
((pmap? coll) (fx=? 0 (pmap-cnt coll)))
|
||||
((pset? coll) (fx=? 0 (pset-count coll)))
|
||||
((string? coll) (fx=? 0 (string-length coll)))
|
||||
((empty-list-t? coll) #t)
|
||||
((cseq? coll) #f) ; a cseq is non-empty by construction
|
||||
(else (error 'empty? "unsupported collection"))))
|
||||
|
||||
(define (jolt-peek coll)
|
||||
(cond ((pvec? coll) (pvec-peek coll)) ((jolt-nil? coll) jolt-nil) (else (error 'peek "unsupported collection"))))
|
||||
(cond ((pvec? coll) (pvec-peek coll))
|
||||
((or (cseq? coll) (empty-list-t? coll)) (jolt-first coll)) ; list peek = first
|
||||
((jolt-nil? coll) jolt-nil) (else (error 'peek "unsupported collection"))))
|
||||
(define (jolt-pop coll)
|
||||
(cond ((pvec? coll) (pvec-pop coll)) (else (error 'pop "unsupported collection"))))
|
||||
(cond ((pvec? coll) (pvec-pop coll))
|
||||
((cseq? coll) (jolt-rest coll)) ; list pop = rest
|
||||
((empty-list-t? coll) (error 'pop "can't pop empty list"))
|
||||
(else (error 'pop "unsupported collection"))))
|
||||
|
||||
;; ============================================================================
|
||||
;; equality / hash hooks called from values.ss (jolt=2 / jolt-hash)
|
||||
|
|
|
|||
|
|
@ -34,7 +34,24 @@
|
|||
"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"})
|
||||
"empty?" "jolt-empty?" "peek" "jolt-peek" "pop" "jolt-pop"
|
||||
# seq tier (jolt-5pso) -> 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"))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
211
host/chez/seq.ss
Normal file
211
host/chez/seq.ss
Normal file
|
|
@ -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 (fx<? i 0) (if default? d (error 'nth "index out of bounds"))
|
||||
(let loop ((s (jolt-seq coll)) (i i))
|
||||
(cond ((jolt-nil? s) (if default? d (error 'nth "index out of bounds")))
|
||||
((fx=? i 0) (seq-first s))
|
||||
(else (loop (jolt-seq (seq-more s)) (fx- i 1)))))))
|
||||
|
||||
;; value-position arithmetic: jolt models every number as a double, so the
|
||||
;; higher-order forms ((reduce + []), (apply * xs)) must coerce — Scheme's (+)/(*)
|
||||
;; identities are EXACT 0/1, which aren't jolt= to the double 0.0/1.0. The hot
|
||||
;; path uses the inlined native ops, not these.
|
||||
(define (jolt-add . xs) (exact->inexact (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)))))
|
||||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue