Merge pull request #280 from jolt-lang/rewrite-clj-conformance-fixes

Fix six JVM divergences surfaced by rewrite-clj

host/chez/host-contract.ss

@@ -430,6 +430,19 @@
 (define (hc-record-ctor-key ctx name)
   (let ((nm (hc-record-tag-name name)))
     (or (and nm (chez-find-ctor-key nm (chez-current-ns))) jolt-nil)))
+;; The fully-qualified deftype tag ("ns.Name") IFF `class` names a deftype DEFINED
+;; in the ctx's compile ns — the analyzer qualifies a bare (Name. …) to it, so a
+;; deftype doesn't shadow a same-named built-in host class in an unrelated ns
+;; (rewrite-clj imports java.io.PushbackReader; tools.reader defines its own). Strict:
+;; only this ns's own def (the preferred shape key) counts, not the global
+;; simple-name fallback, so a ns that merely uses the built-in resolves nil.
+(define (hc-deftype-ctor-class ctx class)
+  (let* ((nm (jolt-str-render-one class))
+         (cns (hc-current-ns ctx))
+         (key (string-append cns "/->" nm)))
+    (if (hashtable-ref chez-record-shapes-tbl key #f)
+        (string-append cns "." nm)
+        jolt-nil)))
 ;; record + protocol-method shapes for the inference, from the runtime registries
 ;; (records.ss) populated as deftype/defprotocol forms load.
 (define (hc-record-shapes ctx) (chez-record-shapes-map))
@@ -505,6 +518,7 @@
   (def-var! "jolt.host" "form-syntax-quote-lower" hc-syntax-quote-lower)
   (def-var! "jolt.host" "record-type?" hc-record-type?)
   (def-var! "jolt.host" "record-ctor-key" hc-record-ctor-key)
+  (def-var! "jolt.host" "deftype-ctor-class" hc-deftype-ctor-class)
   (def-var! "jolt.host" "record-shapes" hc-record-shapes)
   (def-var! "jolt.host" "protocol-methods" hc-protocol-methods)
   (def-var! "jolt.host" "inline-enabled?" hc-inline-enabled?)

host/chez/java/host-static-classes.ss

@@ -375,6 +375,11 @@
 ;; state: a vector #(wrapped-reader pushed-list)
 (register-class-ctor! "PushbackReader"
   (lambda (rdr . _) (make-jhost "pushback-reader" (vector rdr '()))))
+;; Fully-qualified aliases so (java.io.PushbackReader. …) / (java.io.StringReader. …)
+;; resolve to these built-ins even when a library defines a deftype of the same
+;; simple name (tools.reader), which would otherwise take the bare-name slot.
+(register-class-ctor! "java.io.PushbackReader" (lookup-class class-ctors-tbl "PushbackReader"))
+(register-class-ctor! "java.io.StringReader" (lookup-class class-ctors-tbl "StringReader"))
 ;; LineNumberingPushbackReader: a pushback-reader (jolt doesn't track line
 ;; numbers; getLineNumber is a stub for error-reporting paths that read it).
 (register-class-ctor! "LineNumberingPushbackReader"

host/chez/java/host-static-methods.ss

@@ -268,7 +268,12 @@
   (list (cons "isUpperCase" (lambda (c) (let ((n (char-code c))) (and (>= n 65) (<= n 90)))))
         (cons "isLowerCase" (lambda (c) (let ((n (char-code c))) (and (>= n 97) (<= n 122)))))
         (cons "isDigit" (lambda (c) (let ((n (char-code c))) (and (>= n 48) (<= n 57)))))
-        (cons "isWhitespace" (lambda (c) (char<=? (integer->char (char-code c)) #\space)))))
+        ;; JVM Character.isWhitespace: Unicode whitespace (so U+2028 line separator
+        ;; counts, like the JVM) MINUS the no-break spaces the JVM excludes
+        ;; (U+00A0/U+2007/U+202F). char<=?space missed everything above ASCII.
+        (cons "isWhitespace" (lambda (c) (let ((cp (char-code c)))
+                                           (and (char-whitespace? (integer->char cp))
+                                                (not (fx=? cp #xA0)) (not (fx=? cp #x2007)) (not (fx=? cp #x202F))))))))
 
 ;; String/valueOf(Object): "null" for nil, else jolt's str semantics.
 ;; String/format(fmt args…) / (locale fmt args…) -> the clojure.core format engine.

host/chez/java/io.ss

@@ -412,6 +412,11 @@
     ;; method (a no-op for in-memory streams); absent method -> no-op.
     ((htable? x) (guard (e (#t jolt-nil)) (record-method-dispatch x "close" jolt-nil)) jolt-nil)
     ((jfile? x) jolt-nil)
+    ;; a deftype/defrecord that implements a `close` method (java.io.Closeable /
+    ;; AutoCloseable, e.g. tools.reader's reader types) closes through it — the
+    ;; same method (.close x) would dispatch to.
+    ((and (jrec? x) (jrec-cl x "close"))
+     (record-method-dispatch x "close" jolt-nil) jolt-nil)
     (else
      (let ((closef (jolt-get x (keyword #f "close") jolt-nil)))
        (if (and (not (jolt-nil? closef)) (procedure? closef))

host/chez/records.ss

@@ -587,11 +587,18 @@
                                                  (number? a) (not (flonum? a)))
                                             (exact->inexact a) a))
                            (loop (cdr as) (+ i 1)))))))))
-    ;; Register the ctor globally by simple class name (like StringBuilder) so
-    ;; (Name. …) interop resolves ns-agnostically: a deftype used across files works
-    ;; even when the runtime current ns is the caller's, not the defining ns
-    ;; (host-new checks class-ctors-tbl before the current-ns var fallback).
-    (register-class-ctor! (symbol-t-name name-sym) ctor)
+    ;; Register the ctor under its fully-qualified tag ("ns.Name") — a bare
+    ;; (Name. …) in the DEFINING ns is qualified to this by the analyzer, so a
+    ;; deftype whose simple name collides with a built-in host class (tools.reader's
+    ;; PushbackReader vs java.io.PushbackReader) still resolves correctly there.
+    (register-class-ctor! tag ctor)
+    ;; Also register the simple name so (Name. …) resolves ns-agnostically across
+    ;; files — BUT never clobber a built-in host class of the same simple name (an
+    ;; unrelated ns's bare (Name. …) must still reach the built-in). A prior deftype
+    ;; (tracked in chez-simple-name-tag) is fine to overwrite (last def wins / redef).
+    (when (or (not (hashtable-ref class-ctors-tbl (symbol-t-name name-sym) #f))
+              (hashtable-ref chez-simple-name-tag (symbol-t-name name-sym) #f))
+      (register-class-ctor! (symbol-t-name name-sym) ctor))
     ;; index the tag so a cross-ns extend-protocol resolves the bare type name.
     (hashtable-set! chez-deftype-tag-set tag #t)
     (hashtable-set! chez-simple-name-tag (symbol-t-name name-sym) tag)

host/chez/smoke.sh

@@ -43,6 +43,12 @@ check '(deref (future (+ 1 2)))' '3'
 check '(/ 1 2)' '1/2'
 check '(= 3 3.0)' 'false'
 check '(== 3 3.0)' 'true'
+# a deftype whose simple name collides with a built-in host class must not shadow
+# the java class: (java.io.PushbackReader. …) still builds the java reader (has
+# .read), while the bare name in the deftype's own ns is the deftype. (Fresh -e
+# process per check, so the deftype doesn't leak.)
+check '(do (deftype PushbackReader [x]) (.read (java.io.PushbackReader. (java.io.StringReader. "A") 1)))' '65'
+check '(do (deftype PushbackReader [x]) (.-x (PushbackReader. 42)))' '42'
 check_loc '(throw (ex-info "boom" {}))' '  at 1:'
 
 # A throw that crosses the eval boundary (eval / load-string) must surface its

jolt-core/clojure/core/00-syntax.clj

@@ -514,7 +514,9 @@
                             sub (wrap-mods (rest mods) inner)]
                         (if (= (first m) :when)
                           `(if ~(nth m 1) ~sub [])
-                          `(let* ~(nth m 1) ~sub)))))
+                          ;; `let` (not let*) so a :let binding may itself
+                          ;; destructure — (for [x xs :let [{:keys [y]} x]] …).
+                          `(let ~(nth m 1) ~sub)))))
         build (fn build [idx groups]
                 (let [g (nth groups idx)
                       my-bind (nth g 0)

jolt-core/clojure/core/30-macros.clj

@@ -385,11 +385,18 @@
                     ;; field binds / live-read instance (see defrecord's mk-clause).
                     (let [argv (mapv (fn [p] (if (= p (quote _)) (gensym "_p") p)) (nth spec 1))
                           inst (first argv)
+                          ;; A method param shadows a same-named field (Clojure
+                          ;; semantics): don't let-bind a field the param already
+                          ;; provides, and treat those params as shadowing so a
+                          ;; mutable field's live-read rewrite doesn't override them.
+                          pnames (set (map name argv))
                           ;; let-bind only immutable fields; mutable ones are read live
                           ;; via rewrite-body so a set! within the method is observed.
                           binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))])
-                                             (filter (fn [f] (not (mutable? f))) fields)))
-                          mbody (map (fn [bf] (rewrite-body inst #{} bf)) (drop 2 spec))]
+                                             (filter (fn [f] (and (not (mutable? f))
+                                                                  (not (contains? pnames (name f)))))
+                                                     fields)))
+                          mbody (map (fn [bf] (rewrite-body inst (set argv) bf)) (drop 2 spec))]
                       (list argv (list* 'let binds mbody))))
         groups (group-by-head body)
         ;; merge clauses by method NAME across ALL protocols into one multi-arity
@@ -616,7 +623,11 @@
                     (let [argv (mapv (fn [p] (if (= p (quote _)) (gensym "_p") p)) (nth spec 1))
                           inst (first argv)
                           hinted (assoc argv 0 (vary-meta inst assoc :tag (name name-sym)))
-                          binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))]) fields))]
+                          ;; a method param shadows a same-named field (Clojure
+                          ;; semantics), so don't rebind a field the param provides.
+                          pnames (set (map name argv))
+                          binds (vec (mapcat (fn [f] [f `(get ~inst ~(keyword (name f)))])
+                                             (remove (fn [f] (contains? pnames (name f))) fields)))]
                       (list hinted (list* 'let binds (drop 2 spec)))))
         groups (group-by-head body)
         ;; merge clauses by name across protocols into one multi-arity fn (see

jolt-core/jolt/analyzer.clj

@@ -29,7 +29,7 @@
                                unchecked-math?
                                form-macro? form-expand-1 resolve-global
                                form-sym-meta form-coll-meta host-intern! form-syntax-quote-lower
-                               record-type? record-ctor-key form-position late-bind?
+                               record-type? record-ctor-key deftype-ctor-class form-position late-bind?
                                resolve-class-hint]]))
 
 (declare analyze)
@@ -482,7 +482,12 @@
 ;; token and the analyzed args. The Chez back end lowers it to a runtime
 ;; constructor dispatch.
 (defn- analyze-ctor [ctx class args env]
-  (host-new class (mapv #(analyze ctx % env) args)))
+  ;; Qualify a bare (Name. …) to its deftype's FQN when THIS ns defined the deftype,
+  ;; so a deftype named like a built-in host class (tools.reader's PushbackReader)
+  ;; resolves to the deftype here while an unrelated ns's bare (PushbackReader. …)
+  ;; still reaches java.io.PushbackReader.
+  (host-new (or (deftype-ctor-class ctx class) class)
+            (mapv #(analyze ctx % env) args)))
 
 ;; jolt.ffi/__cfn: the low-level foreign-function form a jolt library
 ;; uses (via the jolt.ffi/foreign-fn macro) to bind native code. Shape:

stdlib/clojure/walk.clj

@@ -19,7 +19,10 @@
     ; concat/lazy-seq) walk too — without this, postwalk-replace silently no-op'd
     ; a quoted list, breaking clojure.template/apply-template
     (list? form) (outer (with-meta (apply list (map inner form)) (meta form)))
-    (seq? form) (outer (with-meta (map inner form) (meta form)))
+    ; doall like Clojure: walk must be eager so an `inner` with side effects
+    ; (rewrite-clj's #() reader bumps an arg-count atom during the walk, read right
+    ; after) runs now, not lazily when the result is later realized.
+    (seq? form) (outer (with-meta (doall (map inner form)) (meta form)))
     :else (outer form)))
 
 (defn postwalk

test/chez/corpus.edn

@@ -6,6 +6,10 @@
   {:suite "destructure / :or" :label "map default when key absent" :expected "9" :actual "(let [{x :x :or {x 9}} {}] x)"}
   {:suite "destructure / :or" :label "kwargs default when key absent" :expected "9" :actual "((fn [& {x :x :or {x 9}}] x))"}
   {:suite "destructure / :or" :label "default not used when key present" :expected "5" :actual "(let [{x :x :or {x 9}} {:x 5}] x)"}
+  {:suite "destructure / for :let" :label "a for/doseq :let binding may itself destructure" :expected "[10 20]" :actual "(vec (for [x [1 2] :let [{:keys [y]} {:y (* x 10)}]] y))"}
+  {:suite "deftype / method param shadows field" :label "a method param named like a field shadows it (Clojure scope)" :expected "9" :actual "(do (defprotocol P (setm [this q])) (defrecord R [k m] P (setm [this m] (assoc this :m m))) (:m (setm (->R 1 nil) 9)))"}
+  {:suite "walk / eager" :label "clojure.walk is eager over a lazy seq (side effects run now)" :expected "3" :actual "(let [a (atom 0)] (clojure.walk/postwalk (fn [x] (when (number? x) (swap! a inc)) x) (map inc (list 1 2 3))) @a)"}
+  {:suite "chars / isWhitespace" :label "Character/isWhitespace matches the JVM (Unicode line-sep yes, no-break space no)" :expected "[true true false false]" :actual "(mapv (fn [c] (Character/isWhitespace (char c))) [0x2028 32 0x00A0 65])"}
   {:suite "deftype / field access" :label ".field reads a deftype field" :expected "7" :actual "(do (deftype FldT [q]) (.q (->FldT 7)))"}
   {:suite "fn / pre-post" :label ":pre + :post pass" :expected "5" :actual "(do (defn ppf [x] {:pre [(pos? x)] :post [(= % x)]} x) (ppf 5))"}
   {:suite "fn / pre-post" :label ":pre failure throws" :expected ":blocked" :actual "(do (defn ppg [x] {:pre [(pos? x)]} x) (try (ppg -1) (catch Throwable _ :blocked)))"}

test/chez/unit.edn

@@ -226,6 +226,7 @@
   {:suite "ioreader" :expr "(let [log (atom [])] (try (with-open [c {:close (fn [] (swap! log conj :closed))}] (throw (ex-info \"boom\" {}))) (catch Exception e nil)) (deref log))" :expected "[:closed]"}
   {:suite "ioreader" :expr "(let [log (atom [])] (with-open [a {:close (fn [] (swap! log conj :outer))} b {:close (fn [] (swap! log conj :inner))}] :r) (deref log))" :expected "[:inner :outer]"}
   {:suite "ioreader" :expr "(with-open [c {:close (fn [] nil) :v 5}] (:v c))" :expected "5"}
+  {:suite "ioreader" :expr "(do (defrecord RC [log] java.io.Closeable (close [_] (swap! log conj :closed))) (let [log (atom [])] (with-open [r (->RC log)] :body) @log))" :expected "[:closed]"}
   {:suite "javastatic" :expr "(Math/sqrt 16)" :expected "4.0"}
   {:suite "javastatic" :expr "(Math/abs -3)" :expected "3"}
   {:suite "javastatic" :expr "(Math/max 2 7)" :expected "7"}