simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #256 from jolt-lang/conformance/tools-reader

Browse source 
conformance: general fixes from tools.reader, core.contracts, data.zip, data.csv (+ math.combinatorics)
This commit is contained in:
Dmitri Sotnikov 2026-06-27 19:06:19 +00:00 • committed by GitHub
commit 86dd9650b6
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
15 changed files with 333 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

9
docs/libraries.md
View file

@ -52,6 +52,15 @@ e.g. the [ring-app example](https://github.com/jolt-lang/examples/tree/main/ring
(`<!`/`>!`/`alts!`, `pipeline`, `mult`/`mix`/`pub`/`sub`) on real OS threads.
* [core.logic](https://github.com/clojure/core.logic) — relational logic programming
(unification, `run`/`fresh`/`conde`, finite domains).
* [math.combinatorics](https://github.com/clojure/math.combinatorics) — permutations,
combinations, subsets, selections, cartesian products, partitions.
* [core.contracts](https://github.com/clojure/core.contracts) — programming by
contract (`contract`/`with-constraints`/`provide`), over
[core.unify](https://github.com/clojure/core.unify).
* [data.zip](https://github.com/clojure/data.zip) — zipper navigation, including
`clojure.data.zip.xml`; XML parsing via [jolt-lang/xml](https://github.com/jolt-lang/xml)
(which now ships `clojure.xml/parse`).
* [data.csv](https://github.com/clojure/data.csv) — reading and writing CSV.
* [tick](https://github.com/juxt/tick) — date/time over Jolt's `java.time`;
`#time/…` literals via `time-literals`.
* [transit-jolt](https://github.com/jolt-lang/transit-jolt) — Transit (JSON) read/write

7
host/chez/converters.ss
View file

@ -133,7 +133,12 @@
(else (loop (- i 1))))))))
((keyword? a) (jolt-symbol (keyword-t-ns a) (keyword-t-name a)))
(else (error #f "symbol: requires string/symbol" a)))))
((= (length args) 2) (jolt-symbol (car args) (cadr args)))
;; (symbol ns name): a nil namespace is the no-ns sentinel #f (NOT jolt-nil),
;; so (symbol nil "x") equals (symbol "x") and the reader literal 'x — jolt=
;; compares ns with strict equal?, so a jolt-nil ns would differ from #f.
((= (length args) 2)
(let ((ns (car args)))
(jolt-symbol (if (jolt-nil? ns) #f ns) (cadr args))))
(else (error #f "symbol: wrong arity"))))
;; gensym: per-process counter.

8
host/chez/host-contract.ss
View file

@ -74,6 +74,11 @@
;; reconstruct it by name at the call site.
(define (hc-ns-value? x) (jns? x))
(define (hc-ns-value-name x) (jns-name x))
;; a live Var value spliced into a form (a macro that does `(~v …)` with v a
;; resolved var) — the analyzer turns it into a :the-var reference by ns+name.
(define (hc-var-value? x) (var-cell? x))
(define (hc-var-value-ns x) (var-cell-ns x))
(define (hc-var-value-name x) (var-cell-name x))
;; --- form accessors ---------------------------------------------------------
(define (hc-char-code x) (char->integer x)) ; native Chez char -> codepoint
@ -463,6 +468,9 @@
(def-var! "jolt.host" "form-uuid?" hc-uuid?)
(def-var! "jolt.host" "form-ns-value?" hc-ns-value?)
(def-var! "jolt.host" "form-ns-value-name" hc-ns-value-name)
(def-var! "jolt.host" "form-var-value?" hc-var-value?)
(def-var! "jolt.host" "form-var-value-ns" hc-var-value-ns)
(def-var! "jolt.host" "form-var-value-name" hc-var-value-name)
(def-var! "jolt.host" "form-bigdec?" hc-bigdec?)
(def-var! "jolt.host" "form-bigdec-source" hc-bigdec-source)
(def-var! "jolt.host" "form-elements" hc-elements)

100
host/chez/java/host-static-classes.ss
View file

@ -50,7 +50,7 @@
(cond ((null? args) (make-arraylist '()))
((number? (car args)) (make-arraylist '()))
(else (make-arraylist (seq->list (jolt-seq (car args))))))))
(register-host-methods! "arraylist"
(define arraylist-methods
(list
(cons "add" (lambda (self . a)
;; (.add x) -> append+true; (.add i x) -> insert at i, returns nil.
@ -58,6 +58,14 @@
(begin (al-push! self (car a)) #t)
(begin (al-insert-at! self (jnum->exact (car a)) (cadr a)) jolt-nil))))
(cons "add!" (lambda (self x) (al-push! self x) #t))
(cons "addAll" (lambda (self . a)
;; (.addAll coll) appends; (.addAll i coll) inserts at i.
(let* ((at-i (= 2 (length a)))
(i (if at-i (jnum->exact (car a)) (al-cnt self)))
(coll (if at-i (cadr a) (car a))))
(let loop ((xs (seq->list (jolt-seq coll))) (k i))
(if (null? xs) (pair? (seq->list (jolt-seq coll)))
(begin (al-insert-at! self k (car xs)) (loop (cdr xs) (fx+ k 1))))))))
(cons "get" (lambda (self i) (vector-ref (al-vec self) (jnum->exact i))))
(cons "set" (lambda (self i x)
(let* ((idx (jnum->exact i)) (old (vector-ref (al-vec self) idx)))
@ -72,6 +80,43 @@
(cons "toArray" (lambda (self . _) (apply jolt-vector (al->list self))))
(cons "iterator" (lambda (self) (make-jiterator (list->cseq (al->list self)))))
(cons "toString" (lambda (self) (jolt-pr-str (list->cseq (al->list self)))))))
(register-host-methods! "arraylist" arraylist-methods)
;; java.util.LinkedList: the ArrayList backing plus the Deque surface
;; (addFirst/addLast/removeFirst/removeLast/getFirst/getLast/peek/push/pop).
;; tools.reader holds pending splice forms in one and (seq)s / .remove(0)s it.
(define (al-first self) (vector-ref (al-vec self) 0))
(define (al-last self) (vector-ref (al-vec self) (fx- (al-cnt self) 1)))
(define linkedlist-methods
(append arraylist-methods
(list
(cons "addFirst" (lambda (self x) (al-insert-at! self 0 x) jolt-nil))
(cons "addLast" (lambda (self x) (al-push! self x) jolt-nil))
(cons "offer" (lambda (self x) (al-push! self x) #t))
(cons "removeFirst" (lambda (self) (let ((o (al-first self))) (al-remove-at! self 0) o)))
(cons "removeLast" (lambda (self) (let ((o (al-last self))) (al-remove-at! self (fx- (al-cnt self) 1)) o)))
(cons "getFirst" al-first) (cons "getLast" al-last)
(cons "peek" (lambda (self) (if (fx=? 0 (al-cnt self)) jolt-nil (al-first self))))
(cons "poll" (lambda (self) (if (fx=? 0 (al-cnt self)) jolt-nil (let ((o (al-first self))) (al-remove-at! self 0) o))))
(cons "push" (lambda (self x) (al-insert-at! self 0 x) jolt-nil))
(cons "pop" (lambda (self) (let ((o (al-first self))) (al-remove-at! self 0) o))))))
(define (make-linkedlist xs)
(let ((al (make-arraylist xs))) (make-jhost "linkedlist" (jhost-state al))))
(register-host-methods! "linkedlist" linkedlist-methods)
(let ((ctor (lambda args
(cond ((null? args) (make-linkedlist '()))
(else (make-linkedlist (seq->list (jolt-seq (car args)))))))))
(register-class-ctor! "LinkedList" ctor)
(register-class-ctor! "java.util.LinkedList" ctor))
;; ArrayList / LinkedList are Iterable: (seq al) walks the elements (nil if empty),
;; so (seq pending-forms) and reduce/into over one work like the JVM.
(define %al-seq jolt-seq)
(set! jolt-seq
(lambda (x)
(if (and (jhost? x) (or (string=? (jhost-tag x) "arraylist") (string=? (jhost-tag x) "linkedlist")))
(list->cseq (al->list x))
(%al-seq x))))
;; 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).
@ -109,6 +154,9 @@
(cons "flush" (lambda (self) jolt-nil))
(cons "close" (lambda (self) jolt-nil))
(cons "toString" (lambda (self) (sb-str self)))))
;; (str sw) / print a StringWriter -> its accumulated content, like the JVM
;; (str calls toString) — data.csv writes CSV to a StringWriter and reads it back.
(register-str-render! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "writer"))) sb-str)
;; a file-backed writer (clojure.java.io/writer of a File/path): accumulates like
;; StringWriter, then persists to the path on flush/close, so
@ -433,8 +481,12 @@
(list->string (vector->list v)))))
((string? x) x)
(else (jolt-str-render-one x)))))
;; (BigInteger. s) | (BigInteger. s radix) — parse a string in the given radix
;; (default 10). tools.reader's integer parser builds (BigInteger. digits radix).
(register-class-ctor! "BigInteger"
(lambda (v) (parse-int-or-throw v 10 "BigInteger")))
(lambda (v . r) (parse-int-or-throw v (if (null? r) 10 (jnum->exact (car r))) "BigInteger")))
(register-class-ctor! "java.math.BigInteger"
(lambda (v . r) (parse-int-or-throw v (if (null? r) 10 (jnum->exact (car r))) "BigInteger")))
(register-class-ctor! "MapEntry" (lambda (k v) (make-map-entry k v)))
;; JVM exception ctors -> a typed host throwable carrying the canonical :jolt/class
;; (so class / instance? / getMessage / ex-message reflect the real type) and the
@ -568,17 +620,29 @@
(define %hs-rmd2 record-method-dispatch)
(set! record-method-dispatch
(lambda (obj method-name rest-args)
(if (regex-t? obj)
(let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
(cond ((string=? method-name "split")
;; .split returns a String[] — a seq (prints
;; (a b c), not a vector). re-split with no limit; drop trailing
;; empties (JVM default).
(let ((parts (re-split (regex-t-irx obj) (car rest) #f)))
(list->cseq (str-split-drop-trailing parts))))
((string=? method-name "pattern") (regex-t-source obj))
(else (error #f (string-append "No method " method-name " on Pattern")))))
(%hs-rmd2 obj method-name rest-args))))
(let ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))))
(cond
((regex-t? obj)
(cond ((string=? method-name "split")
;; .split returns a String[] — a seq (prints
;; (a b c), not a vector). re-split with no limit; drop trailing
;; empties (JVM default).
(let ((parts (re-split (regex-t-irx obj) (car rest) #f)))
(list->cseq (str-split-drop-trailing parts))))
((string=? method-name "pattern") (regex-t-source obj))
((or (string=? method-name "toString")) (regex-t-source obj))
;; (.matcher pattern s) -> a Matcher (matcher-t) for stepping matches.
((string=? method-name "matcher") (jolt-re-matcher obj (car rest)))
(else (error #f (string-append "No method " method-name " on Pattern")))))
;; java.util.regex.Matcher: .matches (anchored whole-region), .find
;; (next match), .group [n], .groupCount.
((jolt-matcher? obj)
(cond ((string=? method-name "matches") (jolt-matcher-matches obj))
((string=? method-name "find") (not (jolt-nil? (jolt-re-find obj))))
((string=? method-name "group") (apply jolt-matcher-group obj rest))
((string=? method-name "groupCount") (jolt-matcher-group-count obj))
(else (error #f (string-append "No method " method-name " on Matcher")))))
(else (%hs-rmd2 obj method-name rest-args))))))
;; ---- def-var! the registry entry points so emit can also reach them ---------
(def-var! "clojure.core" "host-static-ref" host-static-ref)
@ -855,8 +919,14 @@
;; class-keyed multimethod / (isa? (class x) SomeClass) dispatches like the JVM.
;; (Object is supplied universally by class-isa?, so it need not be listed.)
(reg-class-supers! "clojure.lang.IFn" '("clojure.lang.Fn" "java.lang.Runnable" "java.util.concurrent.Callable"))
(reg-class-supers! "clojure.lang.Keyword" '("clojure.lang.Named" "java.lang.Comparable"))
(reg-class-supers! "clojure.lang.Symbol" '("clojure.lang.Named" "java.lang.Comparable"))
;; Keyword and Symbol implement IFn (they are callable: (:k m) / ('s m)), so a
;; (class x)-dispatched multimethod with an IFn method matches them, like the JVM.
(reg-class-supers! "clojure.lang.Keyword" '("clojure.lang.Named" "java.lang.Comparable"
"clojure.lang.IFn" "clojure.lang.Fn"
"java.lang.Runnable" "java.util.concurrent.Callable"))
(reg-class-supers! "clojure.lang.Symbol" '("clojure.lang.Named" "java.lang.Comparable"
"clojure.lang.IFn" "clojure.lang.Fn"
"java.lang.Runnable" "java.util.concurrent.Callable"))
(reg-class-supers! "java.lang.String" '("java.lang.CharSequence" "java.lang.Comparable"))
(reg-class-supers! "clojure.lang.PersistentHashSet" '("clojure.lang.APersistentSet" "clojure.lang.IPersistentSet" "clojure.lang.IPersistentCollection" "java.util.Set" "java.util.Collection" "java.lang.Iterable"))
(reg-class-supers! "clojure.lang.PersistentTreeSet" '("clojure.lang.APersistentSet" "clojure.lang.IPersistentSet" "clojure.lang.IPersistentCollection" "java.util.Set" "java.util.Collection" "java.lang.Iterable"))

64
host/chez/java/host-static-methods.ss
View file

@ -96,6 +96,70 @@
(register-class-statics! "PersistentArrayMap" (list (cons "createWithCheck" pam-create-with-check)))
(register-class-statics! "clojure.lang.PersistentArrayMap" (list (cons "createWithCheck" pam-create-with-check)))
;; clojure.lang.RT/map: build a map from a [k v k v…] array/seq (RT.map). Small
;; maps keep insertion order (PersistentArrayMap). tools.reader builds map and
;; namespaced-map literals this way.
(define (rt-map arr)
(let loop ((xs (if (jolt-nil? arr) '() (seq->list (jolt-seq arr)))) (m (jolt-hash-map)))
(cond ((null? xs) m)
((null? (cdr xs)) (error #f "RT/map: odd key/value count"))
(else (loop (cddr xs) (jolt-assoc m (car xs) (cadr xs)))))))
(register-class-statics! "RT" (list (cons "map" rt-map)))
(register-class-statics! "clojure.lang.RT" (list (cons "map" rt-map)))
;; clojure.lang.PersistentList/create: a list (in order) from a seq; empty -> ().
(define (plist-create x)
(let ((items (seq->list (jolt-seq x))))
(if (null? items) jolt-empty-list (list->cseq items))))
(register-class-statics! "PersistentList" (list (cons "create" plist-create)))
(register-class-statics! "clojure.lang.PersistentList" (list (cons "create" plist-create)))
;; clojure.lang.PersistentHashSet/createWithCheck: a set from a seq, throwing on a
;; duplicate element (tools.reader's #{…} reader reports the dup).
(define (phs-create-with-check x)
(let loop ((xs (seq->list (jolt-seq x))) (s (jolt-hash-set)))
(if (null? xs) s
(let ((e (car xs)))
(if (jolt-truthy? (jolt-contains? s e))
(jolt-throw (jolt-ex-info (string-append "Duplicate key: " (jolt-str-render-one e)) (jolt-hash-map)))
(loop (cdr xs) (jolt-conj1 s e)))))))
(register-class-statics! "PersistentHashSet" (list (cons "createWithCheck" phs-create-with-check)))
(register-class-statics! "clojure.lang.PersistentHashSet" (list (cons "createWithCheck" phs-create-with-check)))
;; java.lang.Character statics. digit(ch, radix) -> the digit value or -1; ch may
;; be a char or an int codepoint (tools.reader passes (int c)). isDigit/
;; isWhitespace take a char; valueOf boxes a char (identity on jolt).
(define (char->cp x) (if (char? x) (char->integer x) (jnum->exact x)))
(define (char-digit-value cp radix)
(let ((d (cond ((and (fx>=? cp 48) (fx<=? cp 57)) (fx- cp 48)) ; 0-9
((and (fx>=? cp 97) (fx<=? cp 122)) (fx+ 10 (fx- cp 97))) ; a-z
((and (fx>=? cp 65) (fx<=? cp 90)) (fx+ 10 (fx- cp 65))) ; A-Z
(else 99))))
(if (fx<? d radix) d -1)))
(define character-statics
(list (cons "digit" (lambda (ch radix) (->num (char-digit-value (char->cp ch) (jnum->exact radix)))))
(cons "isDigit" (lambda (ch) (let ((cp (char->cp ch))) (and (fx>=? cp 48) (fx<=? cp 57)))))
(cons "isWhitespace" (lambda (ch) (char-whitespace? (integer->char (char->cp ch)))))
(cons "valueOf" (lambda (ch) (if (char? ch) ch (integer->char (char->cp ch)))))))
(register-class-statics! "Character" character-statics)
(register-class-statics! "java.lang.Character" character-statics)
;; java.util.regex.Pattern/compile: a regex value from a string pattern.
(define pattern-statics (list (cons "compile" (lambda (s) (jolt-regex (jolt-str-render-one s))))))
(register-class-statics! "Pattern" pattern-statics)
(register-class-statics! "java.util.regex.Pattern" pattern-statics)
;; clojure.lang.BigInt / clojure.lang.Numbers: jolt has one exact-integer type
;; (Chez bignums auto-reduce), so BigInt.fromBigInteger and Numbers.reduceBigInt
;; are identity. tools.reader's number parser threads integers through these.
(define identity-num-statics (list (cons "fromBigInteger" (lambda (x) x))))
(register-class-statics! "BigInt" identity-num-statics)
(register-class-statics! "clojure.lang.BigInt" identity-num-statics)
(register-class-statics! "Numbers"
(list (cons "reduceBigInt" (lambda (x) x)) (cons "toRatio" (lambda (x) x))))
(register-class-statics! "clojure.lang.Numbers"
(list (cons "reduceBigInt" (lambda (x) x)) (cons "toRatio" (lambda (x) x))))
(define (now-millis)
(let ((t (current-time 'time-utc)))
(+ (* 1000 (time-second t)) (quotient (time-nanosecond t) 1000000))))

7
host/chez/java/host-static.ss
View file

@ -88,6 +88,13 @@
;; Double/Float .isNaN / .isInfinite (a non-flonum is neither).
((string=? method "isNaN") (and (flonum? n) (not (= n n))))
((string=? method "isInfinite") (and (flonum? n) (infinite? n)))
;; BigInteger interop: .negate / .bitLength / .signum / .abs. A jolt integer is
;; a Chez exact integer, so these are native (integer-length = JVM bitLength,
;; matching for negative values too). tools.reader's number parser uses them.
((string=? method "negate") (->num (- (jnum->exact n))))
((string=? method "abs") (->num (abs (jnum->exact n))))
((string=? method "bitLength") (->num (integer-length (jnum->exact n))))
((string=? method "signum") (->num (let ((e (jnum->exact n))) (cond ((> e 0) 1) ((< e 0) -1) (else 0)))))
(else (error #f (string-append "No method " method " for number")))))
;; Mutable static fields: "Class" -> (member -> 1-vector cell). A library that

95
host/chez/loader.ss
View file

@ -227,50 +227,93 @@
(else '()))))
(and (pair? items) (symbol-t? (car items)) (symbol-t-name (car items)))))
;; A libspec under a prefix joins onto it: a bare symbol `string` -> `prefix.string`,
;; a vector `[string :as s]` -> `[prefix.string :as s]` (opts preserved).
(define (prefix-join prefix lib)
(cond
((symbol-t? lib) (jolt-symbol #f (string-append prefix "." (symbol-t-name lib))))
((pvec? lib)
(let ((items (seq->list lib)))
(if (and (pair? items) (symbol-t? (car items)))
(apply jolt-vector (jolt-symbol #f (string-append prefix "." (symbol-t-name (car items)))) (cdr items))
lib)))
(else lib)))
;; The prefix-list form of a require/use spec: a LIST `(prefix lib …)` expands to
;; one spec per lib (prefix.lib), so (:require (clojure [string :as str])) means
;; clojure.string :as str. A vector / symbol spec is already a single lib.
(define (expand-spec s)
(if (or (cseq? s) (empty-list-t? s))
(let ((items (seq->list s)))
(if (and (pair? items) (symbol-t? (car items)) (pair? (cdr items)))
(map (lambda (lib) (prefix-join (symbol-t-name (car items)) lib)) (cdr items))
(list s)))
(list s)))
;; --- require/use that LOAD ---------------------------------------------------
;; Override the alias-only versions from natives-str.ss. Load each spec's target
;; (no-op if baked/already loaded), THEN register its :as/:refer under the caller
;; ns (chez-register-spec! reads the current ns, restored by load-namespace).
(define (loader-require . specs)
(for-each
(lambda (s)
(let ((target (spec-target-name s)))
(when target (load-namespace target)))
(chez-register-spec! (chez-current-ns) s))
(lambda (s0)
(for-each
(lambda (s)
(let ((target (spec-target-name s)))
(when target (load-namespace target)))
(chez-register-spec! (chez-current-ns) s))
(expand-spec s0)))
specs)
jolt-nil)
(def-var! "clojure.core" "require" loader-require)
(define (loader-use . specs)
(define (loader-use . specs0)
(for-each
(lambda (spec)
(let ((target (spec-target-name spec)))
(when target (load-namespace target)))
(chez-register-spec! (chez-current-ns) spec)
(let* ((items (cond ((pvec? spec) (seq->list spec))
((or (cseq? spec) (empty-list-t? spec)) (seq->list spec))
((symbol-t? spec) (list spec))
(else '())))
(target (and (pair? items) (symbol-t? (car items)) (symbol-t-name (car items))))
(filtered (let scan ((xs (if (pair? items) (cdr items) '())))
(cond ((null? xs) #f)
((and (keyword? (car xs))
(member (keyword-t-name (car xs)) '("only" "refer"))) #t)
(else (scan (cdr xs)))))))
(when (and target (not filtered))
(chez-register-refer-all! (chez-current-ns) target))))
specs)
(lambda (spec0)
(for-each
(lambda (spec)
(let ((target (spec-target-name spec)))
(when target (load-namespace target)))
(chez-register-spec! (chez-current-ns) spec)
(let* ((items (cond ((pvec? spec) (seq->list spec))
((symbol-t? spec) (list spec))
(else '())))
(target (and (pair? items) (symbol-t? (car items)) (symbol-t-name (car items))))
(filtered (let scan ((xs (if (pair? items) (cdr items) '())))
(cond ((null? xs) #f)
((and (keyword? (car xs))
(member (keyword-t-name (car xs)) '("only" "refer"))) #t)
(else (scan (cdr xs)))))))
(when (and target (not filtered))
(chez-register-refer-all! (chez-current-ns) target))))
(expand-spec spec0)))
specs0)
jolt-nil)
(def-var! "clojure.core" "use" loader-use)
(def-var! "clojure.core" "load-file" jolt-load-file)
;; load: each arg is a "/"-rooted resource path like "/app/extra"; load the file
;; for it relative to the search roots (strip the leading slash, try .clj/.cljc).
;; The directory of a namespace's resource path: "clojure.tools.reader-test" ->
;; "clojure/tools" (drop the last segment of ns-name->rel). "" for a top-level ns.
(define (ns-rel-dir name)
(let* ((r (ns-name->rel name)))
(let loop ((k (fx- (string-length r) 1)))
(cond ((fx<? k 0) "")
((char=? (string-ref r k) #\/) (substring r 0 k))
(else (loop (fx- k 1)))))))
;; load: an arg starting with "/" is a root-relative resource path ("/app/extra");
;; otherwise it is resolved against the CURRENT namespace's directory, matching
;; Clojure — (load "common_tests") from clojure.tools.reader-test loads
;; clojure/tools/common_tests.clj. Strip the leading slash / try .clj/.cljc.
(define (jolt-load . paths)
(for-each
(lambda (p)
(let* ((rel (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/))
(substring p 1 (string-length p)) p))
(let* ((rel (cond
((and (> (string-length p) 0) (char=? (string-ref p 0) #\/))
(substring p 1 (string-length p)))
(else (let ((dir (ns-rel-dir (chez-current-ns))))
(if (string=? dir "") p (string-append dir "/" p))))))
(f (resolve-on-roots rel)))
(if f (load-jolt-file f)
(error #f "Could not locate resource on source roots" p))))

18
host/chez/reader.ss
View file

@ -47,6 +47,11 @@
(memv c '(#\( #\) #\[ #\] #\{ #\} #\" #\; #\@ #\^ #\` #\~ #\\))))
(define (rdr-digit? c) (and (char>=? c #\0) (char<=? c #\9)))
(define (rdr-octal? c) (and (char>=? c #\0) (char<=? c #\7)))
;; every char of s in [from,to) is an octal digit (and the span is non-empty).
(define (rdr-all-octal? s from to)
(and (fx<? from to)
(let loop ((i from)) (cond ((fx=? i to) #t) ((rdr-octal? (string-ref s i)) (loop (fx+ i 1))) (else #f)))))
;; Advance past whitespace, commas, and ;-to-end-of-line comments.
(define (rdr-skip-ws s i end)
@ -129,6 +134,11 @@
(and radix (integer? radix) (>= radix 2) (<= radix 36)
(let ((v (rdr-parse-radix (substring body (+ ri 1) blen) radix)))
(and v (* sign v)))))))
;; octal 0NNN: a leading 0 followed by octal digits (Clojure reads 042 as 34,
;; not decimal 42). "0" alone, 0x.., 0r.. and a float "0.5" are handled
;; elsewhere or fall through (a non-octal digit fails rdr-all-octal?).
((and (>= blen 2) (char=? (string-ref body 0) #\0) (rdr-all-octal? body 1 blen))
(let ((o (rdr-parse-radix (substring body 1 blen) 8))) (and o (* sign o))))
;; bigint suffix N
((and (> blen 1) (char=? (string-ref body (- blen 1)) #\N))
(let ((n (string->number (substring body 0 (- blen 1)))))
@ -174,7 +184,13 @@
((#\") (loop (+ i 2) (cons #\" acc)))
((#\b) (loop (+ i 2) (cons #\backspace acc)))
((#\f) (loop (+ i 2) (cons #\page acc)))
((#\0) (loop (+ i 2) (cons #\nul acc)))
;; octal escape \ooo: 1-3 octal digits (Clojure's \0..\377), so \000
;; is one null char, not \0 + literal "00".
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7)
(let oct ((j (+ i 1)) (val 0) (cnt 0))
(if (and (fx<? cnt 3) (fx<? j end) (rdr-octal? (string-ref s j)))
(oct (fx+ j 1) (fx+ (fx* val 8) (fx- (char->integer (string-ref s j)) 48)) (fx+ cnt 1))
(loop j (cons (integer->char val) acc)))))
((#\u)
(let-values (((cp j) (rdr-hex->int s (+ i 2) 4)))
;; A \u escape is a UTF-16 code unit. jolt chars are Unicode scalars,

19
host/chez/records.ss
View file

@ -469,6 +469,18 @@
((and (jhost? obj) (string=? (jhost-tag obj) "uri")) '("URI" "java.net.URI" "Object"))
;; a ByteBuffer — extend-protocol java.nio.ByteBuffer (aws-api util).
((and (jhost? obj) (string=? (jhost-tag obj) "byte-buffer")) '("ByteBuffer" "java.nio.ByteBuffer" "Object"))
;; java.io readers/writers — so (extend-protocol java.io.Reader …) (data.csv)
;; and the like dispatch on one. A PushbackReader is also a Reader.
((and (jhost? obj) (string=? (jhost-tag obj) "string-reader"))
'("StringReader" "java.io.StringReader" "Reader" "java.io.Reader" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "pushback-reader"))
'("PushbackReader" "java.io.PushbackReader" "FilterReader" "java.io.FilterReader" "Reader" "java.io.Reader" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "char-reader"))
'("Reader" "java.io.Reader" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "char-writer"))
'("Writer" "java.io.Writer" "Object"))
((and (jhost? obj) (string=? (jhost-tag obj) "writer"))
'("Writer" "java.io.Writer" "Object"))
;; arrays dispatch by their JVM array-class name — extend-protocol to
;; (Class/forName "[B") for byte[] (data.json, aws-api), "[C" for char[].
((and (jolt-array? obj) (eq? (jolt-array-kind obj) 'byte)) '("[B" "Object"))
@ -606,7 +618,12 @@
"ChronoUnit" "ChronoField" "TemporalAmount" "TemporalUnit" "TemporalField"
;; ByteBuffer + JVM array classes (extend-protocol to (Class/forName "[B"))
"ByteBuffer" "java.nio.ByteBuffer"
"[B" "[C" "[I" "[J" "[D" "[Ljava.lang.Object;"))
"[B" "[C" "[I" "[J" "[D" "[Ljava.lang.Object;"
;; java.io readers/writers — extend-protocol java.io.Reader (data.csv)
"Reader" "java.io.Reader" "Writer" "java.io.Writer"
"StringReader" "java.io.StringReader" "PushbackReader" "java.io.PushbackReader"
"BufferedReader" "java.io.BufferedReader" "FilterReader" "java.io.FilterReader"
"InputStream" "java.io.InputStream" "OutputStream" "java.io.OutputStream"))
h))
(define (strip-prefix s p)
(let ((pl (string-length p)))

15
host/chez/regex.ss
View file

@ -221,6 +221,21 @@
(if last (irx-result last)
(jolt-throw (jolt-ex-info "No match found" (jolt-hash-map))))))
;; java.util.regex.Matcher methods over a matcher-t. .matches anchors a full-region
;; match and remembers it for .group; .group n returns submatch n (0 = whole) or
;; nil; .groupCount is the pattern's capturing-group count.
(define (jolt-matcher-matches m)
(let ((mm (irregex-match (matcher-t-irx m) (matcher-t-str m))))
(matcher-t-last-set! m mm)
(if mm #t #f)))
(define (jolt-matcher-group m . n)
(let ((last (matcher-t-last m)))
(if last
(let ((s (irregex-match-substring last (if (pair? n) (->idx (car n)) 0))))
(if s s jolt-nil))
(jolt-throw (jolt-ex-info "No match available" (jolt-hash-map))))))
(define (jolt-matcher-group-count m) (irregex-num-submatches (matcher-t-irx m)))
;; All non-overlapping matches, left to right. Advance past each match end (or by
;; one on a zero-width match). nil when there are no matches (Clojure: seq-able as
;; nil, so (if-let [m (re-seq ...)] ...) works).

2
host/chez/seed/image.ss
View file

@ -125,7 +125,7 @@
(guard (e (#t #f))
(def-var-with-meta! "jolt.analyzer" "with-coll-meta" (letrec ((with-coll-meta (lambda (ctx form env node) (let fnrec8904 ((ctx ctx) (form form) (env env) (node node)) (let* ((m (jolt-invoke (var-deref "jolt.host" "form-coll-meta") form))) (if (jolt-nil? m) node (let* ((_a$8907 (var-deref "jolt.ir" "invoke")) (_a$8908 (jolt-invoke (var-deref "jolt.ir" "var-ref") "clojure.core" "with-meta")) (_a$8909 (let* ((_o$8905 node) (_o$8906 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx m env))) (jolt-vector _o$8905 _o$8906)))) (jolt-invoke _a$8907 _a$8908 _a$8909)))))))) with-coll-meta) (let* ((_o$8910 (keyword #f "private")) (_o$8911 #t)) (jolt-hash-map _o$8910 _o$8911))))
(guard (e (#t #f))
(def-var! "jolt.analyzer" "analyze" (letrec ((analyze (case-lambda ((ctx form) (let fnrec8912 ((ctx ctx) (form form)) (analyze ctx form (jolt-invoke (var-deref "jolt.analyzer" "empty-env"))))) ((ctx form env) (let fnrec8913 ((ctx ctx) (form form) (env env)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-literal?") form)) (jolt-invoke (var-deref "jolt.ir" "const") form) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-symbol") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") form)) (jolt-invoke (var-deref "jolt.analyzer" "with-coll-meta") ctx form env (jolt-invoke (var-deref "jolt.ir" "vector-node") (let* ((_a$8915 (var-deref "clojure.core" "mapv")) (_a$8916 (lambda (p__99_) (let fnrec8914 ((p__99_ p__99_)) (analyze ctx p__99_ env)))) (_a$8917 (jolt-invoke (var-deref "jolt.host" "form-vec-items") form))) (jolt-invoke _a$8915 _a$8916 _a$8917)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") form)) (jolt-invoke (var-deref "jolt.analyzer" "with-coll-meta") ctx form env (jolt-invoke (var-deref "jolt.ir" "map-node") (let* ((_a$8921 (var-deref "clojure.core" "mapv")) (_a$8922 (lambda (p) (let fnrec8918 ((p p)) (let* ((_o$8919 (analyze ctx (jolt-first p) env)) (_o$8920 (analyze ctx (jolt-invoke (var-deref "clojure.core" "second") p) env))) (jolt-vector _o$8919 _o$8920))))) (_a$8923 (jolt-invoke (var-deref "jolt.host" "form-map-pairs") form))) (jolt-invoke _a$8921 _a$8922 _a$8923)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-set?") form)) (jolt-invoke (var-deref "jolt.analyzer" "with-coll-meta") ctx form env (jolt-invoke (var-deref "jolt.ir" "set-node") (let* ((_a$8925 (var-deref "clojure.core" "mapv")) (_a$8926 (lambda (p__100_) (let fnrec8924 ((p__100_ p__100_)) (analyze ctx p__100_ env)))) (_a$8927 (jolt-invoke (var-deref "jolt.host" "form-set-items") form))) (jolt-invoke _a$8925 _a$8926 _a$8927)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-list") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-regex?") form)) (let* ((_o$8928 (keyword #f "op")) (_o$8929 (keyword #f "regex")) (_o$8930 (keyword #f "source")) (_o$8931 (jolt-invoke (var-deref "jolt.host" "form-regex-source") form))) (jolt-hash-map _o$8928 _o$8929 _o$8930 _o$8931)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-inst?") form)) (let* ((_o$8932 (keyword #f "op")) (_o$8933 (keyword #f "inst")) (_o$8934 (keyword #f "source")) (_o$8935 (jolt-invoke (var-deref "jolt.host" "form-inst-source") form))) (jolt-hash-map _o$8932 _o$8933 _o$8934 _o$8935)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-uuid?") form)) (let* ((_o$8936 (keyword #f "op")) (_o$8937 (keyword #f "uuid")) (_o$8938 (keyword #f "source")) (_o$8939 (jolt-invoke (var-deref "jolt.host" "form-uuid-source") form))) (jolt-hash-map _o$8936 _o$8937 _o$8938 _o$8939)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-bigdec?") form)) (let* ((_o$8940 (keyword #f "op")) (_o$8941 (keyword #f "bigdec")) (_o$8942 (keyword #f "source")) (_o$8943 (jolt-invoke (var-deref "jolt.host" "form-bigdec-source") form))) (jolt-hash-map _o$8940 _o$8941 _o$8942 _o$8943)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-ns-value?") form)) (let* ((_o$8944 (keyword #f "op")) (_o$8945 (keyword #f "the-ns")) (_o$8946 (keyword #f "name")) (_o$8947 (jolt-invoke (var-deref "jolt.host" "form-ns-value-name") form))) (jolt-hash-map _o$8944 _o$8945 _o$8946 _o$8947)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "unsupported form") jolt-nil))))))))))))))))) analyze)))
(def-var! "jolt.analyzer" "analyze" (letrec ((analyze (case-lambda ((ctx form) (let fnrec8912 ((ctx ctx) (form form)) (analyze ctx form (jolt-invoke (var-deref "jolt.analyzer" "empty-env"))))) ((ctx form env) (let fnrec8913 ((ctx ctx) (form form) (env env)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-literal?") form)) (jolt-invoke (var-deref "jolt.ir" "const") form) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-symbol") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") form)) (jolt-invoke (var-deref "jolt.analyzer" "with-coll-meta") ctx form env (jolt-invoke (var-deref "jolt.ir" "vector-node") (let* ((_a$8915 (var-deref "clojure.core" "mapv")) (_a$8916 (lambda (p__99_) (let fnrec8914 ((p__99_ p__99_)) (analyze ctx p__99_ env)))) (_a$8917 (jolt-invoke (var-deref "jolt.host" "form-vec-items") form))) (jolt-invoke _a$8915 _a$8916 _a$8917)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") form)) (jolt-invoke (var-deref "jolt.analyzer" "with-coll-meta") ctx form env (jolt-invoke (var-deref "jolt.ir" "map-node") (let* ((_a$8921 (var-deref "clojure.core" "mapv")) (_a$8922 (lambda (p) (let fnrec8918 ((p p)) (let* ((_o$8919 (analyze ctx (jolt-first p) env)) (_o$8920 (analyze ctx (jolt-invoke (var-deref "clojure.core" "second") p) env))) (jolt-vector _o$8919 _o$8920))))) (_a$8923 (jolt-invoke (var-deref "jolt.host" "form-map-pairs") form))) (jolt-invoke _a$8921 _a$8922 _a$8923)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-set?") form)) (jolt-invoke (var-deref "jolt.analyzer" "with-coll-meta") ctx form env (jolt-invoke (var-deref "jolt.ir" "set-node") (let* ((_a$8925 (var-deref "clojure.core" "mapv")) (_a$8926 (lambda (p__100_) (let fnrec8924 ((p__100_ p__100_)) (analyze ctx p__100_ env)))) (_a$8927 (jolt-invoke (var-deref "jolt.host" "form-set-items") form))) (jolt-invoke _a$8925 _a$8926 _a$8927)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-list") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-regex?") form)) (let* ((_o$8928 (keyword #f "op")) (_o$8929 (keyword #f "regex")) (_o$8930 (keyword #f "source")) (_o$8931 (jolt-invoke (var-deref "jolt.host" "form-regex-source") form))) (jolt-hash-map _o$8928 _o$8929 _o$8930 _o$8931)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-inst?") form)) (let* ((_o$8932 (keyword #f "op")) (_o$8933 (keyword #f "inst")) (_o$8934 (keyword #f "source")) (_o$8935 (jolt-invoke (var-deref "jolt.host" "form-inst-source") form))) (jolt-hash-map _o$8932 _o$8933 _o$8934 _o$8935)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-uuid?") form)) (let* ((_o$8936 (keyword #f "op")) (_o$8937 (keyword #f "uuid")) (_o$8938 (keyword #f "source")) (_o$8939 (jolt-invoke (var-deref "jolt.host" "form-uuid-source") form))) (jolt-hash-map _o$8936 _o$8937 _o$8938 _o$8939)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-bigdec?") form)) (let* ((_o$8940 (keyword #f "op")) (_o$8941 (keyword #f "bigdec")) (_o$8942 (keyword #f "source")) (_o$8943 (jolt-invoke (var-deref "jolt.host" "form-bigdec-source") form))) (jolt-hash-map _o$8940 _o$8941 _o$8942 _o$8943)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-ns-value?") form)) (let* ((_o$8944 (keyword #f "op")) (_o$8945 (keyword #f "the-ns")) (_o$8946 (keyword #f "name")) (_o$8947 (jolt-invoke (var-deref "jolt.host" "form-ns-value-name") form))) (jolt-hash-map _o$8944 _o$8945 _o$8946 _o$8947)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-var-value?") form)) (let* ((_a$8948 (var-deref "jolt.ir" "the-var")) (_a$8949 (jolt-invoke (var-deref "jolt.host" "form-var-value-ns") form)) (_a$8950 (jolt-invoke (var-deref "jolt.host" "form-var-value-name") form))) (jolt-invoke _a$8948 _a$8949 _a$8950)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "unsupported form") jolt-nil)))))))))))))))))) analyze)))
(guard (e (#t #f))
(def-var-with-meta! "jolt.backend-scheme" "native-ops" (let* ((_o$7153 "+") (_o$7154 "+") (_o$7155 "-") (_o$7156 "-") (_o$7157 "*") (_o$7158 "*") (_o$7159 "/") (_o$7160 "/") (_o$7161 "<") (_o$7162 "<") (_o$7163 ">") (_o$7164 ">") (_o$7165 "<=") (_o$7166 "<=") (_o$7167 ">=") (_o$7168 ">=") (_o$7169 "=") (_o$7170 "jolt=") (_o$7171 "inc") (_o$7172 "jolt-inc") (_o$7173 "dec") (_o$7174 "jolt-dec") (_o$7175 "not") (_o$7176 "jolt-not") (_o$7177 "min") (_o$7178 "min") (_o$7179 "max") (_o$7180 "max") (_o$7181 "mod") (_o$7182 "modulo") (_o$7183 "rem") (_o$7184 "remainder") (_o$7185 "quot") (_o$7186 "quotient") (_o$7187 "vector") (_o$7188 "jolt-vector") (_o$7189 "hash-map") (_o$7190 "jolt-hash-map-fn") (_o$7191 "hash-set") (_o$7192 "jolt-hash-set") (_o$7193 "conj") (_o$7194 "jolt-conj") (_o$7195 "get") (_o$7196 "jolt-get") (_o$7197 "nth") (_o$7198 "jolt-nth") (_o$7199 "count") (_o$7200 "jolt-count") (_o$7201 "assoc") (_o$7202 "jolt-assoc") (_o$7203 "dissoc") (_o$7204 "jolt-dissoc") (_o$7205 "contains?") (_o$7206 "jolt-contains?") (_o$7207 "empty?") (_o$7208 "jolt-empty?") (_o$7209 "peek") (_o$7210 "jolt-peek") (_o$7211 "pop") (_o$7212 "jolt-pop") (_o$7213 "first") (_o$7214 "jolt-first") (_o$7215 "rest") (_o$7216 "jolt-rest") (_o$7217 "next") (_o$7218 "jolt-next") (_o$7219 "seq") (_o$7220 "jolt-seq") (_o$7221 "cons") (_o$7222 "jolt-cons") (_o$7223 "list") (_o$7224 "jolt-list") (_o$7225 "reverse") (_o$7226 "jolt-reverse") (_o$7227 "last") (_o$7228 "jolt-last") (_o$7229 "map") (_o$7230 "jolt-map") (_o$7231 "filter") (_o$7232 "jolt-filter") (_o$7233 "remove") (_o$7234 "jolt-remove") (_o$7235 "reduce") (_o$7236 "jolt-reduce") (_o$7237 "into") (_o$7238 "jolt-into") (_o$7239 "concat") (_o$7240 "jolt-concat") (_o$7241 "apply") (_o$7242 "jolt-apply") (_o$7243 "range") (_o$7244 "jolt-range") (_o$7245 "take") (_o$7246 "jolt-take") (_o$7247 "drop") (_o$7248 "jolt-drop") (_o$7249 "keys") (_o$7250 "jolt-keys") (_o$7251 "vals") (_o$7252 "jolt-vals") (_o$7253 "even?") (_o$7254 "jolt-even?") (_o$7255 "odd?") (_o$7256 "jolt-odd?") (_o$7257 "pos?") (_o$7258 "jolt-pos?") (_o$7259 "neg?") (_o$7260 "jolt-neg?") (_o$7261 "zero?") (_o$7262 "jolt-zero?") (_o$7263 "identity") (_o$7264 "jolt-identity") (_o$7265 "nil?") (_o$7266 "jolt-nil?") (_o$7267 "some?") (_o$7268 "jolt-some?") (_o$7269 "ex-info") (_o$7270 "jolt-ex-info") (_o$7271 "protocol-dispatch1") (_o$7272 "protocol-dispatch1") (_o$7273 "protocol-dispatch2") (_o$7274 "protocol-dispatch2") (_o$7275 "protocol-dispatch3") (_o$7276 "protocol-dispatch3")) (jolt-hash-map _o$7153 _o$7154 _o$7155 _o$7156 _o$7157 _o$7158 _o$7159 _o$7160 _o$7161 _o$7162 _o$7163 _o$7164 _o$7165 _o$7166 _o$7167 _o$7168 _o$7169 _o$7170 _o$7171 _o$7172 _o$7173 _o$7174 _o$7175 _o$7176 _o$7177 _o$7178 _o$7179 _o$7180 _o$7181 _o$7182 _o$7183 _o$7184 _o$7185 _o$7186 _o$7187 _o$7188 _o$7189 _o$7190 _o$7191 _o$7192 _o$7193 _o$7194 _o$7195 _o$7196 _o$7197 _o$7198 _o$7199 _o$7200 _o$7201 _o$7202 _o$7203 _o$7204 _o$7205 _o$7206 _o$7207 _o$7208 _o$7209 _o$7210 _o$7211 _o$7212 _o$7213 _o$7214 _o$7215 _o$7216 _o$7217 _o$7218 _o$7219 _o$7220 _o$7221 _o$7222 _o$7223 _o$7224 _o$7225 _o$7226 _o$7227 _o$7228 _o$7229 _o$7230 _o$7231 _o$7232 _o$7233 _o$7234 _o$7235 _o$7236 _o$7237 _o$7238 _o$7239 _o$7240 _o$7241 _o$7242 _o$7243 _o$7244 _o$7245 _o$7246 _o$7247 _o$7248 _o$7249 _o$7250 _o$7251 _o$7252 _o$7253 _o$7254 _o$7255 _o$7256 _o$7257 _o$7258 _o$7259 _o$7260 _o$7261 _o$7262 _o$7263 _o$7264 _o$7265 _o$7266 _o$7267 _o$7268 _o$7269 _o$7270 _o$7271 _o$7272 _o$7273 _o$7274 _o$7275 _o$7276)) (let* ((_o$7277 (keyword #f "private")) (_o$7278 #t)) (jolt-hash-map _o$7277 _o$7278))))
(guard (e (#t #f))

5
jolt-core/jolt/analyzer.clj
View file

@ -25,6 +25,7 @@
form-inst? form-inst-source form-uuid? form-uuid-source
form-bigdec? form-bigdec-source
form-ns-value? form-ns-value-name
form-var-value? form-var-value-ns form-var-value-name
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?
@ -724,4 +725,8 @@
;; a live namespace value spliced into a form (~*ns* in a macro) -> a
;; :the-ns leaf the back end reconstructs by name at the call site.
(form-ns-value? form) {:op :the-ns :name (form-ns-value-name form)}
;; a live Var value spliced into a form (a macro that resolves a var and
;; splices it, e.g. core.contracts' defcurry-from) -> a :the-var reference,
;; same as (var ns/name); the back end emits (jolt-var ns name).
(form-var-value? form) (the-var (form-var-value-ns form) (form-var-value-name form))
:else (uncompilable "unsupported form"))))

9
stdlib/clojure/test.clj
View file

@ -107,7 +107,8 @@
;; (is (thrown-with-msg? Class re body...))
(thrown-form? form "thrown-with-msg?")
(let [klass (name (second form))
(let [klass-sym (second form)
klass (name klass-sym)
re (nth form 2)
body (nthrest form 3)]
`(try
@ -115,7 +116,11 @@
(clojure.test/fail! (str "expected " '~form " to throw"))
(catch Throwable e#
(let [m# (or (clojure.core/ex-message e#) (str e#))]
(if (and (clojure.test/class-match? e# ~klass) (re-find ~re m#))
;; honor the class hierarchy (ExceptionInfo IS a RuntimeException),
;; then fall back to a simple-name match like thrown? does.
(if (and (or (clojure.core/instance? ~klass-sym e#)
(clojure.test/class-match? e# ~klass))
(re-find ~re m#))
(clojure.test/inc-pass!)
(clojure.test/fail! (str "expected throw of " ~klass " matching " ~re " but got " (clojure.core/class e#) ": " m#)))))))

10
stdlib/clojure/zip.clj
View file

@ -28,6 +28,16 @@
[root]
(zipper vector? seq (fn [node children] (with-meta (vec children) (meta node))) root))
(defn xml-zip
"Returns a zipper for xml elements (as from clojure.xml/parse), given a root
element"
[root]
(zipper (complement string?)
(comp seq :content)
(fn [node children]
(assoc node :content (and children (apply vector children))))
root))
(defn node "Returns the node at loc" [loc] (nth loc 0))
(defn branch? "Returns true if the node at loc is a branch"

12
test/chez/corpus.edn
View file

@ -3357,4 +3357,16 @@
{:suite "host-interop / instance? Object" :label "nil is not an instance of Object" :expected "false" :actual "(instance? Object nil)"}
{:suite "host-interop / instance? Object" :label "java.lang.Object too" :expected "true" :actual "(instance? java.lang.Object :k)"}
{:suite "host-interop / Compiler" :label "@Compiler/LINE is a number" :expected "true" :actual "(number? @clojure.lang.Compiler/LINE)"}
{:suite "reader / octal literals" :label "0NNN is octal" :expected "34" :actual "042"}
{:suite "reader / octal literals" :label "negative octal" :expected "-34" :actual "-042"}
{:suite "reader / octal literals" :label "octal char escape \\oNNN" :expected "true" :actual "(= (char 0377) \\o377)"}
{:suite "reader / octal literals" :label "octal string escape is one char" :expected "true" :actual "(= \"a\\000b\" (str \"a\" (char 0) \"b\"))"}
{:suite "reader / octal literals" :label "hex still decimal-distinct" :expected "[1070 255 0]" :actual "[0x42e 0xff 0]"}
{:suite "symbols / construction" :label "(symbol nil name) equals (symbol name)" :expected "true" :actual "(= (symbol nil \"foo\") (quote foo))"}
{:suite "symbols / construction" :label "(symbol nil name) has no namespace" :expected "true" :actual "(nil? (namespace (symbol nil \"x\")))"}
{:suite "host-interop / instance? hierarchy" :label "ExceptionInfo is a RuntimeException" :expected "[true true true]" :actual "[(instance? RuntimeException (ex-info \"x\" {})) (instance? Exception (ex-info \"x\" {})) (instance? Throwable (ex-info \"x\" {}))]"}
{:suite "host-interop / class hierarchy" :label "Symbol and Keyword are IFn" :expected "[true true]" :actual "[(isa? clojure.lang.Symbol clojure.lang.IFn) (isa? clojure.lang.Keyword clojure.lang.IFn)]"}
{:suite "host-interop / class hierarchy" :label "(class sym)-dispatched multimethod hits an IFn method" :expected ":ifn" :actual "(do (defmulti cm1 class) (defmethod cm1 clojure.lang.IFn [_] :ifn) (cm1 (quote sym)))"}
{:suite "host-interop / extend-protocol java.io" :label "protocol extended to Reader / String dispatches a StringReader and a String" :expected "[:reader :string]" :actual "(do (import (quote (java.io StringReader))) (defprotocol Prdr (mrd [x])) (extend-protocol Prdr java.io.Reader (mrd [_] :reader) String (mrd [_] :string)) [(mrd (StringReader. \"x\")) (mrd \"y\")])"}
{:suite "host-interop / StringWriter" :label "(str StringWriter) returns its accumulated content" :expected "\"hi!\"" :actual "(do (import (quote (java.io StringWriter))) (let [w (StringWriter.)] (.write w \"hi\") (.write w \"!\") (str w)))"}
]