diff --git a/host/chez/compile-eval.ss b/host/chez/compile-eval.ss index e585e36..624511b 100644 --- a/host/chez/compile-eval.ss +++ b/host/chez/compile-eval.ss @@ -15,7 +15,10 @@ ;; inference when the unit opted into direct-linking (jolt build --opt). Off that ;; path it is a pure const-fold. Loaded from the compiler image (jolt.passes). (define jolt-ce-run-passes (var-deref "jolt.passes" "run-passes")) -(define jolt-ce-read (var-deref "clojure.core" "read-string")) +;; The compiler reads source as FORMS (set literals stay {:jolt/type :jolt/set}, +;; which the analyzer lowers) — the raw reader, not clojure.core/read-string, +;; whose data conversion would turn those into real sets. +(define jolt-ce-read jolt-read-form-raw) ;; The spine ALWAYS runs with the full clojure.core prelude loaded, so a clojure.* ;; ref must lower to var-deref (resolved from the prelude), not trip the emitter's diff --git a/host/chez/host-contract.ss b/host/chez/host-contract.ss index 08bde45..5dd1c4f 100644 --- a/host/chez/host-contract.ss +++ b/host/chez/host-contract.ss @@ -32,6 +32,7 @@ (define hc-kw-name (keyword #f "name")) (define hc-kw-var (keyword #f "var")) (define hc-kw-unresolved (keyword #f "unresolved")) +(define hc-kw-class (keyword #f "class")) (define hc-kw-num-ret (keyword #f "num-ret")) (define hc-kw-double (keyword #f "double")) (define hc-kw-long (keyword #f "long")) @@ -192,6 +193,19 @@ ((equal? t "long") hc-kw-long) (else #f)))))) +;; A slash-free dotted symbol whose final segment is Capitalized is a class +;; reference (java.util.Map, clojure.lang.Named) — Clojure has no such vars. With +;; no JVM classes, jolt models a class as its name string, so the symbol +;; self-evaluates to that string (the analyzer emits a :const). This lets a lib +;; extend a protocol to / instance?-check a host class jolt has no shim for. +(define (hc-fq-class-name? nm) + (let ((n (string-length nm))) + (let loop ((i (fx- n 1))) + (cond ((fxcseq (al->list self))))) (cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al->list self))))))) +;; Appendable.append text: append(x) renders x; append(csq,start,end) appends the +;; subsequence csq[start,end) (data.json's writer appends string runs this way). +(define (append-text x rest) + (if (null? rest) + (render-piece x) + (substring (render-piece x) (jnum->exact (car rest)) (jnum->exact (cadr rest))))) + (register-class-ctor! "StringBuilder" (lambda args (make-jhost "string-builder" ;; a numeric first arg is a CAPACITY hint, not content. (vector (if (and (pair? args) (not (number? (car args)))) (render-piece (car args)) ""))))) (register-host-methods! "string-builder" - (list (cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self)) + (list (cons "append" (lambda (self x . rest) (sb-set! self (string-append (sb-str self) (append-text x rest))) self)) (cons "toString" (lambda (self) (sb-str self))) (cons "length" (lambda (self) (->num (string-length (sb-str self))))) (cons "charAt" (lambda (self i) (string-ref (sb-str self) (jnum->exact i)))) @@ -88,6 +95,9 @@ (substring cur 0 n) (string-append cur (make-string (- n (string-length cur)) #\nul))))) jolt-nil)))) +;; (str sb) / print a StringBuilder -> its accumulated content, like the JVM +;; (str calls toString). Without this str renders the opaque host object. +(register-str-render! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "string-builder"))) sb-str) ;; ---- StringWriter ----------------------------------------------------------- ;; Writer.write(int) writes the CHAR for that code; append(char) appends the char. @@ -95,7 +105,7 @@ (register-class-ctor! "StringWriter" (lambda args (make-jhost "writer" (vector "")))) (register-host-methods! "writer" (list (cons "write" (lambda (self x) (sb-set! self (string-append (sb-str self) (writer-piece x))) jolt-nil)) - (cons "append" (lambda (self x) (sb-set! self (string-append (sb-str self) (render-piece x))) self)) + (cons "append" (lambda (self x . rest) (sb-set! self (string-append (sb-str self) (append-text x rest))) self)) (cons "flush" (lambda (self) jolt-nil)) (cons "close" (lambda (self) jolt-nil)) (cons "toString" (lambda (self) (sb-str self))))) @@ -109,7 +119,7 @@ (define (fw-flush! self) (jolt-spit (fw-path self) (fw-buf self))) ; jolt-spit: io.ss (register-host-methods! "file-writer" (list (cons "write" (lambda (self x) (fw-append! self (writer-piece x)) jolt-nil)) - (cons "append" (lambda (self x) (fw-append! self (render-piece x)) self)) + (cons "append" (lambda (self x . rest) (fw-append! self (append-text x rest)) self)) (cons "flush" (lambda (self) (fw-flush! self) jolt-nil)) (cons "close" (lambda (self) (fw-flush! self) jolt-nil)) (cons "toString" (lambda (self) (fw-buf self))))) @@ -120,7 +130,7 @@ ;; (tools.logging, selmer) compile and run. (register-host-methods! "port-writer" (list (cons "write" (lambda (self x) (display (writer-piece x) (vector-ref (jhost-state self) 0)) jolt-nil)) - (cons "append" (lambda (self x) (display (render-piece x) (vector-ref (jhost-state self) 0)) self)) + (cons "append" (lambda (self x . rest) (display (append-text x rest) (vector-ref (jhost-state self) 0)) self)) (cons "flush" (lambda (self) (flush-output-port (vector-ref (jhost-state self) 0)) jolt-nil)) (cons "close" (lambda (self) jolt-nil)) (cons "toString" (lambda (self) "")))) @@ -291,6 +301,15 @@ (lambda (x . rest) (cond ((bytevector? x) (decode-bytevector x rest)) ((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (decode-bytevector (na-bytearray->bv x) rest)) + ;; (String. char[] [offset count]) — the whole array or a slice. Buffered + ;; readers (data.json) build a string from a fill buffer this way. + ((and (jolt-array? x) (eq? (jolt-array-kind x) 'char)) + (let ((v (jolt-array-vec x))) + (if (pair? rest) + (let* ((off (jnum->exact (car rest))) (cnt (jnum->exact (cadr rest))) (out (make-string cnt))) + (let loop ((i 0)) (when (fxstring (vector->list v))))) ((string? x) x) (else (jolt-str-render-one x))))) (register-class-ctor! "BigInteger" @@ -535,6 +554,24 @@ ((string=? iface "IFn") (or (procedure? val) (keyword? val) (symbol-t? val) (pmap? val) (pset? val) (pvec? val))) + ;; host-class interfaces libraries branch on (data.json, etc.). + ;; Matched by last segment, so java.util.Map and Map both hit. + ((string=? iface "Named") (or (keyword? val) (symbol-t? val))) + ((string=? iface "CharSequence") (string? val)) + ((string=? iface "Number") (number? val)) + ((string=? iface "Map") (or (pmap? val) (htable-sorted-map? val))) + ((string=? iface "Set") (or (pset? val) (htable-sorted-set? val))) + ;; a Java List is a vector or a seq/list — not a set or map. + ((string=? iface "List") + (or (and (pvec? val) (not (jolt-map-entry? val))) + (cseq? val) (empty-list-t? val) (jolt-lazyseq? val))) + ;; a Java Collection is any of those plus a set — but NOT a map. + ((string=? iface "Collection") + (or (pvec? val) (pset? val) (cseq? val) (empty-list-t? val) + (jolt-lazyseq? val) (htable-sorted-set? val))) + ((string=? iface "Associative") + (or (pmap? val) (htable-sorted-map? val) + (and (pvec? val) (not (jolt-map-entry? val))))) (else 'none)))) (if (eq? hit 'none) 'pass (if hit #t #f)))))) diff --git a/host/chez/inst-time.ss b/host/chez/inst-time.ss index f05b726..e32e4c2 100644 --- a/host/chez/inst-time.ss +++ b/host/chez/inst-time.ss @@ -320,6 +320,8 @@ (list (cons "ofPattern" (lambda (p . _) (mk-formatter p))) (cons "ISO_LOCAL_DATE" (mk-formatter "yyyy-MM-dd")) (cons "ISO_LOCAL_DATE_TIME" (mk-formatter "yyyy-MM-dd'T'HH:mm:ss")) + ;; ISO_INSTANT always renders in UTC with a trailing Z (format-ms is UTC; X -> "Z"). + (cons "ISO_INSTANT" (mk-formatter "yyyy-MM-dd'T'HH:mm:ssX")) (cons "ofLocalizedDate" (lambda (fs) (style-fmt 'date fs))) (cons "ofLocalizedTime" (lambda (fs) (style-fmt 'time fs))) (cons "ofLocalizedDateTime" (lambda (fs) (style-fmt 'datetime fs))))) @@ -354,8 +356,11 @@ ;; java.util.TimeZone: an opaque id holder (format-ms is UTC, so a non-UTC zone is ;; not honored — only the UTC case the corpus uses is exercised). (define (timezone-of id) (make-jhost "timezone" (vector (if (string? id) id (jolt-str-render-one id))))) -(register-class-statics! "TimeZone" (list (cons "getTimeZone" timezone-of))) -(register-class-statics! "java.util.TimeZone" (list (cons "getTimeZone" timezone-of))) +(define timezone-statics + (list (cons "getTimeZone" timezone-of) + (cons "getDefault" (lambda () (timezone-of "default"))))) +(register-class-statics! "TimeZone" timezone-statics) +(register-class-statics! "java.util.TimeZone" timezone-statics) ;; java.text.SimpleDateFormat: holds a pattern; .setTimeZone is accepted (format-ms ;; is UTC); .format(date) renders the date per the pattern via the format-ms engine. diff --git a/host/chez/natives-format.ss b/host/chez/natives-format.ss index 0334b4e..ab33010 100644 --- a/host/chez/natives-format.ss +++ b/host/chez/natives-format.ss @@ -43,7 +43,7 @@ ((#\d) (number->string (->long a))) ((#\s) (jolt-str-render-one a)) ((#\f) (fmt-float a (or prec 6))) - ((#\x) (number->string (->long a) 16)) + ((#\x) (string-downcase (number->string (->long a) 16))) ((#\X) (string-upcase (number->string (->long a) 16))) ((#\o) (number->string (->long a) 8)) ((#\b) (if (jolt-truthy? a) "true" "false")) diff --git a/host/chez/natives-str.ss b/host/chez/natives-str.ss index 58f182f..3bb1614 100644 --- a/host/chez/natives-str.ss +++ b/host/chez/natives-str.ss @@ -166,6 +166,18 @@ ((or (string=? method "getName") (string=? method "getCanonicalName")) s) ((string=? method "getSimpleName") (let ((i (str-last-index-of s "."))) (if (>= i 0) (substring s (+ i 1) (string-length s)) s))) + ;; .getChars srcBegin srcEnd dst dstBegin — copy s[srcBegin,srcEnd) into the + ;; char-array dst at dstBegin (used by buffered readers, e.g. data.json). + ((string=? method "getChars") + (let ((src-begin (jolt->idx (arg 0))) (src-end (jolt->idx (arg 1))) + (dv (jolt-array-vec (arg 2))) (dst-begin (jolt->idx (arg 3)))) + (let loop ((i src-begin) (j dst-begin)) + (when (fxidx (arg 0)) (jolt->idx (arg 1)))) (else (error #f (string-append "No method " method " for value"))))) ;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) --- diff --git a/host/chez/reader.ss b/host/chez/reader.ss index 92f74ce..4c58522 100644 --- a/host/chez/reader.ss +++ b/host/chez/reader.ss @@ -177,7 +177,21 @@ ((#\0) (loop (+ i 2) (cons #\nul acc))) ((#\u) (let-values (((cp j) (rdr-hex->int s (+ i 2) 4))) - (loop j (cons (integer->char cp) acc)))) + ;; A \u escape is a UTF-16 code unit. jolt chars are Unicode scalars, + ;; so combine a high+low surrogate pair (😃 -> U+1F603) into + ;; the one scalar char. A lone surrogate has no scalar — emit U+FFFD + ;; rather than crash (the irreducible UTF-16/scalar divergence). + (cond + ((and (fx>=? cp #xD800) (fx<=? cp #xDBFF) + (fxint s (+ j 2) 4))) + (if (and (fx>=? lo #xDC00) (fx<=? lo #xDFFF)) + (loop k (cons (integer->char + (fx+ #x10000 (fx* (fx- cp #xD800) 1024) (fx- lo #xDC00))) acc)) + (loop j (cons #\xFFFD acc))))) + ((and (fx>=? cp #xD800) (fx<=? cp #xDFFF)) (loop j (cons #\xFFFD acc))) + (else (loop j (cons (integer->char cp) acc)))))) (else (loop (+ i 2) (cons e acc)))))) (else (loop (+ i 1) (cons c acc))))))) @@ -526,12 +540,62 @@ (jolt-throw (jolt-ex-info "EOF while reading reader macro" (empty-pmap)))) (values (jolt-list head form) j))) +;; --- form -> data ----------------------------------------------------------- +;; read-string/read return DATA, so set literal FORMS ({:jolt/type :jolt/set +;; :value [...]}) become real sets, recursing through maps/vectors/lists. The +;; COMPILER reads via rdr-read-form and keeps the set FORM (the analyzer lowers +;; it), so this conversion runs only on the data seams. Structural sharing keeps +;; identity (and the rdr-map-order entry + metadata) for any branch with no set. +(define (rdr-set-form? x) + (and (pmap? x) (eq? (jolt-get x rdr-kw-jolt-type) rdr-kw-jolt-set) + (not (jolt-nil? (jolt-get x rdr-kw-value))))) + +(define (rdr-conv-each xs) ; (values converted-list changed?) + (let loop ((xs xs) (acc '()) (changed #f)) + (if (null? xs) + (values (reverse acc) changed) + (let ((c (rdr-form->data (car xs)))) + (loop (cdr xs) (cons c acc) (or changed (not (eq? c (car xs))))))))) + +(define (rdr-carry-meta src dst) + (let ((m (jolt-meta src))) (if (jolt-nil? m) dst (jolt-with-meta dst m)))) + +(define (rdr-form->data x) + (cond + ((rdr-set-form? x) + (let ((items (jolt-get x rdr-kw-value))) + (rdr-carry-meta x + (let loop ((i 0) (s empty-pset)) + (if (fx>=? i (pvec-count items)) s + (loop (fx+ i 1) (pset-conj s (rdr-form->data (pvec-nth-d items i jolt-nil))))))))) + ((pvec? x) + (let-values (((items changed) (rdr-conv-each (vector->list (pvec-v x))))) + (if changed (rdr-carry-meta x (apply jolt-vector items)) x))) + ((pmap? x) + (let ((order (hashtable-ref rdr-map-order x #f))) + (if order + (let-values (((kvs changed) (rdr-conv-each order))) + (if changed + (let ((m (rdr-make-map kvs))) (rdr-carry-meta x m)) + x)) + (let-values (((kvs changed) + (rdr-conv-each (pmap-fold x (lambda (k v a) (cons k (cons v a))) '())))) + (if changed (rdr-carry-meta x (apply jolt-hash-map kvs)) x))))) + ((cseq? x) + (let-values (((items changed) (rdr-conv-each (seq->list x)))) + (if changed (rdr-carry-meta x (apply jolt-list items)) x))) + (else x))) + ;; --- the two host seams ----------------------------------------------------- ;; clojure.core/read-string: first form, or nil for blank / comment-only input -;; (parse-string wart, matched deliberately). -(define (jolt-read-string s) +;; (parse-string wart, matched deliberately). jolt-read-form-raw keeps set FORMS +;; for the compiler spine (compile-eval); the data seam converts them to sets. +(define (jolt-read-form-raw s) (let-values (((form j) (rdr-read-form s 0 (string-length s)))) (if (rdr-eof? form) jolt-nil form))) +(define (jolt-read-string s) + (let ((form (jolt-read-form-raw s))) + (if (jolt-nil? form) form (rdr-form->data form)))) ;; __parse-next: [form rest-of-string] or nil when only whitespace/comments left. (define (jolt-parse-next s) @@ -539,7 +603,7 @@ (let-values (((form j) (rdr-read-form s 0 end))) (if (rdr-eof? form) jolt-nil - (jolt-vector form (substring s j end)))))) + (jolt-vector (rdr-form->data form) (substring s j end)))))) ;; __read-tagged: apply a built-in data reader to an already-read form. The tag ;; is the :#name keyword the reader produced; #uuid/#inst reuse the inst-time ctors. diff --git a/host/chez/seed/image.ss b/host/chez/seed/image.ss index 05c4b06..35eb9b7 100644 --- a/host/chez/seed/image.ss +++ b/host/chez/seed/image.ss @@ -113,7 +113,7 @@ (guard (e (#t #f)) (def-var! "jolt.analyzer" "analyze-field" (letrec ((analyze-field (lambda (ctx hname items env) (let fnrec5359 ((ctx ctx) (hname hname) (items items) (env env)) (begin (if (< (jolt-count items) 2) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed (.-field target) form")) jolt-nil) (let* ((_o$5360 (keyword #f "op")) (_o$5361 (keyword #f "host-call")) (_o$5362 (keyword #f "method")) (_o$5363 (jolt-invoke (var-deref "clojure.core" "subs") hname 1)) (_o$5364 (keyword #f "target")) (_o$5365 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$5366 (keyword #f "args")) (_o$5367 (jolt-vector))) (jolt-hash-map _o$5360 _o$5361 _o$5362 _o$5363 _o$5364 _o$5365 _o$5366 _o$5367))))))) analyze-field))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-symbol" (letrec ((analyze-symbol (lambda (ctx form env) (let fnrec5368 ((ctx ctx) (form form) (env env)) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") form)) (ns (jolt-invoke (var-deref "jolt.host" "form-sym-ns") form))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "nil?") ns))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env nm) and__13__auto))) (let* ((h (jolt-get (jolt-get env (keyword #f "hints")) nm))) (if (jolt-truthy? h) (jolt-assoc (jolt-invoke (var-deref "jolt.ir" "local") nm) (keyword #f "hint") h) (jolt-invoke (var-deref "jolt.ir" "local") nm))) (if (jolt-truthy? ns) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (let* ((G__45 (let* ((_a$5369 (var-deref "jolt.ir" "var-ref")) (_a$5370 (jolt-get r (keyword #f "ns"))) (_a$5371 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$5369 _a$5370 _a$5371)))) (let* ((G__46 (if (jolt-truthy? (jolt-get r (keyword #f "num-ret"))) (jolt-assoc G__45 (keyword #f "num-ret") (jolt-get r (keyword #f "num-ret"))) G__45))) G__46)) (jolt-invoke (var-deref "jolt.ir" "host-static") ns nm))) (if (jolt-truthy? (keyword #f "else")) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (let* ((G__47 (jolt-get r (keyword #f "kind")))) (if (jolt= G__47 (keyword #f "var")) (let* ((G__48 (let* ((_a$5372 (var-deref "jolt.ir" "var-ref")) (_a$5373 (jolt-get r (keyword #f "ns"))) (_a$5374 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$5372 _a$5373 _a$5374)))) (let* ((G__49 (if (jolt-truthy? (jolt-get r (keyword #f "num-ret"))) (jolt-assoc G__48 (keyword #f "num-ret") (jolt-get r (keyword #f "num-ret"))) G__48))) G__49)) (if (jolt= G__47 (keyword #f "host")) (jolt-invoke (var-deref "jolt.ir" "host-ref") (jolt-get r (keyword #f "name"))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "late-bind?") ctx)) (jolt-invoke (var-deref "jolt.ir" "var-ref") (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx) nm) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "Unable to resolve symbol: " nm " in this context"))))))) jolt-nil)))))))) analyze-symbol))) + (def-var! "jolt.analyzer" "analyze-symbol" (letrec ((analyze-symbol (lambda (ctx form env) (let fnrec5368 ((ctx ctx) (form form) (env env)) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") form)) (ns (jolt-invoke (var-deref "jolt.host" "form-sym-ns") form))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "nil?") ns))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env nm) and__13__auto))) (let* ((h (jolt-get (jolt-get env (keyword #f "hints")) nm))) (if (jolt-truthy? h) (jolt-assoc (jolt-invoke (var-deref "jolt.ir" "local") nm) (keyword #f "hint") h) (jolt-invoke (var-deref "jolt.ir" "local") nm))) (if (jolt-truthy? ns) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (let* ((G__45 (let* ((_a$5369 (var-deref "jolt.ir" "var-ref")) (_a$5370 (jolt-get r (keyword #f "ns"))) (_a$5371 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$5369 _a$5370 _a$5371)))) (let* ((G__46 (if (jolt-truthy? (jolt-get r (keyword #f "num-ret"))) (jolt-assoc G__45 (keyword #f "num-ret") (jolt-get r (keyword #f "num-ret"))) G__45))) G__46)) (jolt-invoke (var-deref "jolt.ir" "host-static") ns nm))) (if (jolt-truthy? (keyword #f "else")) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (let* ((G__47 (jolt-get r (keyword #f "kind")))) (if (jolt= G__47 (keyword #f "var")) (let* ((G__48 (let* ((_a$5372 (var-deref "jolt.ir" "var-ref")) (_a$5373 (jolt-get r (keyword #f "ns"))) (_a$5374 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$5372 _a$5373 _a$5374)))) (let* ((G__49 (if (jolt-truthy? (jolt-get r (keyword #f "num-ret"))) (jolt-assoc G__48 (keyword #f "num-ret") (jolt-get r (keyword #f "num-ret"))) G__48))) G__49)) (if (jolt= G__47 (keyword #f "host")) (jolt-invoke (var-deref "jolt.ir" "host-ref") (jolt-get r (keyword #f "name"))) (if (jolt= G__47 (keyword #f "class")) (jolt-invoke (var-deref "jolt.ir" "const") (jolt-get r (keyword #f "name"))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "late-bind?") ctx)) (jolt-invoke (var-deref "jolt.ir" "var-ref") (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx) nm) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "Unable to resolve symbol: " nm " in this context")))))))) jolt-nil)))))))) analyze-symbol))) (guard (e (#t #f)) (def-var! "jolt.analyzer" "analyze-list" (letrec ((analyze-list (lambda (ctx form env) (let fnrec5375 ((ctx ctx) (form form) (env env)) (let* ((items (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") form)))) (if (jolt-zero? (jolt-count items)) (jolt-invoke (var-deref "jolt.ir" "quote-node") form) (let* ((head (jolt-first items)) (hname (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") head) jolt-nil)) (shadowed (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env hname) and__13__auto)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-macro?") ctx head) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-expand-1") ctx form) env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "jolt.ffi" (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)))) (if (jolt-truthy? and__13__auto) (jolt= "__cfn" (jolt-invoke (var-deref "jolt.host" "form-sym-name") head)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-ffi-fn") ctx items env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "jolt.ffi" (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)))) (if (jolt-truthy? and__13__auto) (jolt= "__ccallable" (jolt-invoke (var-deref "jolt.host" "form-sym-name") head)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-ffi-callable") ctx items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (jolt-contains? (var-deref "jolt.analyzer" "handled") hname) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-special") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "method-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-host-call") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "ctor-head?") hname) and__13__auto)) and__13__auto))) (let* ((_a$5376 (var-deref "jolt.analyzer" "analyze-ctor")) (_a$5377 ctx) (_a$5378 (jolt-invoke (var-deref "clojure.core" "subs") hname 0 (jolt-dec (jolt-count hname)))) (_a$5379 (jolt-rest items)) (_a$5380 env)) (jolt-invoke _a$5376 _a$5377 _a$5378 _a$5379 _a$5380)) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "new"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= (jolt-count items) 2))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth items 1)) and__13__auto)) and__13__auto)) and__13__auto))) (let* ((_a$5381 (var-deref "jolt.analyzer" "analyze-ctor")) (_a$5382 ctx) (_a$5383 (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth items 1))) (_a$5384 (jolt-drop 2 items)) (_a$5385 env)) (jolt-invoke _a$5381 _a$5382 _a$5383 _a$5384 _a$5385)) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "."))) (if (jolt-truthy? and__13__auto) (jolt-not shadowed) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-dot") ctx items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "field-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-field") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-special?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " hname)) (if (jolt-truthy? (keyword #f "else")) (let* ((n (let* ((_a$5390 (var-deref "jolt.ir" "invoke")) (_a$5391 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx head env)) (_a$5392 (let* ((_a$5387 (var-deref "clojure.core" "mapv")) (_a$5388 (lambda (p__54_) (let fnrec5386 ((p__54_ p__54_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__54_ env)))) (_a$5389 (jolt-rest items))) (jolt-invoke _a$5387 _a$5388 _a$5389)))) (jolt-invoke _a$5390 _a$5391 _a$5392))) (p (jolt-invoke (var-deref "jolt.host" "form-position") form))) (if (jolt-truthy? p) (jolt-assoc n (keyword #f "pos") p) n)) jolt-nil)))))))))))))))))) analyze-list))) (guard (e (#t #f)) diff --git a/host/chez/seed/prelude.ss b/host/chez/seed/prelude.ss index cd31f13..6cd6dd1 100644 --- a/host/chez/seed/prelude.ss +++ b/host/chez/seed/prelude.ss @@ -885,9 +885,9 @@ (lambda (x form . more) (let fnrec1546 ((x x) (form form) (more (list->cseq more))) (let* ((step (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "seq?") form)) (let* ((_a$1547 (var-deref "clojure.core" "__sqcat")) (_a$1548 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "."))) (_a$1549 (jolt-invoke (var-deref "clojure.core" "__sq1") x)) (_a$1550 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-first form))) (_a$1551 (jolt-rest form))) (jolt-invoke _a$1547 _a$1548 _a$1549 _a$1550 _a$1551)) (let* ((_a$1552 (var-deref "clojure.core" "__sqcat")) (_a$1553 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "."))) (_a$1554 (jolt-invoke (var-deref "clojure.core" "__sq1") x)) (_a$1555 (jolt-invoke (var-deref "clojure.core" "__sq1") form))) (jolt-invoke _a$1552 _a$1553 _a$1554 _a$1555))))) (if (jolt-truthy? (jolt-seq more)) (let* ((_a$1556 (var-deref "clojure.core" "__sqcat")) (_a$1557 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" ".."))) (_a$1558 (jolt-invoke (var-deref "clojure.core" "__sq1") step)) (_a$1559 more)) (jolt-invoke _a$1556 _a$1557 _a$1558 _a$1559)) step))))) (mark-macro! "clojure.core" "..")) (guard (e (#t #f)) - (def-var! "clojure.core" "extends?" (letrec ((extends? (lambda (protocol atype) (let fnrec1560 ((protocol protocol) (atype atype)) (let* ((want (jolt-invoke (var-deref "clojure.core" "name") atype)) (dotted (jolt-invoke (var-deref "clojure.core" "str") "." want)) (dlen (jolt-count dotted))) (jolt-invoke (var-deref "clojure.core" "boolean") (let* ((_a$1562 (var-deref "clojure.core" "some")) (_a$1563 (lambda (t) (let fnrec1561 ((t t)) (let* ((tn (jolt-invoke (var-deref "clojure.core" "name") t))) (let* ((or__14__auto (jolt= tn want))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((and__13__auto (> (jolt-count tn) dlen))) (if (jolt-truthy? and__13__auto) (jolt= (jolt-invoke (var-deref "clojure.core" "subs") tn (- (jolt-count tn) dlen)) dotted) and__13__auto)))))))) (_a$1564 (jolt-invoke (var-deref "clojure.core" "extenders") protocol))) (jolt-invoke _a$1562 _a$1563 _a$1564)))))))) extends?))) + (def-var! "clojure.core" "extends?" (letrec ((extends? (lambda (protocol atype) (let fnrec1560 ((protocol protocol) (atype atype)) (let* ((want (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") atype)) "nil" (jolt-invoke (var-deref "clojure.core" "name") atype))) (suffix? (lambda (long short) (let fnrec1561 ((long long) (short short)) (let* ((d (jolt-invoke (var-deref "clojure.core" "str") "." short))) (let* ((and__13__auto (let* ((_a$1562 (jolt-count long)) (_a$1563 (jolt-count d))) (> _a$1562 _a$1563)))) (if (jolt-truthy? and__13__auto) (jolt= (jolt-invoke (var-deref "clojure.core" "subs") long (let* ((_a$1564 (jolt-count long)) (_a$1565 (jolt-count d))) (- _a$1564 _a$1565))) d) and__13__auto))))))) (jolt-invoke (var-deref "clojure.core" "boolean") (let* ((_a$1567 (var-deref "clojure.core" "some")) (_a$1568 (lambda (t) (let fnrec1566 ((t t)) (let* ((tn (jolt-invoke (var-deref "clojure.core" "name") t))) (let* ((or__14__auto (jolt= tn want))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke suffix? tn want))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke suffix? want tn))))))))) (_a$1569 (jolt-invoke (var-deref "clojure.core" "extenders") protocol))) (jolt-invoke _a$1567 _a$1568 _a$1569)))))))) extends?))) (guard (e (#t #f)) - (def-var! "clojure.core" "extend" (letrec ((extend (lambda (atype . proto+mmaps) (let fnrec1565 ((atype atype) (proto+mmaps (list->cseq proto+mmaps))) (let* ((s (jolt-seq proto+mmaps))) (let loop1566 ((s s)) (if (jolt-truthy? s) (begin (let* ((proto (jolt-first s)) (mmap (jolt-invoke (var-deref "clojure.core" "second") s)) (pname (jolt-invoke (var-deref "clojure.core" "name") (jolt-get proto (keyword #f "name"))))) (begin (jolt-count (jolt-map (lambda (G__25) (let fnrec1567 ((G__25 G__25)) (let* ((G__26 G__25) (k (jolt-nth G__26 0 jolt-nil)) (f (jolt-nth G__26 1 jolt-nil))) (begin (let* ((_a$1568 (var-deref "clojure.core" "register-method")) (_a$1569 (jolt-invoke (var-deref "clojure.core" "name") atype)) (_a$1570 pname) (_a$1571 (jolt-invoke (var-deref "clojure.core" "name") k)) (_a$1572 f)) (jolt-invoke _a$1568 _a$1569 _a$1570 _a$1571 _a$1572)) jolt-nil)))) mmap)) jolt-nil)) (loop1566 (jolt-invoke (var-deref "clojure.core" "nnext") s))) jolt-nil))))))) extend))) + (def-var! "clojure.core" "extend" (letrec ((extend (lambda (atype . proto+mmaps) (let fnrec1570 ((atype atype) (proto+mmaps (list->cseq proto+mmaps))) (let* ((tname (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") atype)) "nil" (jolt-invoke (var-deref "clojure.core" "name") atype)))) (let* ((s (jolt-seq proto+mmaps))) (let loop1571 ((s s)) (if (jolt-truthy? s) (begin (let* ((proto (jolt-first s)) (mmap (jolt-invoke (var-deref "clojure.core" "second") s)) (pname (jolt-invoke (var-deref "clojure.core" "name") (jolt-get proto (keyword #f "name"))))) (begin (jolt-count (jolt-map (lambda (G__25) (let fnrec1572 ((G__25 G__25)) (let* ((G__26 G__25) (k (jolt-nth G__26 0 jolt-nil)) (f (jolt-nth G__26 1 jolt-nil))) (begin (jolt-invoke (var-deref "clojure.core" "register-method") tname pname (jolt-invoke (var-deref "clojure.core" "name") k) f) jolt-nil)))) mmap)) jolt-nil)) (loop1571 (jolt-invoke (var-deref "clojure.core" "nnext") s))) jolt-nil)))))))) extend))) (guard (e (#t #f)) (def-var! "clojure.core" "extend-type" (lambda (tsym . body) (let fnrec1573 ((tsym tsym) (body (list->cseq body))) (let* ((tname (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") tsym)) "nil" (jolt-invoke (var-deref "clojure.core" "name") tsym)))) (let* ((items (jolt-seq body)) (proto jolt-nil) (forms (jolt-vector))) (let loop1574 ((items items) (proto proto) (forms forms)) (if (jolt-empty? items) (jolt-invoke (var-deref "clojure.core" "__sqcat") (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol #f "do")) forms) (let* ((x (jolt-first items))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "symbol?") x)) (let* ((_a$1575 (jolt-rest items)) (_a$1576 (jolt-invoke (var-deref "clojure.core" "name") x)) (_a$1577 forms)) (loop1574 _a$1575 _a$1576 _a$1577)) (let* ((_a$1588 (jolt-rest items)) (_a$1589 proto) (_a$1590 (jolt-conj forms (let* ((_a$1582 (var-deref "clojure.core" "__sqcat")) (_a$1583 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "register-method"))) (_a$1584 (jolt-invoke (var-deref "clojure.core" "__sq1") tname)) (_a$1585 (jolt-invoke (var-deref "clojure.core" "__sq1") proto)) (_a$1586 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-invoke (var-deref "clojure.core" "name") (jolt-first x)))) (_a$1587 (jolt-invoke (var-deref "clojure.core" "__sq1") (let* ((_a$1578 (var-deref "clojure.core" "__sqcat")) (_a$1579 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-symbol "clojure.core" "fn"))) (_a$1580 (jolt-invoke (var-deref "clojure.core" "__sq1") (jolt-nth x 1))) (_a$1581 (jolt-drop 2 x))) (jolt-invoke _a$1578 _a$1579 _a$1580 _a$1581))))) (jolt-invoke _a$1582 _a$1583 _a$1584 _a$1585 _a$1586 _a$1587))))) (loop1574 _a$1588 _a$1589 _a$1590))))))))))) diff --git a/jolt-core/clojure/core/30-macros.clj b/jolt-core/clojure/core/30-macros.clj index 728f48c..e4f4ef6 100644 --- a/jolt-core/clojure/core/30-macros.clj +++ b/jolt-core/clojure/core/30-macros.clj @@ -380,31 +380,35 @@ step))) ;; True when atype's methods were registered for this protocol (via extend / -;; extend-type). Tags are canonical host names or ns-qualified record names, -;; so a bare record name also matches its "ns.Name" tag. +;; extend-type). Tags are canonical host names or ns-qualified record names, so a +;; name matches its tag when either is a dotted suffix of the other — a bare +;; record name matches its "ns.Name" tag, and a query for a qualified host class +;; (java.util.Map) matches the canonical short tag (Map) extend registered it as. (defn extends? [protocol atype] - (let [want (name atype) - dotted (str "." want) - dlen (count dotted)] + (let [want (if (nil? atype) "nil" (name atype)) + suffix? (fn [long short] + (let [d (str "." short)] + (and (> (count long) (count d)) + (= (subs long (- (count long) (count d))) d))))] (boolean (some (fn [t] (let [tn (name t)] - (or (= tn want) - (and (> (count tn) dlen) - (= (subs tn (- (count tn) dlen)) dotted))))) + (or (= tn want) (suffix? tn want) (suffix? want tn)))) (extenders protocol))))) ;; extend, the FUNCTION (extend-type's runtime sibling): protocol + method-map ;; pairs, methods registered under the type's (canonicalized) name — so ;; (extend 'String P {:m (fn [x] ...)}) dispatches exactly like extend-type. (defn extend [atype & proto+mmaps] - (loop [s (seq proto+mmaps)] - (when s - (let [proto (first s) - mmap (second s) - pname (name (get proto :name))] - (doseq [[k f] mmap] - (register-method (name atype) pname (name k) f))) - (recur (nnext s))))) + ;; nil extends on nil values; its host tag is the string "nil" (as extend-type). + (let [tname (if (nil? atype) "nil" (name atype))] + (loop [s (seq proto+mmaps)] + (when s + (let [proto (first s) + mmap (second s) + pname (name (get proto :name))] + (doseq [[k f] mmap] + (register-method tname pname (name k) f))) + (recur (nnext s)))))) (defmacro extend-type [tsym & body] ;; register-method is a fn (clojure.core); pass type/protocol/method NAMES as diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index bd247e6..d16ca55 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -516,6 +516,9 @@ ;; jolt.passes.numeric types a call to it (an accumulator over the result). :var (cond-> (var-ref (:ns r) (:name r)) (:num-ret r) (assoc :num-ret (:num-ret r))) :host (host-ref (:name r)) + ;; a class-name symbol (java.util.Map) self-evaluates to its name + ;; string — jolt models a class as its name, with no JVM classes. + :class (const (:name r)) ;; :unresolved — emitting a var-ref here would auto-intern an ;; UNBOUND var, so a typo'd symbol would die later as 'Cannot call ;; nil as a function' with no hint which symbol. diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index e3412c1..39337fa 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -2953,4 +2953,36 @@ {:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "syntax-quote resolves alias" :expected "\"HI\"" :actual "(do (ns sq.lib (:require [clojure.string :as s])) (defmacro up [x] `(s/upper-case ~x)) (in-ns (quote user)) (sq.lib/up \"hi\"))"} {:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "ns name with ^{:map} meta" :expected "5" :actual "(do (ns ^{:author \"a\" :doc \"d\"} nm.meta) (def q 5) (in-ns (quote user)) nm.meta/q)"} {:suite "conformance / defmacro surface + syntax-quote/ns (enabling real clojure libs)" :label "unquote *ns* in template" :expected "true" :actual "(do (defmacro cur-ns [] `(str ~*ns*)) (string? (cur-ns)))"} + {:suite "reader / read-string constructs sets" :label "top-level set" :expected "true" :actual "(set? (read-string \"#{:a :b}\"))"} + {:suite "reader / read-string constructs sets" :label "set value equals" :expected "true" :actual "(= #{1 2} (read-string \"#{1 2}\"))"} + {:suite "reader / read-string constructs sets" :label "set nested in map" :expected "true" :actual "(set? (:k (read-string \"{:k #{:a :b}}\")))"} + {:suite "reader / read-string constructs sets" :label "set nested in vector" :expected "true" :actual "(set? (first (read-string \"[#{:a}]\")))"} + {:suite "reader / read-string constructs sets" :label "set nested in list" :expected "true" :actual "(set? (first (read-string \"(#{:a})\")))"} + {:suite "reader / read-string constructs sets" :label "set keeps reader metadata" :expected "true" :actual "(:s (meta (read-string \"^:s #{1 2}\")))"} + {:suite "reader / read-string constructs sets" :label "set of sets" :expected "true" :actual "(every? set? (read-string \"#{#{1} #{2}}\"))"} + {:suite "io / str & format" :label "format %x lowercase" :expected "\"ff\"" :actual "(format \"%x\" 255)"} + {:suite "io / str & format" :label "format %04x zero-pad lower" :expected "\"00ff\"" :actual "(format \"%04x\" 255)"} + {:suite "io / str & format" :label "format %X uppercase" :expected "\"00FF\"" :actual "(format \"%04X\" 255)"} + {:suite "io / str & format" :label "format %x wide hex" :expected "\"deadbeef\"" :actual "(format \"%x\" 3735928559)"} + {:suite "protocols / extend & extends? on nil" :label "extend nil dispatches" :expected ":nil-via-extend" :actual "(do (defprotocol P2 (q [this])) (extend nil P2 {:q (fn [_] :nil-via-extend)}) (q nil))"} + {:suite "protocols / extend & extends? on nil" :label "extends? nil when extended" :expected "true" :actual "(do (defprotocol Pe (pe [this])) (extend nil Pe {:pe (fn [_] :x)}) (extends? Pe nil))"} + {:suite "protocols / extend & extends? on nil" :label "extends? nil when not extended" :expected "false" :actual "(do (defprotocol P3 (r [this])) (extends? P3 nil))"} + {:suite "protocols / extend & extends? on nil" :label "extend-type nil still works" :expected ":via-type" :actual "(do (defprotocol P4 (s [this])) (extend-type nil P4 (s [_] :via-type)) (s nil))"} + {:suite "protocols / extend on host classes" :label "dispatch by java.util.Map/Collection/CharSequence" :expected "[:map :coll :str :obj]" :actual "(do (defprotocol W (-w [x])) (extend java.util.Map W {:-w (fn [_] :map)}) (extend java.util.Collection W {:-w (fn [_] :coll)}) (extend java.lang.CharSequence W {:-w (fn [_] :str)}) (extend java.lang.Object W {:-w (fn [_] :obj)}) [(-w {:a 1}) (-w [1 2]) (-w \"s\") (-w 42)])"} + {:suite "protocols / extend on host classes" :label "satisfies? via java.util.Map" :expected "true" :actual "(do (defprotocol Q (qq [x])) (extend java.util.Map Q {:qq (fn [_] :m)}) (satisfies? Q {}))"} + {:suite "protocols / extend on host classes" :label "extends? on a qualified host class" :expected "true" :actual "(do (defprotocol Qe (qe [x])) (extend java.util.Collection Qe {:qe (fn [_] :c)}) (extends? Qe java.util.Collection))"} + {:suite "interop / instance? on host interfaces" :label "keyword is Named" :expected "true" :actual "(instance? clojure.lang.Named :a)"} + {:suite "interop / instance? on host interfaces" :label "string is CharSequence" :expected "true" :actual "(instance? java.lang.CharSequence \"s\")"} + {:suite "interop / instance? on host interfaces" :label "number is Number" :expected "true" :actual "(instance? java.lang.Number 42)"} + {:suite "interop / instance? on host interfaces" :label "map is java.util.Map" :expected "true" :actual "(instance? java.util.Map {:a 1})"} + {:suite "interop / instance? on host interfaces" :label "vector is java.util.List" :expected "true" :actual "(instance? java.util.List [1 2])"} + {:suite "interop / instance? on host interfaces" :label "list is java.util.Collection" :expected "true" :actual "(instance? java.util.Collection (list 1))"} + {:suite "interop / instance? on host interfaces" :label "set is java.util.Set" :expected "true" :actual "(instance? java.util.Set #{1})"} + {:suite "interop / instance? on host interfaces" :label "map is not a Collection" :expected "false" :actual "(instance? java.util.Collection {:a 1})"} + {:suite "interop / instance? on host interfaces" :label "vector is Associative" :expected "true" :actual "(instance? clojure.lang.Associative [1])"} + {:suite "interop / instance? on host interfaces" :label "string is not Number" :expected "false" :actual "(instance? java.lang.Number \"s\")"} + {:suite "interop / String & StringBuilder char ops" :label "String from char-array slice" :expected "\"abc\"" :actual "(String. (char-array [\\a \\b \\c \\d]) 0 3)"} + {:suite "interop / String & StringBuilder char ops" :label "str of StringBuilder" :expected "\"hi\"" :actual "(let [sb (StringBuilder.)] (.append sb \"hi\") (str sb))"} + {:suite "interop / String & StringBuilder char ops" :label "append subsequence" :expected "\"bcd\"" :actual "(let [sb (StringBuilder.)] (.append sb \"abcde\" 1 4) (.toString sb))"} + {:suite "interop / String & StringBuilder char ops" :label "String.getChars into buffer" :expected "\"abc\"" :actual "(let [a (char-array 4)] (.getChars \"abcd\" 0 3 a 0) (String. a 0 3))"} ] diff --git a/test/chez/unit.edn b/test/chez/unit.edn index a8b49fa..6d9e84e 100644 --- a/test/chez/unit.edn +++ b/test/chez/unit.edn @@ -316,8 +316,8 @@ {:suite "reader" :expr "(= [1 2 3] (read-string \"[1 2 3]\"))" :expected "true"} {:suite "reader" :expr "(= (quote (+ 1 2)) (read-string \"(+ 1 2)\"))" :expected "true"} {:suite "reader" :expr "(= {:a 1 :b 2} (read-string \"{:a 1 :b 2}\"))" :expected "true"} - {:suite "reader" :expr "(:value (read-string \"#{1 2 3}\"))" :expected "[1 2 3]"} - {:suite "reader" :expr "(= :jolt/set (:jolt/type (read-string \"#{1 2 3}\")))" :expected "true"} + {:suite "reader" :expr "(set? (read-string \"#{1 2 3}\"))" :expected "true"} + {:suite "reader" :expr "(= #{1 2 3} (read-string \"#{1 2 3}\"))" :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 (clojure.core/deref a)) (read-string \"@a\"))" :expected "true"}