Chez parity: trailing-apostrophe symbols + arglist return hints (jolt-vgrp, jolt-5540)
Two Chez reader bugs, both JVM-parity gaps: inc'/+'/foo' (trailing apostrophe) were mis-read as a symbol followed by a quote macro, because the reader treated ' as a terminator. In Clojure ' is a NON-terminating macro char (constituent after the first char). Since the seed is minted on Chez, (def inc' inc) became (def inc 'inc), clobbering inc's var cell with its own symbol -- so (var-get (var inc)) returned the symbol, not the fn. Drop ' from the token terminator set; a leading ' still quotes. ^bytes [b] / ^String [x y] return-type hints: the Chez reader lowered ^meta on a collection to a (with-meta vec meta) form, but emitted a QUALIFIED clojure.core/with-meta while the Janet reader emits a bare with-meta -- so the fn/defn macros' unwrap logic (matching the bare head) slipped past it and choked on a non-vector arglist. Emit bare with-meta to match Janet, and unwrap a (with-meta <vec> _) arglist in analyze-fn as a backstop. Re-minted the seed. zero-janet 2699, prelude 2652, Janet gate 155/0, fixpoint 10/10, bootstrap 6/6, all 0 new divergences.
This commit is contained in:
parent
53a189541c
commit
eb1c3298a4
5 changed files with 53 additions and 25 deletions
|
|
@ -36,9 +36,13 @@
|
||||||
(define (rdr-ws? c)
|
(define (rdr-ws? c)
|
||||||
(or (char-whitespace? c) (char=? c #\,)))
|
(or (char-whitespace? c) (char=? c #\,)))
|
||||||
|
|
||||||
|
;; `'` (apostrophe) is a NON-terminating macro char in Clojure (isTerminatingMacro
|
||||||
|
;; is false for it), so it's a valid symbol constituent after the first char:
|
||||||
|
;; inc'/+'/foo' read as single symbols. A LEADING ' still dispatches as quote
|
||||||
|
;; (handled before token reading begins). Omit it from the terminator set.
|
||||||
(define (rdr-terminator? c)
|
(define (rdr-terminator? c)
|
||||||
(or (rdr-ws? c)
|
(or (rdr-ws? c)
|
||||||
(memv c '(#\( #\) #\[ #\] #\{ #\} #\" #\; #\@ #\^ #\' #\` #\~ #\\))))
|
(memv c '(#\( #\) #\[ #\] #\{ #\} #\" #\; #\@ #\^ #\` #\~ #\\))))
|
||||||
|
|
||||||
(define (rdr-digit? c) (and (char>=? c #\0) (char<=? c #\9)))
|
(define (rdr-digit? c) (and (char>=? c #\0) (char<=? c #\9)))
|
||||||
|
|
||||||
|
|
@ -283,8 +287,11 @@
|
||||||
;; non-symbol target (a collection): lower to a runtime (with-meta form meta)
|
;; non-symbol target (a collection): lower to a runtime (with-meta form meta)
|
||||||
;; the analyzer compiles like any invoke — same as the Janet reader, so e.g.
|
;; the analyzer compiles like any invoke — same as the Janet reader, so e.g.
|
||||||
;; (meta ^{:tag :int} [1 2]) and ^:foo {} carry their meta at runtime. The meta
|
;; (meta ^{:tag :int} [1 2]) and ^:foo {} carry their meta at runtime. The meta
|
||||||
;; pmap doubles as its own map-literal form.
|
;; pmap doubles as its own map-literal form. Use the BARE `with-meta` symbol
|
||||||
(jolt-list (jolt-symbol "clojure.core" "with-meta") target meta)))
|
;; (ns #f) to match the Janet reader exactly — the fn/defn macros unwrap a
|
||||||
|
;; (with-meta <arglist-vec> _) return-hint by matching the unqualified head,
|
||||||
|
;; so a qualified clojure.core/with-meta would slip past them (^bytes [b]).
|
||||||
|
(jolt-list (jolt-symbol #f "with-meta") target meta)))
|
||||||
|
|
||||||
;; --- # dispatch -------------------------------------------------------------
|
;; --- # dispatch -------------------------------------------------------------
|
||||||
;; #(...) anonymous fn shorthand (jolt-qjr0): % -> p1, %N -> pN, %& -> rest. The
|
;; #(...) anonymous fn shorthand (jolt-qjr0): % -> p1, %N -> pN, %& -> rest. The
|
||||||
|
|
|
||||||
File diff suppressed because one or more lines are too long
|
|
@ -495,15 +495,15 @@
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "ifn?" (letrec ((ifn? (lambda (x) (let fnrec882 ((x x)) (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "fn?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "keyword?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "symbol?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "map?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "set?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "vector?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "clojure.core" "var?") x))))))))))))))))) ifn?)))
|
(def-var! "clojure.core" "ifn?" (letrec ((ifn? (lambda (x) (let fnrec882 ((x x)) (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "fn?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "keyword?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "symbol?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "map?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "set?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "vector?") x))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "clojure.core" "var?") x))))))))))))))))) ifn?)))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "+" (jolt-symbol #f "+")))
|
(def-var! "clojure.core" "+'" jolt-add))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "-" (jolt-symbol #f "-")))
|
(def-var! "clojure.core" "-'" jolt-sub))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "*" (jolt-symbol #f "*")))
|
(def-var! "clojure.core" "*'" jolt-mul))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "inc" (jolt-symbol #f "inc")))
|
(def-var! "clojure.core" "inc'" jolt-inc))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "dec" (jolt-symbol #f "dec")))
|
(def-var! "clojure.core" "dec'" jolt-dec))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
(def-var! "clojure.core" "unchecked-add" (letrec ((unchecked-add (lambda (x y) (let fnrec883 ((x x) (y y)) (+ x y))))) unchecked-add)))
|
(def-var! "clojure.core" "unchecked-add" (letrec ((unchecked-add (lambda (x y) (let fnrec883 ((x x) (y y)) (+ x y))))) unchecked-add)))
|
||||||
(guard (e (#t #f))
|
(guard (e (#t #f))
|
||||||
|
|
|
||||||
|
|
@ -136,11 +136,28 @@
|
||||||
;; but keeps a fixed arity a nil-free struct rather than a phm.
|
;; but keeps a fixed arity a nil-free struct rather than a phm.
|
||||||
(if rst (assoc arity :rest rst) arity)))
|
(if rst (assoc arity :rest rst) arity)))
|
||||||
|
|
||||||
|
;; A reader that lowers ^meta on a collection to a runtime (with-meta <coll> <meta>)
|
||||||
|
;; form (the Chez data reader) wraps an arglist vector carrying a return-type hint
|
||||||
|
;; (^bytes [b] / ^String [x y]). Unwrap to the underlying vector so fn parsing sees
|
||||||
|
;; the params — the hint is ignored at runtime. Only the (with-meta <vec> _) shape
|
||||||
|
;; matches, so a real arity clause (head is a vector) and the Janet reader's
|
||||||
|
;; meta-on-tuple (already a vector) pass through unchanged.
|
||||||
|
(defn- strip-arglist-meta [form]
|
||||||
|
(if (form-list? form)
|
||||||
|
(let [es (vec (form-elements form))]
|
||||||
|
(if (and (= 3 (count es))
|
||||||
|
(form-sym? (first es))
|
||||||
|
(= "with-meta" (form-sym-name (first es)))
|
||||||
|
(form-vec? (nth es 1)))
|
||||||
|
(nth es 1)
|
||||||
|
form))
|
||||||
|
form))
|
||||||
|
|
||||||
(defn- analyze-fn [ctx items env]
|
(defn- analyze-fn [ctx items env]
|
||||||
(let [named (form-sym? (nth items 1))
|
(let [named (form-sym? (nth items 1))
|
||||||
fn-name (when named (form-sym-name (nth items 1)))
|
fn-name (when named (form-sym-name (nth items 1)))
|
||||||
rest-items (if named (drop 2 items) (drop 1 items))
|
rest-items (if named (drop 2 items) (drop 1 items))
|
||||||
first* (first rest-items)]
|
first* (strip-arglist-meta (first rest-items))]
|
||||||
(cond
|
(cond
|
||||||
(form-vec? first*)
|
(form-vec? first*)
|
||||||
(fn-node fn-name [(analyze-arity ctx first* (rest rest-items) env fn-name)])
|
(fn-node fn-name [(analyze-arity ctx first* (rest rest-items) env fn-name)])
|
||||||
|
|
@ -148,7 +165,7 @@
|
||||||
(fn-node fn-name
|
(fn-node fn-name
|
||||||
(mapv (fn [clause]
|
(mapv (fn [clause]
|
||||||
(let [cl (vec (form-elements clause))]
|
(let [cl (vec (form-elements clause))]
|
||||||
(analyze-arity ctx (first cl) (rest cl) env fn-name)))
|
(analyze-arity ctx (strip-arglist-meta (first cl)) (rest cl) env fn-name)))
|
||||||
rest-items))
|
rest-items))
|
||||||
:else (uncompilable "fn: bad params"))))
|
:else (uncompilable "fn: bad params"))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -203,7 +203,9 @@
|
||||||
(when (os/getenv "JOLT_DUMP_CRASH_LABELS")
|
(when (os/getenv "JOLT_DUMP_CRASH_LABELS")
|
||||||
(printf "\nCRASH LABELS:")
|
(printf "\nCRASH LABELS:")
|
||||||
(each [l k] (sort-by (fn [pair] (get pair 1)) crashes)
|
(each [l k] (sort-by (fn [pair] (get pair 1)) crashes)
|
||||||
(printf " [%s] :: %s" k l)))
|
(printf " [%s] :: %s" k l))
|
||||||
|
(printf "\nKNOWN-HIT LABELS:")
|
||||||
|
(each l (sort known-hit) (printf " %s" l)))
|
||||||
(when (> (length diverged) 0)
|
(when (> (length diverged) 0)
|
||||||
(printf "\nNEW divergences (ran, wrong value) — gate FAILS:")
|
(printf "\nNEW divergences (ran, wrong value) — gate FAILS:")
|
||||||
(each [l m] (slice diverged 0 (min 40 (length diverged)))
|
(each [l m] (slice diverged 0 (min 40 (length diverged)))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue