Bare-index field reads for statically-known records (#228)
When the inference types a keyword-lookup receiver as a record — it carries the field-order :shape and :hint :struct from the whole-program fixpoint — the back end reads the field by its declared slot via jrec-field-at instead of jolt-get. That skips the jolt-get case-lambda, the dispatch fn, and the field-key hashtable lookup, leaving a jrec? check + a static-index vector-ref. jrec-field-at falls back to jolt-get when the receiver isn't the expected record (a map downgraded by dissoc, or a value the inference mistyped), so it stays correct if the static type is wrong. Only the no-default form takes the bare path (a declared field is always present). Sound only for non-nil records: a self-recursive param that can be nil (e.g. binary-trees check-tree, whose untagged child is nil at leaves) types :any and keeps jolt-get — the whole-program fixpoint demotes it. The target is non-nil record params, like a Vec3 dot product (~5% there; boxed-flonum arithmetic dominates the rest, a separate numeric lever). run-fieldread.ss gate: emitted form uses jrec-field-at at the right slot and matches jolt-get for each declared field; a non-field key and a default-arg form keep the generic path. make test / shakesmoke green, 0 new divergences. Co-authored-by: Yogthos <yogthos@gmail.com>
This commit is contained in:
parent
af11aaa7ff
commit
de31221573
5 changed files with 188 additions and 80 deletions
|
|
@ -146,6 +146,17 @@
|
|||
=> (lambda (m) (jolt-invoke m coll k d)))
|
||||
(else d))
|
||||
v))))))
|
||||
;; bare-index field read for a statically-known record field — emitted by `jolt
|
||||
;; build --opt` for a struct-typed receiver, where i is the field's declared slot.
|
||||
;; When r is the expected record it reads the value vector directly: no field-key
|
||||
;; hashtable lookup, no jolt-get dispatch. Falls back to jolt-get otherwise (a map
|
||||
;; downgraded by dissoc, or a value the inference mistyped), so it stays correct
|
||||
;; even if the static type is wrong.
|
||||
(define (jrec-field-at r i k)
|
||||
(if (and (jrec? r) (fx< i (vector-length (jrec-vals r))))
|
||||
(vector-ref (jrec-vals r) i)
|
||||
(jolt-get r k)))
|
||||
|
||||
;; mutate a deftype's mutable field in place: the value vector is mutable, so
|
||||
;; vector-set! updates the field. (set! field v) inside a method lowers to this;
|
||||
;; returns v, as set! does.
|
||||
|
|
|
|||
72
host/chez/run-fieldread.ss
Normal file
72
host/chez/run-fieldread.ss
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
;; run-fieldread.ss — native record field-read gate (backend_scheme emit).
|
||||
;;
|
||||
;; When the inference types a keyword-lookup receiver as a record (it carries the
|
||||
;; field-order :shape + :hint :struct), the back end reads the field by its static
|
||||
;; slot via jrec-field-at instead of jolt-get. This gate pins the emit shape and
|
||||
;; that the value matches jolt-get — for a declared field, a non-field key (no
|
||||
;; bare path), and a default-arg form (no bare path).
|
||||
;;
|
||||
;; chez --script host/chez/run-fieldread.ss
|
||||
(import (chezscheme))
|
||||
(load "host/chez/rt.ss")
|
||||
(set-chez-ns! "clojure.core")
|
||||
(load "host/chez/seed/prelude.ss")
|
||||
(load "host/chez/post-prelude.ss")
|
||||
(set-chez-ns! "user")
|
||||
(load "host/chez/host-contract.ss")
|
||||
(load "host/chez/seed/image.ss")
|
||||
(load "host/chez/compile-eval.ss")
|
||||
|
||||
(define analyze (var-deref "jolt.analyzer" "analyze"))
|
||||
(define emit (var-deref "jolt.backend-scheme" "emit"))
|
||||
(define kw (lambda (n) (keyword #f n)))
|
||||
(define (evals src) (jolt-compile-eval (string-append "(do " src ")") "user"))
|
||||
|
||||
(evals "(defrecord Vec3 [x y z])")
|
||||
(evals "(def a (->Vec3 10 20 30))")
|
||||
|
||||
;; emit (:KEY a [default]) with arg 0 marked as a Vec3 struct receiver.
|
||||
(define (mark-emit src)
|
||||
(let* ((ir (analyze (make-analyze-ctx "user") (jolt-ce-read src)))
|
||||
(a0 (jolt-nth (jolt-get ir (kw "args")) 0))
|
||||
(marked (jolt-assoc a0 (kw "hint") (kw "struct")
|
||||
(kw "shape") (jolt-vector (kw "x") (kw "y") (kw "z"))))
|
||||
(args (jolt-get ir (kw "args")))
|
||||
(args2 (jolt-assoc args 0 marked)))
|
||||
(emit (jolt-assoc ir (kw "args") args2))))
|
||||
|
||||
(define (run-emit scm) (eval (read (open-input-string scm)) (interaction-environment)))
|
||||
(define (has-sub? s sub)
|
||||
(let ((n (string-length s)) (m (string-length sub)))
|
||||
(let loop ((i 0)) (cond ((> (+ i m) n) #f)
|
||||
((string=? (substring s i (+ i m)) sub) #t)
|
||||
(else (loop (+ i 1)))))))
|
||||
(define fails 0) (define total 0)
|
||||
(define (check label actual expected)
|
||||
(set! total (+ total 1))
|
||||
(unless (equal? actual expected)
|
||||
(set! fails (+ fails 1))
|
||||
(printf " FAIL ~a: got ~s expected ~s\n" label actual expected)))
|
||||
|
||||
;; a declared field -> bare-index path, value matches jolt-get
|
||||
(let ((e (mark-emit "(:y a)")))
|
||||
(check "declared field uses jrec-field-at" (has-sub? e "jrec-field-at") #t)
|
||||
(check "field 1 -> static slot 1" (has-sub? e " 1 ") #t)
|
||||
(check "bare read == jolt-get" (run-emit e) (evals "(:y a)"))) ; 20
|
||||
|
||||
;; first/last fields too
|
||||
(check "field x == jolt-get" (run-emit (mark-emit "(:x a)")) (evals "(:x a)")) ; 10
|
||||
(check "field z == jolt-get" (run-emit (mark-emit "(:z a)")) (evals "(:z a)")) ; 30
|
||||
|
||||
;; a key that is NOT a declared field -> no bare path, still correct (nil)
|
||||
(let ((e (mark-emit "(:w a)")))
|
||||
(check "non-field key no jrec-field-at" (has-sub? e "jrec-field-at") #f)
|
||||
(check "non-field key == jolt-get" (run-emit e) (evals "(:w a)"))) ; nil
|
||||
|
||||
;; a default-arg form keeps jolt-get (the bare path is no-default only)
|
||||
(let ((e (mark-emit "(:y a 99)")))
|
||||
(check "default-arg keeps jolt-get" (has-sub? e "jrec-field-at") #f))
|
||||
|
||||
(if (= fails 0)
|
||||
(begin (printf "fieldread gate: ~a/~a passed\n" total total) (exit 0))
|
||||
(begin (printf "fieldread gate: ~a/~a passed (~a failed)\n" (- total fails) total fails) (exit 1)))
|
||||
File diff suppressed because one or more lines are too long
Loading…
Add table
Add a link
Reference in a new issue