General fixes shaken out by running core.logic's test suite
Running clojure/core.logic's own suite surfaced a batch of general jolt gaps.
None are core.logic-specific; each is a language/host behavior that was wrong or
missing. With these, the core relational engine (unify, run/fresh/conde,
conso/membero/appendo, reification to _0/_1, lcons) runs; the remaining failures
are in core.logic's constraint-logic-programming and finite-domain layers
(tracked separately).
- analyzer: accept the list-member dot form (. target (method args)), sugar for
(. target method args). Re-mint.
- identical? is reference identity (eq?), not value equality. It was aliased to =,
which infinite-loops when a deftype's .equals short-circuits on (identical? this o)
(core.logic's Substitutions) and is wrong for distinct equal collections.
- jrecs use a deftype's declared hashCode/equals/equiv for map/set keying instead
of structural field comparison, so metadata-wrapped keys still match (core.logic
keys substitutions on lvar id, ignoring metadata).
- meta/with-meta dispatch to a deftype's clojure.lang.IObj meta/withMeta methods
when present, so metadata threaded through the type's own assoc/withMeta survives
(previously kept in an identity side-table the reconstructed instances didn't share).
- coll?/seqable? on a deftype require IPersistentCollection (cons) or ISeq (first);
ILookup(valAt)/Indexed(nth)/Counted(count)/Seqable(seq) alone no longer qualify,
matching the JVM.
- syntax-quote resolves a bare symbol to the compile ns's own def before
clojure.core, so a name the ns excluded and redefined (core.logic's == after
:refer-clojure :exclude) qualifies correctly in macro output.
- reader: record literals #ns.Type{...} / #ns.Type[...] expand to the map->/->
factory call.
- structmap API: defstruct/create-struct/struct-map/struct/accessor (map-backed,
insertion-ordered). Re-mint.
- .hashCode on strings/symbols (Java String.hashCode, Symbol Util.hashCombine);
Class.isInstance; java.util.Collection.contains over vector/list/set;
clojure.lang.RT/nextID and clojure.lang.Util hash/hasheq/equiv/identical statics.
corpus.edn: 8 JVM-certified rows. unit.edn: a Counted+Seqable deftype is coll?=false
(was a stale expectation encoding the old behavior).
This commit is contained in:
parent
af91dbbaa6
commit
9dbfd7e5c1
16 changed files with 748 additions and 577 deletions
|
|
@ -320,6 +320,12 @@
|
|||
;; a class token, not a var to namespace-qualify — leave it bare, as
|
||||
;; Clojure's syntax-quote resolves it to the class.
|
||||
((hc-fq-class-name? nm) form)
|
||||
;; the compile ns's OWN def shadows clojure.core — a name the ns
|
||||
;; excluded and redefined (e.g. core.logic's `==` after
|
||||
;; (:refer-clojure :exclude [==])), or any ns-local redefinition.
|
||||
;; Referred names live in a separate table, so this only hits a real
|
||||
;; local intern, matching how the analyzer resolves the bare symbol.
|
||||
((var-cell-lookup (chez-actx-cns ctx) nm) (jolt-symbol (chez-actx-cns ctx) nm))
|
||||
((var-cell-lookup "clojure.core" nm) (jolt-symbol "clojure.core" nm))
|
||||
;; a name referred into the compile ns (:require :refer / :use :only)
|
||||
;; qualifies to its SOURCE ns, not the compile ns — so a macro that
|
||||
|
|
|
|||
|
|
@ -38,6 +38,17 @@
|
|||
((or (string=? name "get") (string=? name "valAt"))
|
||||
(list (apply jolt-get obj args)))
|
||||
((string=? name "containsKey") (list (jolt-contains? obj (car args))))
|
||||
;; java.util.Collection.contains(o): VALUE membership (a set is O(1) via
|
||||
;; contains?; a list/vector/seq is a linear scan — contains? on a vector tests
|
||||
;; an index, so it is wrong here).
|
||||
((string=? name "contains")
|
||||
(list (if (pset? obj)
|
||||
(jolt-contains? obj (car args))
|
||||
(let ((x (car args)))
|
||||
(let loop ((s (jolt-seq obj)))
|
||||
(cond ((jolt-nil? s) #f)
|
||||
((jolt=2 (seq-first s) x) #t)
|
||||
(else (loop (jolt-seq (seq-more s))))))))))
|
||||
((string=? name "size") (list (jolt-count obj)))
|
||||
((string=? name "isEmpty") (list (jolt-empty? obj)))
|
||||
;; java.util.Map views: keySet (a Set), values (a Collection), entrySet.
|
||||
|
|
|
|||
|
|
@ -745,6 +745,9 @@
|
|||
(cons "toString" (lambda (self) (string-append "class " (jclass-name self))))
|
||||
(cons "isArray" (lambda (self) (let ((n (jclass-name self)))
|
||||
(and (fx>? (string-length n) 0) (char=? (string-ref n 0) #\[)))))
|
||||
;; Class.isInstance(o) == (instance? class o); core.logic's deftype .equals
|
||||
;; uses (.. this getClass (isInstance o)).
|
||||
(cons "isInstance" (lambda (self o) (if (instance-check self o) #t #f)))
|
||||
(cons "getClass" (lambda (self) (make-class-obj "java.lang.Class")))))
|
||||
|
||||
;; (jolt.host/table? x) — is x a host tagged-table?
|
||||
|
|
|
|||
|
|
@ -460,6 +460,25 @@
|
|||
;; is how libraries reach Clojure's base loader, e.g. aws-api's resources ns).
|
||||
(register-class-statics! "RT" (list (cons "baseLoader" (lambda () the-classloader))))
|
||||
(register-class-statics! "clojure.lang.RT" (list (cons "baseLoader" (lambda () the-classloader))))
|
||||
;; clojure.lang.RT/nextID — process-unique increasing id (AtomicInteger(1)
|
||||
;; getAndIncrement), used by id generators such as core.logic's lvar.
|
||||
(define rt-next-id-counter 1)
|
||||
(define (rt-next-id)
|
||||
(let ((v rt-next-id-counter))
|
||||
(set! rt-next-id-counter (+ rt-next-id-counter 1))
|
||||
v))
|
||||
(register-class-statics! "RT" (list (cons "nextID" rt-next-id)))
|
||||
(register-class-statics! "clojure.lang.RT" (list (cons "nextID" rt-next-id)))
|
||||
;; clojure.lang.Util — hash/equality helpers libraries call directly (core.logic's
|
||||
;; LCons.hashCode uses Util/hash). hash = Java hashCode (0 for nil); hasheq = the
|
||||
;; value hash jolt's = uses; equiv = value equality; identical = reference identity.
|
||||
(let ((util-statics
|
||||
(list (cons "hash" (lambda (x) (if (jolt-nil? x) 0 (record-method-dispatch x "hashCode" jolt-nil))))
|
||||
(cons "hasheq" (lambda (x) (jolt-hash x)))
|
||||
(cons "equiv" (lambda (a b) (if (jolt= a b) #t #f)))
|
||||
(cons "identical" (lambda (a b) (if (eq? a b) #t #f))))))
|
||||
(register-class-statics! "Util" util-statics)
|
||||
(register-class-statics! "clojure.lang.Util" util-statics))
|
||||
;; Thread/currentThread -> a fresh thread jhost wrapping THIS thread's interrupt
|
||||
;; flag (the box from current-interrupt-box, host-static.ss), so .interrupt from
|
||||
;; any thread sets the target thread's flag and .isInterrupted reads it without
|
||||
|
|
|
|||
|
|
@ -108,10 +108,30 @@
|
|||
((string=? cs "utf-32le") (string->utf32 s (endianness little)))
|
||||
(else (string->utf8 s)))))
|
||||
|
||||
;; Object.hashCode parity: Java's specified String hash and Clojure's Symbol hash
|
||||
;; (Util.hashCombine), so (.hashCode s) / (.hashCode sym) match the JVM. 32-bit int.
|
||||
(define (jolt-u32 x) (bitwise-and x #xFFFFFFFF))
|
||||
(define (jolt-s32 x) (let ((m (jolt-u32 x))) (if (>= m #x80000000) (- m #x100000000) m)))
|
||||
(define (java-string-hash s)
|
||||
(let ((n (string-length s)))
|
||||
(let loop ((i 0) (h 0))
|
||||
(if (fx<? i n)
|
||||
(loop (fx+ i 1) (jolt-s32 (+ (* 31 h) (char->integer (string-ref s i)))))
|
||||
(jolt-s32 h)))))
|
||||
(define (java-hash-combine seed hash)
|
||||
(let* ((su (jolt-u32 seed))
|
||||
(sl (bitwise-arithmetic-shift-left su 6))
|
||||
(sr (bitwise-arithmetic-shift-right (jolt-s32 su) 2))
|
||||
(add (+ (jolt-u32 hash) #x9e3779b9 sl sr)))
|
||||
(jolt-s32 (bitwise-xor su (jolt-u32 add)))))
|
||||
(define (java-symbol-hash name ns)
|
||||
(java-hash-combine (java-string-hash name) (if ns (java-string-hash ns) 0)))
|
||||
|
||||
(define (jolt-string-method method s rest)
|
||||
(define (arg n) (list-ref rest n))
|
||||
(cond
|
||||
((string=? method "toString") s)
|
||||
((string=? method "hashCode") (java-string-hash s))
|
||||
((string=? method "toLowerCase") (ascii-string-down s))
|
||||
((string=? method "toUpperCase") (ascii-string-up s))
|
||||
((string=? method "trim") (str-trim s))
|
||||
|
|
|
|||
|
|
@ -22,6 +22,11 @@
|
|||
(jolt-assoc (if user user (jolt-hash-map))
|
||||
jolt-kw-var-ns (var-cell-ns x)
|
||||
jolt-kw-var-name (var-cell-name x))))
|
||||
;; a deftype implementing clojure.lang.IObj stores meta in a field and threads
|
||||
;; it through its own assoc/withMeta (core.logic's Substitutions/LVar/LCons),
|
||||
;; so dispatch to its meta method rather than the identity side-table — which
|
||||
;; the deftype's reconstructed instances would not share.
|
||||
((and (jrec? x) (jrec-cl x "meta")) => (lambda (m) (jolt-invoke m x)))
|
||||
((or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x) (jolt-lazyseq? x) (jrec? x) (jreify? x) (procedure? x))
|
||||
(hashtable-ref meta-table x jolt-nil))
|
||||
(else jolt-nil)))
|
||||
|
|
@ -53,6 +58,9 @@
|
|||
(define (jolt-with-meta x m)
|
||||
(cond
|
||||
((symbol-t? x) (make-symbol-t (symbol-t-ns x) (symbol-t-name x) m))
|
||||
;; a deftype with an explicit clojure.lang.IObj withMeta carries meta in a
|
||||
;; field; dispatch to it (see jolt-meta) so the meta survives reconstruction.
|
||||
((and (jrec? x) (jrec-cl x "withMeta")) => (lambda (meth) (jolt-invoke meth x m)))
|
||||
((or (pvec? x) (pmap? x) (pset? x) (cseq? x) (empty-list-t? x) (jolt-lazyseq? x) (jrec? x) (jreify? x) (procedure? x))
|
||||
(let ((c (meta-copy x)))
|
||||
(if (jolt-nil? m) (hashtable-delete! meta-table c) (hashtable-set! meta-table c m))
|
||||
|
|
|
|||
|
|
@ -182,9 +182,12 @@
|
|||
(if (jolt-nil? s) jolt-empty-list
|
||||
(list->cseq (list-sort less? (seq->list s))))))
|
||||
|
||||
;; identical?: jolt reference identity, defined as (= a b) over the
|
||||
;; value model, where interned keywords/small values compare equal.
|
||||
(define (jolt-identical? a b) (jolt= a b))
|
||||
;; identical?: reference identity (Clojure ==). eq? gives pointer identity over
|
||||
;; the value model — interned keywords/fixnums/nil compare equal, distinct
|
||||
;; collections do not. Must NOT be value equality: a deftype whose .equals calls
|
||||
;; (identical? this o) to short-circuit (e.g. core.logic's Substitutions) would
|
||||
;; otherwise recur forever (identical? -> = -> equiv -> .equals -> identical?).
|
||||
(define (jolt-identical? a b) (eq? a b))
|
||||
|
||||
;; Give the seq.ss native procedures their transducer (1-arg) arity — the emitter
|
||||
;; lowers (map f)/(filter p)/(take n) at the wrong arity to the bare procedure
|
||||
|
|
|
|||
|
|
@ -455,6 +455,30 @@
|
|||
(values (cadr xs) j)))
|
||||
(else (loop (cddr xs)))))))))
|
||||
|
||||
(define (rdr-string-rindex-char str c)
|
||||
(let loop ((i (- (string-length str) 1)))
|
||||
(cond ((< i 0) #f) ((char=? (string-ref str i) c) i) (else (loop (- i 1))))))
|
||||
|
||||
;; A record/type literal tag (#ns.Type{..} / #ns.Type[..]) is any tag containing
|
||||
;; a dot — Clojure routes those to a constructor instead of a data reader.
|
||||
(define (rdr-record-tag? tok) (and (rdr-string-rindex-char tok #\.) #t))
|
||||
|
||||
;; #a.b.C{..} -> (a.b/map->C {..}); #a.b.C[..] -> (a.b/->C ..). The factory call
|
||||
;; compiles like any invoke; defrecord interns map->C/->C in the type's ns.
|
||||
(define (rdr-record-ctor-form tok form)
|
||||
(let* ((di (rdr-string-rindex-char tok #\.))
|
||||
(ns (substring tok 0 di))
|
||||
(simple (substring tok (+ di 1) (string-length tok))))
|
||||
(cond
|
||||
((pmap? form)
|
||||
(jolt-list (jolt-symbol ns (string-append "map->" simple)) form))
|
||||
((pvec? form)
|
||||
(apply jolt-list (jolt-symbol ns (string-append "->" simple))
|
||||
(vector->list (pvec-v form))))
|
||||
(else (jolt-throw (jolt-ex-info
|
||||
(string-append "Unreadable constructor form: #" tok)
|
||||
(empty-pmap)))))))
|
||||
|
||||
(define (rdr-read-dispatch s i end) ; i points just past the '#'
|
||||
(when (>= i end) (jolt-throw (jolt-ex-info "EOF after #" (empty-pmap))))
|
||||
(let ((c (string-ref s i)))
|
||||
|
|
@ -497,7 +521,9 @@
|
|||
(let-values (((tok j) (rdr-read-token s i end)))
|
||||
(let-values (((form k) (rdr-read-form s j end)))
|
||||
(when (rdr-eof? form) (jolt-throw (jolt-ex-info "EOF after #tag" (empty-pmap))))
|
||||
(values (rdr-make-tagged (keyword #f (string-append "#" tok)) form) k)))))))
|
||||
(if (rdr-record-tag? tok) ; #ns.Type{..}/[..] record literal
|
||||
(values (rdr-record-ctor-form tok form) k)
|
||||
(values (rdr-make-tagged (keyword #f (string-append "#" tok)) form) k))))))))
|
||||
|
||||
;; regex literal source: raw chars to the closing quote; \" is an escaped quote,
|
||||
;; every other backslash sequence is kept verbatim (regex engine semantics).
|
||||
|
|
|
|||
|
|
@ -52,11 +52,12 @@
|
|||
(and (jrec? x)
|
||||
(or (jrec-record? x)
|
||||
(let ((tag (jrec-tag x)))
|
||||
(or (find-method-any-protocol tag "seq")
|
||||
(find-method-any-protocol tag "count")
|
||||
(find-method-any-protocol tag "nth")
|
||||
(find-method-any-protocol tag "valAt")
|
||||
(find-method-any-protocol tag "cons"))))
|
||||
;; coll? is instance? IPersistentCollection — its marker is `cons`
|
||||
;; (and ISeq's `first`). ILookup(valAt) / Indexed(nth) / Counted(count)
|
||||
;; / Seqable(seq) alone do NOT make a value coll?, matching the JVM
|
||||
;; (e.g. core.logic's LVar implements only valAt and is not coll?).
|
||||
(or (find-method-any-protocol tag "cons")
|
||||
(find-method-any-protocol tag "first"))))
|
||||
#t))
|
||||
;; a jrec that is map? — a record, or a deftype implementing clojure.lang
|
||||
;; .IPersistentMap (clojure.core.cache's caches do). `without` (dissoc) is the
|
||||
|
|
@ -277,9 +278,20 @@
|
|||
(lambda (a b)
|
||||
(cond ((and (jrec? a) (jrec-cl a "equiv")) => (lambda (m) (if (jolt-truthy? (jolt-invoke m a b)) #t #f)))
|
||||
((and (jrec? b) (jrec-cl b "equiv")) => (lambda (m) (if (jolt-truthy? (jolt-invoke m b a)) #t #f)))
|
||||
;; a deftype with a custom Object.equals (but no equiv) governs
|
||||
;; its own value equality and map-key identity — core.logic's
|
||||
;; LVar/LCons key substitutions on id, ignoring metadata, so
|
||||
;; structural jrec=? (which sees the meta field) is wrong here.
|
||||
((and (jrec? a) (jrec-cl a "equals")) => (lambda (m) (if (jolt-truthy? (jolt-invoke m a b)) #t #f)))
|
||||
((and (jrec? b) (jrec-cl b "equals")) => (lambda (m) (if (jolt-truthy? (jolt-invoke m b a)) #t #f)))
|
||||
((and (jrec? a) (jrec? b)) (jrec=? a b))
|
||||
(else #f))))
|
||||
(register-hash-arm! jrec? jrec-hash)
|
||||
;; a deftype's declared hashCode governs its map/set hashing (paired with the
|
||||
;; equals/equiv above so the hash/eq contract holds); a plain record hashes its
|
||||
;; fields structurally via jrec-hash.
|
||||
(register-hash-arm! jrec?
|
||||
(lambda (x) (let ((m (jrec-cl x "hashCode")))
|
||||
(if m (jolt-invoke m x) (jrec-hash x)))))
|
||||
;; get on a jrec: a real field reads raw (so a deftype method's own field bindings,
|
||||
;; compiled to (get inst :field), never recurse); a NON-field key on a deftype that
|
||||
;; implements clojure.lang.ILookup routes to its valAt (core.match's pattern types
|
||||
|
|
@ -789,6 +801,8 @@
|
|||
(string-append (if (symbol-t-ns obj) (string-append (symbol-t-ns obj) "/") "")
|
||||
(symbol-t-name obj)))
|
||||
((string=? method-name "equals") (and (pair? rest) (jolt=2 obj (car rest))))
|
||||
((string=? method-name "hashCode")
|
||||
(java-symbol-hash (symbol-t-name obj) (symbol-t-ns obj)))
|
||||
(else (error #f (string-append "No method " method-name " on Symbol")))))
|
||||
;; clojure.lang.Namespace: name/getName yield the ns name as a Symbol (JVM:
|
||||
;; Namespace.name is a Symbol). clojure.spec.alpha reads (.name *ns*).
|
||||
|
|
@ -838,6 +852,14 @@
|
|||
((jolt=2 (seq-first s) target)
|
||||
(if last? (loop (jolt-seq (seq-more s)) (fx+ i 1) i) i))
|
||||
(else (loop (jolt-seq (seq-more s)) (fx+ i 1) found))))))
|
||||
;; java.util.Collection.contains over a list/seq (vectors/sets handle it in
|
||||
;; dot-coll-method): value membership, like the JVM.
|
||||
((string=? method-name "contains")
|
||||
(let ((target (car rest)))
|
||||
(let loop ((s (jolt-seq obj)))
|
||||
(cond ((jolt-nil? s) #f)
|
||||
((jolt=2 (seq-first s) target) #t)
|
||||
(else (loop (jolt-seq (seq-more s))))))))
|
||||
;; universal Object methods on any remaining value (boolean, etc.).
|
||||
((string=? method-name "toString") (jolt-str-render-one obj))
|
||||
((string=? method-name "hashCode") (jolt-hash obj))
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
Loading…
Add table
Add a link
Reference in a new issue