core.logic constraint layer: fixes for the CLP/unifier failures
Follow-on to the core.logic relational-engine work. These clear every crash in core.logic's constraint-logic-programming and unifier layers (33 errors -> 0) and most of the value mismatches; the suite goes 504 -> 523 passing assertions. All are general gaps, not core.logic-specific. - symbols intern their ns/name strings (JVM Symbol.intern .intern()s them): two separately-read `?a` symbols now share one name-string object. core.logic's non-unique lvars compare names by identity (via (str sym)), so without this a term's lvar and a constraint's lvar built from different `?a` reads never matched and constraints silently never fired. - (str x) of a single arg returns its rendering directly instead of copying through string-append, and a symbol stringifies to its (interned) name — JVM (str x) is x.toString(). Needed for the identity comparison above. - a clojure.core-qualified special form dispatches correctly: syntax-quote namespace-qualifies a macro like letfn to clojure.core/letfn (matching Clojure, where it's a macro), and the analyzer now maps that back to the special form instead of treating it as an invoke of a nil var. core.logic's fnc/defnc emit (clojure.core/letfn ...). Re-mint. - (disj nil ...) is nil (JVM), instead of crashing in the set path — core.logic's constraint store does (disj (get km v) id) where the get can be nil. corpus.edn: 4 JVM-certified rows. make test + shakesmoke green, 0 new divergences, self-host fixpoint holds.
This commit is contained in:
parent
36105ba702
commit
e6aa2aace7
6 changed files with 56 additions and 12 deletions
|
|
@ -27,6 +27,15 @@
|
|||
((and (flonum? v) (fl= v +inf.0)) "Infinity")
|
||||
((and (flonum? v) (fl= v -inf.0)) "-Infinity")
|
||||
((and (flonum? v) (not (fl= v v))) "NaN")
|
||||
;; a symbol stringifies to its name (JVM Symbol.toString returns the interned
|
||||
;; name), so (str sym) of a no-ns symbol is the SAME string object the symbol
|
||||
;; holds — code that compares those by identity (core.logic's non-unique lvar
|
||||
;; equality) depends on it.
|
||||
((symbol-t? v)
|
||||
(let ((ns (symbol-t-ns v)))
|
||||
(if (or (not ns) (jolt-nil? ns))
|
||||
(symbol-t-name v)
|
||||
(string-append ns "/" (symbol-t-name v)))))
|
||||
(else
|
||||
(let loop ((rs str-render-registry))
|
||||
(cond
|
||||
|
|
@ -49,10 +58,17 @@
|
|||
(jolt-pr-readable v)
|
||||
(jolt-str-render-one v)))
|
||||
(define (jolt-str . xs)
|
||||
(let loop ((xs xs) (acc '()))
|
||||
(if (null? xs)
|
||||
(apply string-append (reverse acc))
|
||||
(loop (cdr xs) (cons (jolt-str-one (car xs)) acc)))))
|
||||
(cond
|
||||
((null? xs) "")
|
||||
;; single arg returns its rendering directly (no string-append copy), so
|
||||
;; (str sym) hands back the symbol's own name string — JVM (str x) is
|
||||
;; x.toString(), and core.logic's non-unique lvar equality compares those by
|
||||
;; identity.
|
||||
((null? (cdr xs)) (jolt-str-one (car xs)))
|
||||
(else (let loop ((xs xs) (acc '()))
|
||||
(if (null? xs)
|
||||
(apply string-append (reverse acc))
|
||||
(loop (cdr xs) (cons (jolt-str-one (car xs)) acc)))))))
|
||||
|
||||
;; jolt indices are flonums; substring etc. need exact ints.
|
||||
(define (jolt->idx n) (exact (truncate n)))
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -171,8 +171,11 @@
|
|||
|
||||
;; persistent disj over sets (pset-disj already exists in collections.ss).
|
||||
(define (jolt-disj s . xs)
|
||||
(meta-carry s
|
||||
(let loop ((s s) (xs xs)) (if (null? xs) s (loop (pset-disj s (car xs)) (cdr xs))))))
|
||||
;; (disj nil ...) is nil on the JVM (disj is otherwise set-only).
|
||||
(if (jolt-nil? s)
|
||||
jolt-nil
|
||||
(meta-carry s
|
||||
(let loop ((s s) (xs xs)) (if (null? xs) s (loop (pset-disj s (car xs)) (cdr xs)))))))
|
||||
|
||||
;; --- see-through accessors ---------------------------------------------------
|
||||
(define (tvec-in-bounds? t i) (and (fixnum? i) (fx>=? i 0) (fx<? i (jolt-transient-n t))))
|
||||
|
|
|
|||
|
|
@ -47,9 +47,21 @@
|
|||
(define (keyword? x) (keyword-t? x))
|
||||
|
||||
;; --- symbols: ns + name + meta; NOT interned (meta varies), = by ns/name ------
|
||||
;; The ns/name STRINGS are pooled (like JVM Symbol.intern, which .intern()s them):
|
||||
;; two separately-read `?a` symbols share one name-string object, so code that
|
||||
;; compares symbol names by identity (core.logic's non-unique lvar equality, via
|
||||
;; (str sym)) behaves like the JVM.
|
||||
(define symbol-string-pool (make-hashtable string-hash string=?))
|
||||
(define (intern-symbol-string s)
|
||||
(if (string? s)
|
||||
(or (hashtable-ref symbol-string-pool s #f)
|
||||
(begin (hashtable-set! symbol-string-pool s s) s))
|
||||
s))
|
||||
(define-record-type symbol-t (fields ns name meta) (nongenerative symbol-v1))
|
||||
(define (jolt-symbol ns name) (make-symbol-t ns name jolt-nil))
|
||||
(define (jolt-symbol/meta ns name meta) (make-symbol-t ns name meta))
|
||||
(define (jolt-symbol ns name)
|
||||
(make-symbol-t (intern-symbol-string ns) (intern-symbol-string name) jolt-nil))
|
||||
(define (jolt-symbol/meta ns name meta)
|
||||
(make-symbol-t (intern-symbol-string ns) (intern-symbol-string name) meta))
|
||||
(define (jolt-symbol? x) (symbol-t? x))
|
||||
|
||||
;; chars/strings: Chez natives (strings treated immutable).
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue