fd subsystem: instance? name-boundary + ~ reads as clojure.core/unquote
Two general fixes that clear core.logic's finite-domain -difference, safefd, and the defne quoted-list patterns (form->ast), taking the suite to 532/5/0. - instance? on a deftype matched a simple type name against the qualified tag by raw string suffix, so "a.b.MultiIntervalFD" tested true for IntervalFD. The suffix must land on a "." boundary. core.logic's fd dispatches on (interval? x) = (instance? IntervalFD x), and a MultiIntervalFD wrongly counted as an interval, so -difference/safefd computed the wrong set. - the reader reads ~ / ~@ as clojure.core/unquote(-splicing), like the JVM reader, instead of a bare unquote. Code that inspects quoted pattern/template data — core.logic's defne checks (= f 'clojure.core/unquote) — now sees the symbol it expects, so '(fn ~args . ~body) patterns compile. hc-head-is? accepts the qualified head in syntax-quote lowering; the value-preserving change leaves the minted seed byte-identical. corpus.edn: 2 JVM-certified unquote rows. unit.edn: two reader rows updated to the qualified unquote. make test + shakesmoke green, 0 new divergences, self-host holds.
This commit is contained in:
parent
42c163bacb
commit
f46772d576
5 changed files with 22 additions and 7 deletions
|
|
@ -298,10 +298,15 @@
|
||||||
;; Any seq counts, not just a proper list: a macro that builds the template with
|
;; Any seq counts, not just a proper list: a macro that builds the template with
|
||||||
;; map/for (e.g. deftype's rewrite-set) yields a LAZY seq, and its ~unquotes must
|
;; map/for (e.g. deftype's rewrite-set) yields a LAZY seq, and its ~unquotes must
|
||||||
;; still be recognized.
|
;; still be recognized.
|
||||||
|
;; head symbol matches name nm, bare or clojure.core-qualified — the reader
|
||||||
|
;; produces clojure.core/unquote(-splicing) for ~/~@ (JVM parity), and this is
|
||||||
|
;; only used to spot those heads in syntax-quote templates.
|
||||||
(define (hc-head-is? x nm)
|
(define (hc-head-is? x nm)
|
||||||
(and (cseq? x)
|
(and (cseq? x)
|
||||||
(let ((h (seq-first x)))
|
(let ((h (seq-first x)))
|
||||||
(and (symbol-t? h) (jolt-nil? (hc-sym-ns h)) (string=? (symbol-t-name h) nm)))))
|
(and (symbol-t? h) (string=? (symbol-t-name h) nm)
|
||||||
|
(let ((ns (hc-sym-ns h)))
|
||||||
|
(or (jolt-nil? ns) (and (string? ns) (string=? ns "clojure.core"))))))))
|
||||||
(define (hc-second x) (seq-first (jolt-seq (seq-more x))))
|
(define (hc-second x) (seq-first (jolt-seq (seq-more x))))
|
||||||
|
|
||||||
(define (hc-sq-symbol ctx form gsmap)
|
(define (hc-sq-symbol ctx form gsmap)
|
||||||
|
|
|
||||||
|
|
@ -93,8 +93,13 @@
|
||||||
((jrec? val)
|
((jrec? val)
|
||||||
(let ((tag (jrec-tag val)))
|
(let ((tag (jrec-tag val)))
|
||||||
(or (string=? tag tname)
|
(or (string=? tag tname)
|
||||||
(and (> (string-length tag) (string-length tname))
|
;; a simple name matches a qualified tag only at a `.` boundary:
|
||||||
(string=? (substring tag (- (string-length tag) (string-length tname)) (string-length tag)) tname))
|
;; "a.b.IntervalFD" is an IntervalFD, but "a.b.MultiIntervalFD" is NOT
|
||||||
|
;; (a raw string-suffix would wrongly match the latter).
|
||||||
|
(let ((tl (string-length tag)) (nl (string-length tname)))
|
||||||
|
(and (fx>? tl nl)
|
||||||
|
(char=? (string-ref tag (fx- (fx- tl nl) 1)) #\.)
|
||||||
|
(string=? (substring tag (fx- tl nl) tl) tname)))
|
||||||
;; a protocol/interface the type implements (defprotocol generates an
|
;; a protocol/interface the type implements (defprotocol generates an
|
||||||
;; interface; (instance? SomeProtocol record) is true when the record
|
;; interface; (instance? SomeProtocol record) is true when the record
|
||||||
;; implements it — core.match dispatches on instance? IPatternCompile).
|
;; implements it — core.match dispatches on instance? IPatternCompile).
|
||||||
|
|
|
||||||
|
|
@ -589,10 +589,13 @@
|
||||||
(jolt-list (jolt-symbol #f "syntax-quote") form))
|
(jolt-list (jolt-symbol #f "syntax-quote") form))
|
||||||
j)))
|
j)))
|
||||||
((char=? c #\@) (rdr-wrap s (+ i 1) end (jolt-symbol "clojure.core" "deref")))
|
((char=? c #\@) (rdr-wrap s (+ i 1) end (jolt-symbol "clojure.core" "deref")))
|
||||||
|
;; ~ / ~@ read as clojure.core/unquote(-splicing), like the JVM reader —
|
||||||
|
;; so code that inspects pattern/template data (core.logic's defne) sees
|
||||||
|
;; the qualified symbol it expects.
|
||||||
((char=? c #\~)
|
((char=? c #\~)
|
||||||
(if (and (< (+ i 1) end) (char=? (string-ref s (+ i 1)) #\@))
|
(if (and (< (+ i 1) end) (char=? (string-ref s (+ i 1)) #\@))
|
||||||
(rdr-wrap s (+ i 2) end (jolt-symbol #f "unquote-splicing"))
|
(rdr-wrap s (+ i 2) end (jolt-symbol "clojure.core" "unquote-splicing"))
|
||||||
(rdr-wrap s (+ i 1) end (jolt-symbol #f "unquote"))))
|
(rdr-wrap s (+ i 1) end (jolt-symbol "clojure.core" "unquote"))))
|
||||||
((char=? c #\^)
|
((char=? c #\^)
|
||||||
(let-values (((mform j) (rdr-read-form s (+ i 1) end)))
|
(let-values (((mform j) (rdr-read-form s (+ i 1) end)))
|
||||||
(let-values (((target k) (rdr-read-form s j end)))
|
(let-values (((target k) (rdr-read-form s j end)))
|
||||||
|
|
|
||||||
|
|
@ -3347,4 +3347,6 @@
|
||||||
{:suite "special forms / qualified" :label "clojure.core-qualified special form (from syntax-quote)" :expected "[:g 9]" :actual "(clojure.core/letfn [(g [x] [:g x])] (g 9))"}
|
{:suite "special forms / qualified" :label "clojure.core-qualified special form (from syntax-quote)" :expected "[:g 9]" :actual "(clojure.core/letfn [(g [x] [:g x])] (g 9))"}
|
||||||
{:suite "symbols / interning" :label "(str sym) is the symbol's interned name (identity-stable)" :expected "[true true]" :actual "(let [s (quote ?a)] [(identical? (name s) (str s)) (= (str s) \"?a\")])"}
|
{:suite "symbols / interning" :label "(str sym) is the symbol's interned name (identity-stable)" :expected "[true true]" :actual "(let [s (quote ?a)] [(identical? (name s) (str s)) (= (str s) \"?a\")])"}
|
||||||
{:suite "symbols / interning" :label "equal symbols share an interned name string" :expected "true" :actual "(let [a (quote ?foo) b (quote ?foo)] (identical? (name a) (name b)))"}
|
{:suite "symbols / interning" :label "equal symbols share an interned name string" :expected "true" :actual "(let [a (quote ?foo) b (quote ?foo)] (identical? (name a) (name b)))"}
|
||||||
|
{:suite "reader / unquote" :label "~x reads as clojure.core/unquote" :expected "true" :actual "(= (quote (clojure.core/unquote v)) (read-string \"~v\"))"}
|
||||||
|
{:suite "reader / unquote" :label "~@x reads as clojure.core/unquote-splicing" :expected "clojure.core/unquote-splicing" :actual "(first (read-string \"~@xs\"))"}
|
||||||
]
|
]
|
||||||
|
|
|
||||||
|
|
@ -323,8 +323,8 @@
|
||||||
{:suite "reader" :expr "(= [1 [2 3] {:k :v}] (read-string \"[1 [2 3] {:k :v}]\"))" :expected "true"}
|
{:suite "reader" :expr "(= [1 [2 3] {:k :v}] (read-string \"[1 [2 3] {:k :v}]\"))" :expected "true"}
|
||||||
{:suite "reader" :expr "(= (quote (quote x)) (read-string \"'x\"))" :expected "true"}
|
{:suite "reader" :expr "(= (quote (quote x)) (read-string \"'x\"))" :expected "true"}
|
||||||
{:suite "reader" :expr "(= (quote (clojure.core/deref a)) (read-string \"@a\"))" :expected "true"}
|
{:suite "reader" :expr "(= (quote (clojure.core/deref a)) (read-string \"@a\"))" :expected "true"}
|
||||||
{:suite "reader" :expr "(= (quote (syntax-quote (a (unquote b)))) (read-string \"`(a ~b)\"))" :expected "true"}
|
{:suite "reader" :expr "(= (quote (syntax-quote (a (clojure.core/unquote b)))) (read-string \"`(a ~b)\"))" :expected "true"}
|
||||||
{:suite "reader" :expr "(= (quote (unquote-splicing xs)) (read-string \"~@xs\"))" :expected "true"}
|
{:suite "reader" :expr "(= (quote (clojure.core/unquote-splicing xs)) (read-string \"~@xs\"))" :expected "true"}
|
||||||
{:suite "reader" :expr "(= 42 (read-string \"; comment\\n42\"))" :expected "true"}
|
{:suite "reader" :expr "(= 42 (read-string \"; comment\\n42\"))" :expected "true"}
|
||||||
{:suite "reader" :expr "(= [1 2] (read-string \"[1 #_ 9 2]\"))" :expected "true"}
|
{:suite "reader" :expr "(= [1 2] (read-string \"[1 #_ 9 2]\"))" :expected "true"}
|
||||||
{:suite "reader" :expr "(nil? (read-string \"\"))" :expected "true"}
|
{:suite "reader" :expr "(nil? (read-string \"\"))" :expected "true"}
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue