Chez Phase 1 (increment 3q): multimethod dispatch + late-bind
host/chez/multimethods.ss implements the multimethod runtime: defmulti/defmethod expand to defmulti-setup/defmethod-setup calls (+ get-method/methods/ remove-method/prefer-method/prefers). A jolt-multifn record carries its dispatch fn and a jolt=-keyed method table; jolt-invoke dispatches it (exact match, then isa?/hierarchy with prefer-method, then :default), reusing the overlay's isa?/derive/make-hierarchy. The multifn's ns comes from a runtime chez-current-ns (default user; the prelude load sets clojure.core for print-method/print-dup). Two emit-side changes were needed: - late-bind (:late-bind-unresolved? ctx flag, default OFF): defmulti expands to a bare-symbol setup call, so the analyzer doesn't intern the name and a forward reference '(area ...)' after '(defmulti area ...)' in one form was 'Unable to resolve symbol'. The strict compiler punts these to the interpreter; the Chez back end has none, so the flag lowers an unresolved symbol to a var-ref against the compile ns (open-world -e semantics). Set only by the Chez make-ctx / jolt-chez; the main compiler keeps strict resolution (host_iface late-bind? defaults nil). - a :var call head now routes through jolt-invoke, since a late-bound var can hold a multifn (or keyword/coll IFn), not just a procedure. Transparent for procedures; the hot self-recursive call is a :local known-proc, stays direct. Class-based dispatch ((class x)/String) deferred (needs deftype/class subsystem). Parity 1506 -> 1530/2497, 0 new divergences. emit-test 302/302. Full janet gate green (the analyzer flag is off there; suite flakiness under parallel load only).
This commit is contained in:
Yogthos
parent
e51cc2e47e
commit
02139af0a1
10 changed files with 279 additions and 8 deletions
|
|
@ -29,8 +29,13 @@
|
|||
(and (r 0) (zero? (r 1))))
|
||||
|
||||
(defn make-ctx []
|
||||
"A compile-mode jolt ctx (the analyzer pipeline is only built under :compile?)."
|
||||
(api/init {:compile? true}))
|
||||
"A compile-mode jolt ctx (the analyzer pipeline is only built under :compile?).
|
||||
Late-bind unresolved symbols: the Chez back end has no interpreter to punt to,
|
||||
so a forward reference to a runtime-interned var (defmulti/defmethod's setup
|
||||
call) lowers to a var-deref instead of failing to compile (jolt-9ls5)."
|
||||
(def ctx (api/init {:compile? true}))
|
||||
(put (get ctx :env) :late-bind-unresolved? true)
|
||||
ctx)
|
||||
|
||||
(defn- parse-all [src]
|
||||
(def out @[])
|
||||
|
|
@ -138,10 +143,15 @@
|
|||
(string
|
||||
"(import (chezscheme))\n"
|
||||
"(load \"host/chez/rt.ss\")\n"
|
||||
# the prelude's defmultis (print-method/print-dup) must land in clojure.core,
|
||||
# not the default user ns (jolt-9ls5); set the multimethod current-ns around
|
||||
# the prelude load, then restore it to user for the program form.
|
||||
"(set-chez-ns! \"clojure.core\")\n"
|
||||
"(load " (string/format "%j" prelude-path) ")\n"
|
||||
# native-wins overrides for overlay predicates that read :jolt/type (char?,
|
||||
# atom?) — must load AFTER the prelude's own def-var! to take effect.
|
||||
"(load \"host/chez/post-prelude.ss\")\n"
|
||||
"(set-chez-ns! \"user\")\n"
|
||||
"(printf \"~a\\n\" (jolt-final-str " final-scm "))\n"))
|
||||
|
||||
(defn eval-e-with-prelude
|
||||
|
|
|
|||
|
|
@ -331,6 +331,13 @@
|
|||
# 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 " ") ")")
|
||||
# a late-bound :var call head can hold a plain procedure OR a non-applicable
|
||||
# value the RT dispatches (a multimethod record, a keyword/coll IFn) — route it
|
||||
# through jolt-invoke so all of those work. Transparent for a procedure
|
||||
# (jolt-invoke just applies it); the hot self-recursive call is a :local
|
||||
# known-proc above, so it stays a direct call.
|
||||
(= :var (get fnode :op))
|
||||
(string "(jolt-invoke " (emit fnode) " " (string/join args " ") ")")
|
||||
(string "(" (emit fnode) " " (string/join args " ") ")")))
|
||||
|
||||
(set emit (fn emit [node]
|
||||
|
|
|
|||
|
|
@ -39,6 +39,9 @@
|
|||
(os/exit 2))
|
||||
(def src (in args 1))
|
||||
(def ctx (api/init-cached {:compile? true}))
|
||||
# late-bind unresolved symbols (no interpreter to punt to) so defmulti/defmethod
|
||||
# forward references lower to a var-deref (jolt-9ls5), matching d/make-ctx.
|
||||
(put (get ctx :env) :late-bind-unresolved? true)
|
||||
(def prelude-path (ensure-prelude ctx))
|
||||
(def [code out err] (d/eval-e-with-prelude ctx src prelude-path))
|
||||
(when (= code :emit-err)
|
||||
|
|
|
|||
183
host/chez/multimethods.ss
Normal file
183
host/chez/multimethods.ss
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
;; multimethods (jolt-9ls5) — the multimethod dispatch runtime on the Chez host.
|
||||
;;
|
||||
;; defmulti/defmethod are macros that expand to ctx-capturing setup CALLS
|
||||
;; (defmulti-setup / defmethod-setup, + the table ops get-method/methods/
|
||||
;; remove-method/prefer-method/prefers). The Janet seed implements these against
|
||||
;; the evaluator's ns/var machinery (eval_runtime.janet); this is the Chez port.
|
||||
;;
|
||||
;; A multimethod VALUE is a jolt-multifn record carrying its dispatch fn and a
|
||||
;; mutable method table (dispatch-val -> method fn, keyed with jolt= so keyword/
|
||||
;; vector/number dispatch values match by value). jolt-invoke dispatches it:
|
||||
;; an exact method, else an isa?/hierarchy match (resolved through prefer-method
|
||||
;; and the overlay's isa?/derive/hierarchy), else the :default method.
|
||||
;;
|
||||
;; NS resolution: defmulti expands to (defmulti-setup (quote name) ...) with a
|
||||
;; BARE symbol — the Chez RT has no compile-time current ns at the call site, so a
|
||||
;; runtime `chez-current-ns` box names where to def-var! the multifn. It defaults
|
||||
;; to "user" (matching the analyzer's ns for -e user code); the assembled prelude
|
||||
;; sets it to "clojure.core" around its own load (program-with-prelude), so the
|
||||
;; print-method/print-dup defmultis land in clojure.core. defmethod-setup and the
|
||||
;; symbol-taking table ops resolve the multifn via (var-deref (chez-current-ns) …),
|
||||
;; so they agree with defmulti. Loaded from rt.ss after seq.ss (jolt-invoke),
|
||||
;; collections.ss (jolt=/key-hash/jolt-hash-map) and the var-cell machinery.
|
||||
|
||||
(define chez-current-ns-box (vector "user"))
|
||||
(define (chez-current-ns) (vector-ref chez-current-ns-box 0))
|
||||
(define (set-chez-ns! ns) (vector-set! chez-current-ns-box 0 ns))
|
||||
|
||||
(define-record-type jolt-multifn
|
||||
(fields name dispatch-fn methods default hierarchy prefers)
|
||||
(nongenerative jolt-multifn-v1))
|
||||
|
||||
(define kw-default (keyword #f "default"))
|
||||
(define (new-mm-table) (make-hashtable key-hash jolt=))
|
||||
|
||||
;; (defmulti-setup 'name dispatch & opts) — opts is a flat :default/:hierarchy plist.
|
||||
(define (parse-mm-opts opts)
|
||||
(let loop ((o opts) (dk kw-default) (h #f))
|
||||
(if (or (null? o) (null? (cdr o)))
|
||||
(values dk h)
|
||||
(let ((k (car o)) (v (cadr o)))
|
||||
(cond
|
||||
((and (keyword? k) (not (keyword-t-ns k)) (string=? (keyword-t-name k) "default"))
|
||||
(loop (cddr o) v h))
|
||||
((and (keyword? k) (not (keyword-t-ns k)) (string=? (keyword-t-name k) "hierarchy"))
|
||||
(loop (cddr o) dk v))
|
||||
(else (loop (cddr o) dk h)))))))
|
||||
|
||||
(define (jolt-defmulti-setup name-sym dispatch . opts)
|
||||
(let-values (((dk h) (parse-mm-opts opts)))
|
||||
(let ((mf (make-jolt-multifn (symbol-t-name name-sym) dispatch
|
||||
(new-mm-table) dk h (new-mm-table))))
|
||||
(def-var! (chez-current-ns) (symbol-t-name name-sym) mf)
|
||||
mf)))
|
||||
|
||||
;; (defmethod-setup 'mm dispatch-val impl) — add a method. Auto-creates the multifn
|
||||
;; if absent (defmethod before defmulti — rare; identity dispatch as a fallback).
|
||||
(define (jolt-defmethod-setup mm-sym dval impl)
|
||||
(let* ((nm (symbol-t-name mm-sym))
|
||||
(cur (var-deref (chez-current-ns) nm))
|
||||
(mf (if (jolt-multifn? cur) cur
|
||||
(let ((m (make-jolt-multifn nm (var-deref "clojure.core" "identity")
|
||||
(new-mm-table) kw-default #f (new-mm-table))))
|
||||
(def-var! (chez-current-ns) nm m) m))))
|
||||
(hashtable-set! (jolt-multifn-methods mf) dval impl)
|
||||
mf))
|
||||
|
||||
;; --- dispatch ----------------------------------------------------------------
|
||||
(define (mm-isa? mf)
|
||||
;; the overlay's isa? (the hierarchy system is pure Clojure); a per-mm :hierarchy
|
||||
;; is an atom (deref each dispatch, like a Clojure var) or a plain map.
|
||||
(let* ((isa (var-deref "clojure.core" "isa?"))
|
||||
(h (jolt-multifn-hierarchy mf))
|
||||
(hval (and h (if (jolt-atom? h) (jolt-atom-val h) h))))
|
||||
(lambda (x y) (jolt-truthy? (if hval (jolt-invoke isa hval x y) (jolt-invoke isa x y))))))
|
||||
|
||||
(define (mm-find-isa mf dv)
|
||||
(let* ((methods (jolt-multifn-methods mf))
|
||||
(isa? (mm-isa? mf))
|
||||
(default (jolt-multifn-default mf))
|
||||
(keys (filter (lambda (k) (not (jolt= k default)))
|
||||
(vector->list (hashtable-keys methods))))
|
||||
(matches (filter (lambda (k) (isa? dv k)) keys)))
|
||||
(cond
|
||||
((null? matches) #f)
|
||||
((null? (cdr matches)) (hashtable-ref methods (car matches) #f))
|
||||
(else
|
||||
;; >1 isa-match: pick the dominant key (x dominates y when x is
|
||||
;; prefer-method'd over y, or (isa? x y)); ambiguity with no dominant is an
|
||||
;; error, as in Clojure.
|
||||
(let* ((prefers (jolt-multifn-prefers mf))
|
||||
(pref? (lambda (x y)
|
||||
(let ((px (hashtable-ref prefers x #f)))
|
||||
(and px (hashtable-ref px y #f) #t))))
|
||||
(dom? (lambda (x y) (or (pref? x y) (isa? x y))))
|
||||
(best (fold-left (lambda (b k) (if (dom? k b) k b)) (car matches) (cdr matches))))
|
||||
(for-each
|
||||
(lambda (k)
|
||||
(when (and (not (jolt= k best)) (not (dom? best k)))
|
||||
(error #f (string-append "Multiple methods in multimethod '" (jolt-multifn-name mf)
|
||||
"' match dispatch value - and neither is preferred"))))
|
||||
matches)
|
||||
(hashtable-ref methods best #f))))))
|
||||
|
||||
(define (multifn-dispatch mf . args)
|
||||
(let* ((dv (apply jolt-invoke (jolt-multifn-dispatch-fn mf) args))
|
||||
(methods (jolt-multifn-methods mf))
|
||||
(direct (hashtable-ref methods dv #f)))
|
||||
(cond
|
||||
(direct (apply jolt-invoke direct args))
|
||||
((mm-find-isa mf dv) => (lambda (m) (apply jolt-invoke m args)))
|
||||
((hashtable-ref methods (jolt-multifn-default mf) #f)
|
||||
=> (lambda (m) (apply jolt-invoke m args)))
|
||||
(else (error #f (string-append "No method in multimethod '" (jolt-multifn-name mf)
|
||||
"' for dispatch value: " (jolt-pr-str dv)))))))
|
||||
|
||||
;; jolt-invoke dispatches a multifn (otherwise falls through to the prior logic).
|
||||
(define %prev-jolt-invoke jolt-invoke)
|
||||
(set! jolt-invoke
|
||||
(lambda (f . args)
|
||||
(if (jolt-multifn? f)
|
||||
(apply multifn-dispatch f args)
|
||||
(apply %prev-jolt-invoke f args))))
|
||||
|
||||
;; --- table ops ---------------------------------------------------------------
|
||||
;; prefer-method/remove-method/remove-all-methods/prefers take the name QUOTED;
|
||||
;; get-method/methods take the multifn VALUE (Clojure semantics).
|
||||
(define (mm-of-sym sym) (let ((v (var-deref (chez-current-ns) (symbol-t-name sym))))
|
||||
(and (jolt-multifn? v) v)))
|
||||
|
||||
(define (jolt-prefer-method-setup mm-sym dval-a dval-b)
|
||||
(let ((mf (mm-of-sym mm-sym)))
|
||||
(when mf
|
||||
(let ((sub (or (hashtable-ref (jolt-multifn-prefers mf) dval-a #f)
|
||||
(let ((h (new-mm-table)))
|
||||
(hashtable-set! (jolt-multifn-prefers mf) dval-a h) h))))
|
||||
(hashtable-set! sub dval-b #t)))
|
||||
mf))
|
||||
|
||||
(define (jolt-remove-method-setup mm-sym dval)
|
||||
(let ((mf (mm-of-sym mm-sym)))
|
||||
(when mf (hashtable-delete! (jolt-multifn-methods mf) dval))
|
||||
mf))
|
||||
|
||||
(define (jolt-remove-all-methods-setup mm-sym)
|
||||
(let ((mf (mm-of-sym mm-sym)))
|
||||
(when mf (hashtable-clear! (jolt-multifn-methods mf)))
|
||||
mf))
|
||||
|
||||
(define (jolt-get-method-setup mf dval)
|
||||
(if (jolt-multifn? mf)
|
||||
(or (hashtable-ref (jolt-multifn-methods mf) dval #f)
|
||||
(hashtable-ref (jolt-multifn-methods mf) (jolt-multifn-default mf) #f)
|
||||
jolt-nil)
|
||||
jolt-nil))
|
||||
|
||||
(define (jolt-methods-setup mf)
|
||||
(if (jolt-multifn? mf)
|
||||
(let-values (((ks vs) (hashtable-entries (jolt-multifn-methods mf))))
|
||||
(let loop ((i 0) (m (jolt-hash-map)))
|
||||
(if (fx>=? i (vector-length ks)) m
|
||||
(loop (fx+ i 1) (jolt-assoc m (vector-ref ks i) (vector-ref vs i))))))
|
||||
jolt-nil))
|
||||
|
||||
(define (jolt-prefers-setup mm-sym)
|
||||
(let ((mf (mm-of-sym mm-sym)))
|
||||
(if (not mf) (jolt-hash-map)
|
||||
(let-values (((ks vs) (hashtable-entries (jolt-multifn-prefers mf))))
|
||||
(let loop ((i 0) (m (jolt-hash-map)))
|
||||
(if (fx>=? i (vector-length ks)) m
|
||||
;; each value is an inner set of preferred-over keys -> a jolt set
|
||||
(loop (fx+ i 1)
|
||||
(jolt-assoc m (vector-ref ks i)
|
||||
(apply jolt-hash-set
|
||||
(vector->list (hashtable-keys (vector-ref vs i))))))))))))
|
||||
|
||||
(def-var! "clojure.core" "defmulti-setup" jolt-defmulti-setup)
|
||||
(def-var! "clojure.core" "defmethod-setup" jolt-defmethod-setup)
|
||||
(def-var! "clojure.core" "prefer-method-setup" jolt-prefer-method-setup)
|
||||
(def-var! "clojure.core" "remove-method-setup" jolt-remove-method-setup)
|
||||
(def-var! "clojure.core" "remove-all-methods-setup" jolt-remove-all-methods-setup)
|
||||
(def-var! "clojure.core" "get-method-setup" jolt-get-method-setup)
|
||||
(def-var! "clojure.core" "methods-setup" jolt-methods-setup)
|
||||
(def-var! "clojure.core" "prefers-setup" jolt-prefers-setup)
|
||||
|
|
@ -165,3 +165,8 @@
|
|||
;; reduced/reduced?/identical? — seed-native fns the overlay assumes are core
|
||||
;; natives. Over the seq layer + jolt-compare, so loaded after converters.ss.
|
||||
(load "host/chez/natives-seq.ss")
|
||||
|
||||
;; multimethods (jolt-9ls5): defmulti/defmethod dispatch runtime. Needs jolt-invoke
|
||||
;; (seq.ss), jolt=/key-hash/jolt-hash-map (collections.ss), jolt-atom? (atoms.ss),
|
||||
;; jolt-pr-str (above), and the var-cell machinery — so loaded last.
|
||||
(load "host/chez/multimethods.ss")
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@
|
|||
form-regex? form-regex-source
|
||||
form-macro? form-expand-1 resolve-global
|
||||
form-sym-meta host-intern! form-syntax-quote-lower
|
||||
record-type? record-ctor-key form-position]]))
|
||||
record-type? record-ctor-key form-position late-bind?]]))
|
||||
|
||||
(declare analyze)
|
||||
|
||||
|
|
@ -317,7 +317,13 @@
|
|||
;; (defmulti's setup call) legitimately reference the var they
|
||||
;; are about to create when nested in a non-top-level do. Real
|
||||
;; forward references want (declare ...), as in Clojure.
|
||||
(uncompilable (str "Unable to resolve symbol: " nm " in this context")))))))
|
||||
;; Under late-bind? (the Chez back end, which has no interpreter
|
||||
;; to punt to) an unresolved symbol instead lowers to a var-ref
|
||||
;; against the compile ns — resolved at runtime, the open-world
|
||||
;; semantics of -e — so defmulti/defmethod forward references work.
|
||||
(if (late-bind? ctx)
|
||||
(var-ref (compile-ns ctx) nm)
|
||||
(uncompilable (str "Unable to resolve symbol: " nm " in this context"))))))))
|
||||
|
||||
(defn- analyze-list [ctx form env]
|
||||
(let [items (vec (form-elements form))]
|
||||
|
|
|
|||
|
|
@ -171,6 +171,14 @@
|
|||
(ns-intern (ctx-find-ns ctx ns-name) nm)
|
||||
nil)
|
||||
|
||||
# Open-world (late-binding) analysis: when set on the ctx env, an unresolved
|
||||
# symbol emits a var-ref against the compile ns (resolved at runtime) instead of
|
||||
# punting to the interpreter. The Chez back end (host/chez/driver) sets it: it has
|
||||
# no interpreter to punt to, and a forward reference to a runtime-interned var
|
||||
# (e.g. defmulti's setup call) must lower to a var-deref. Off everywhere else, so
|
||||
# the normal compiler keeps its strict 'Unable to resolve symbol' behavior.
|
||||
(defn h-late-bind? [ctx] (truthy? (get (ctx :env) :late-bind-unresolved?)))
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Installation: bind these fns as vars in the `jolt.host` namespace so jolt-core
|
||||
# can call them. Idempotent per context.
|
||||
|
|
@ -270,7 +278,8 @@
|
|||
"host-intern!" h-intern!
|
||||
"inline-enabled?" h-inline-enabled? "inline-ir" h-inline-ir
|
||||
"record-type?" h-record-type? "form-position" h-form-position
|
||||
"record-ctor-key" h-record-ctor-key "record-shapes" h-record-shapes})
|
||||
"record-ctor-key" h-record-ctor-key "record-shapes" h-record-shapes
|
||||
"late-bind?" h-late-bind?})
|
||||
|
||||
(defn install! [ctx]
|
||||
(def ns (ctx-find-ns ctx "jolt.host"))
|
||||
|
|
|
|||
|
|
@ -163,6 +163,28 @@ class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps).
|
|||
The Chez host throws (Clojure-correct), so the 4 `odd arg …` corpus rows — which
|
||||
encode the seed's lenient behavior — sit in the crash bucket until the seed is
|
||||
fixed and those spec rows are updated to `:throws`.
|
||||
- inc 3q multimethod dispatch + late-bind (jolt-9ls5, Phase 2): `host/chez/
|
||||
multimethods.ss` implements the multimethod runtime — `defmulti`/`defmethod`
|
||||
expand to `defmulti-setup`/`defmethod-setup` calls (+ `get-method`/`methods`/
|
||||
`remove-method`/`prefer-method`/`prefers`). A `jolt-multifn` record carries its
|
||||
dispatch fn and a `jolt=`-keyed method table; `jolt-invoke` dispatches it (exact
|
||||
match, then isa?/hierarchy with `prefer-method`, then `:default`), reusing the
|
||||
overlay's `isa?`/`derive`/`make-hierarchy`. The multifn's ns is set via a runtime
|
||||
`chez-current-ns` (default "user"; the prelude load sets "clojure.core").
|
||||
|
||||
Two emit-side changes made this work:
|
||||
- **late-bind** (`:late-bind-unresolved?` ctx flag, default OFF): `defmulti`
|
||||
expands to a bare-symbol setup *call*, so the analyzer doesn't intern the name
|
||||
and a forward reference (`(area …)` after `(defmulti area …)` in one form) was
|
||||
"Unable to resolve symbol". The strict compiler punts these to the interpreter;
|
||||
the Chez back end has none, so the flag makes an unresolved symbol lower to a
|
||||
`var-ref` against the compile ns — the open-world semantics of `-e`. Set only by
|
||||
the Chez `make-ctx`/`jolt-chez`; the main compiler keeps its strict behavior.
|
||||
- a `:var` call head now routes through `jolt-invoke` (not a direct application),
|
||||
since a late-bound var can hold a multifn (or a keyword/coll IFn), not just a
|
||||
procedure. Transparent for procedures; the hot self-recursive call is a `:local`
|
||||
known-proc, so it stays direct. (Class-based dispatch — `(class x)`/`String` — is
|
||||
deferred; it needs the deftype/class subsystem.)
|
||||
|
||||
The remaining buckets are the punch-list the next increments chase: ~361 emit-fail
|
||||
(genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of
|
||||
|
|
|
|||
|
|
@ -583,6 +583,32 @@
|
|||
(ok (string "y1zq -e: " src) (and (= code 0) (= out want))
|
||||
(string "chez=" out " janet=" want " | " err)))))
|
||||
|
||||
# 3v) multimethod dispatch (jolt-9ls5): defmulti/defmethod expand to
|
||||
# defmulti-setup/defmethod-setup (+ get-method/methods/remove-method/
|
||||
# prefer-method/prefers); host/chez/multimethods.ss provides the runtime. A
|
||||
# jolt-multifn record carries its dispatch fn + method table; jolt-invoke
|
||||
# dispatches it (direct match, then isa?/hierarchy + prefers, then :default).
|
||||
# Dispatch uses the overlay isa?/derive/make-hierarchy, so these need the full
|
||||
# prelude -> the -e binary. (Class-based dispatch — (class x)/String — is
|
||||
# deferred; it needs the deftype/class subsystem.)
|
||||
(when (os/stat "bin/jolt-chez")
|
||||
(each src ["(= \"two\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (f 2)))"
|
||||
"(= \"circle\" (do (defmulti area :shape) (defmethod area :circle [_] \"circle\") (area {:shape :circle})))"
|
||||
"(= \"other\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f :default [_] \"other\") (f 99)))"
|
||||
"(= 5 (do (defmulti g (fn [a b] a)) (defmethod g :add [_ b] b) (g :add 5)))"
|
||||
"(= :is-shape (do (derive :hsq :hshape) (defmulti hmm identity) (defmethod hmm :hshape [_] :is-shape) (hmm :hsq)))"
|
||||
"(= :parent (do (def hh (atom (derive (make-hierarchy) :c :p))) (defmulti cmm identity :hierarchy hh) (defmethod cmm :p [_] :parent) (cmm :c)))"
|
||||
"(= :exact (do (derive :de1 :de2) (defmulti emm identity) (defmethod emm :de2 [_] :parent) (defmethod emm :de1 [_] :exact) (emm :de1)))"
|
||||
"(= \"one\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get-method f 1) 1)))"
|
||||
"(= \"one\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get (methods f) 1) 1)))"
|
||||
"(= 2 (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (count (methods f))))"]
|
||||
(let [[code out err] (run-jolt-chez src) want (cli-oracle src)]
|
||||
(ok (string "multimethod: " src) (and (= code 0) (= out want))
|
||||
(string "chez=" out " janet=" want " | " err))))
|
||||
# no-match throws (exits non-zero), like the corpus :throws row.
|
||||
(let [[code out err] (run-jolt-chez "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (f 99))")]
|
||||
(ok "multimethod: no match throws" (not= code 0) (string "code=" code))))
|
||||
|
||||
# 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.
|
||||
|
|
|
|||
|
|
@ -136,9 +136,9 @@
|
|||
# on any NEW (un-allowlisted) divergence — a real Chez correctness regression.
|
||||
# Full-corpus baseline: inc 3j 1220/2497; 3k (converters) 1326; 3l (transients)
|
||||
# 1382; 3m (numeric-edge emit + variadic assoc!) 1407; 3n (seq-native shims +
|
||||
# reduced) 1467; 3o (transducer arities) 1493; 3p (misc seq/regex gaps) 1506.
|
||||
# Strided runs scale down.
|
||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1506")))
|
||||
# reduced) 1467; 3o (transducer arities) 1493; 3p (misc seq/regex gaps) 1506;
|
||||
# 3q (multimethod dispatch + late-bind) 1530. Strided runs scale down.
|
||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "1530")))
|
||||
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
|
||||
(when (or (> (length diverged) 0) (< pass floor))
|
||||
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue