Merge pull request #245 from jolt-lang/conformance/close-gaps
Close conformance gaps: regex, exceptions, printer vars, lazy-seq model, deftype/str/print
This commit is contained in:
Dmitri Sotnikov
GitHub
commit
1d55d9fa27
26 changed files with 1265 additions and 824 deletions
|
|
@ -19,6 +19,36 @@ reflection and no class hierarchy. `(class x)` returns the JVM class name for th
|
|||
scalar/collection types Clojure programs compare against (`"java.lang.Long"`,
|
||||
`"java.lang.String"`, and so on).
|
||||
|
||||
## Source layering: JVM-specific code lives in the java layer
|
||||
|
||||
Keep anything JVM-specific in `host/chez/java/`. The rest of the runtime stays
|
||||
JVM-free, and the compiler in `jolt-core/` is JVM-free by construction.
|
||||
|
||||
- `host/chez/java/` holds the JVM model: the `java.*` mirrors, the class tokens
|
||||
and class hierarchy, `(class x)`/`(type x)`/`instance?`, exception classes, the
|
||||
interop dispatch for `.method`/`Class/static`/`(Class.)`. If a value or name
|
||||
only means something because the JVM has it, it belongs here.
|
||||
- The rest of `host/chez/` is the host-neutral runtime — the value model
|
||||
(`values.ss`, `collections.ss`, `seq.ss`), reader, vars, multimethods, meta. It
|
||||
speaks jolt's own taxonomy (`:string`, `:vector`, `:jolt/inst`), never JVM class
|
||||
names.
|
||||
- `jolt-core/` (the Clojure compiler + `clojure.core` overlay) emits and reasons
|
||||
in that taxonomy only. The JVM mapping happens *after*, in the java layer.
|
||||
|
||||
The worked example is `type`. The core layer (`natives-meta.ss`) computes the
|
||||
keyword taxonomy and binds it as `__type-tag` — that's what `print-method` and the
|
||||
reader dispatch on, with no JVM in scope. The java layer (`java/host-class.ss`)
|
||||
then rebinds the public `clojure.core/type` to Clojure's `(or (:type meta) (class
|
||||
x))`, mapping `:jolt/inst` → `java.util.Date` and so on, right next to `(class
|
||||
…)`. So the compiler keeps emitting `:jolt/inst`; the java layer remaps it.
|
||||
|
||||
When you add interop behaviour, prefer registering it through the generic hooks a
|
||||
java-layer file already uses — `register-class-arm!` for `(class x)`,
|
||||
`register-instance-check-arm!` for `instance?`, `register-eq-arm!` for value
|
||||
equality — rather than threading a JVM concept back into a host-neutral file. A
|
||||
new `java.*` shim is a new file under `host/chez/java/` loaded from `rt.ss`, not a
|
||||
branch added to `collections.ss` or `seq.ss`.
|
||||
|
||||
## What's shimmed
|
||||
|
||||
This is the surface today, not the whole JVM. Methods not listed generally
|
||||
|
|
|
|||
|
|
@ -1,21 +1,21 @@
|
|||
# Appendix A — Coverage Dashboard (generated)
|
||||
|
||||
Generated 2026-06-22 by `tools/spec_coverage.py` — do not edit by hand.
|
||||
Generated 2026-06-26 by `tools/spec_coverage.py` — do not edit by hand.
|
||||
|
||||
Surface: **694** clojure.core vars (ClojureDocs export; 648 with
|
||||
community examples). jolt interns 574 of them.
|
||||
community examples). jolt interns 594 of them.
|
||||
|
||||
| Status | Count | Meaning |
|
||||
|---|---|---|
|
||||
| implemented+tested | 568 | in jolt and exercised by spec/conformance |
|
||||
| implemented-untested | 6 | in jolt, no direct test — spec entries will add them |
|
||||
| implemented+tested | 590 | in jolt and exercised by spec/conformance |
|
||||
| implemented-untested | 4 | in jolt, no direct test — spec entries will add them |
|
||||
| resolvable-not-interned | 0 | works in code but invisible to ns introspection (conformance finding) |
|
||||
| missing-portable | 6 | portable semantics, jolt lacks it — implementation gap |
|
||||
| missing-portable | 0 | portable semantics, jolt lacks it — implementation gap |
|
||||
| special-form | 16 | specified in §3, not a library var |
|
||||
| dynamic-var | 24 | classification needed: portable default vs host-dependent |
|
||||
| dynamic-var | 11 | classification needed: portable default vs host-dependent |
|
||||
| agents-taps | 16 | out of scope pending concurrency design note |
|
||||
| stm-refs | 11 | out of scope pending concurrency design note |
|
||||
| jvm-specific | 47 | catalogued, not specified |
|
||||
| jvm-specific | 46 | catalogued, not specified |
|
||||
|
||||
Classifications are initial and mechanical — reclassifying is an ordinary
|
||||
spec change. A var is *Verified* only when its §9 entry exists and carries no
|
||||
|
|
@ -27,35 +27,35 @@ UNVERIFIED field; that column will be added as entries land.
|
|||
|---|---|---|
|
||||
| `*` | implemented+tested | ✓ |
|
||||
| `*'` | implemented+tested | ✓ |
|
||||
| `*1` | missing-portable | ✓ |
|
||||
| `*2` | missing-portable | ✓ |
|
||||
| `*3` | missing-portable | ✓ |
|
||||
| `*1` | implemented+tested | ✓ |
|
||||
| `*2` | implemented+tested | ✓ |
|
||||
| `*3` | implemented+tested | ✓ |
|
||||
| `*agent*` | dynamic-var | ✓ |
|
||||
| `*allow-unresolved-vars*` | dynamic-var | ✓ |
|
||||
| `*assert*` | implemented+tested | ✓ |
|
||||
| `*clojure-version*` | implemented+tested | ✓ |
|
||||
| `*command-line-args*` | dynamic-var | ✓ |
|
||||
| `*compile-files*` | dynamic-var | ✓ |
|
||||
| `*command-line-args*` | implemented-untested | ✓ |
|
||||
| `*compile-files*` | implemented+tested | ✓ |
|
||||
| `*compile-path*` | dynamic-var | ✓ |
|
||||
| `*compiler-options*` | dynamic-var | ✓ |
|
||||
| `*data-readers*` | dynamic-var | ✓ |
|
||||
| `*default-data-reader-fn*` | dynamic-var | ✓ |
|
||||
| `*e` | missing-portable | ✓ |
|
||||
| `*err*` | implemented-untested | ✓ |
|
||||
| `*file*` | dynamic-var | ✓ |
|
||||
| `*flush-on-newline*` | dynamic-var | |
|
||||
| `*data-readers*` | implemented+tested | ✓ |
|
||||
| `*default-data-reader-fn*` | implemented+tested | ✓ |
|
||||
| `*e` | implemented+tested | ✓ |
|
||||
| `*err*` | implemented+tested | ✓ |
|
||||
| `*file*` | implemented-untested | ✓ |
|
||||
| `*flush-on-newline*` | implemented+tested | |
|
||||
| `*fn-loader*` | dynamic-var | |
|
||||
| `*in*` | implemented+tested | |
|
||||
| `*math-context*` | dynamic-var | |
|
||||
| `*math-context*` | implemented+tested | |
|
||||
| `*ns*` | implemented+tested | ✓ |
|
||||
| `*out*` | implemented-untested | ✓ |
|
||||
| `*print-dup*` | dynamic-var | ✓ |
|
||||
| `*print-length*` | dynamic-var | ✓ |
|
||||
| `*print-level*` | dynamic-var | ✓ |
|
||||
| `*print-meta*` | dynamic-var | ✓ |
|
||||
| `*print-namespace-maps*` | dynamic-var | ✓ |
|
||||
| `*out*` | implemented+tested | ✓ |
|
||||
| `*print-dup*` | implemented+tested | ✓ |
|
||||
| `*print-length*` | implemented+tested | ✓ |
|
||||
| `*print-level*` | implemented+tested | ✓ |
|
||||
| `*print-meta*` | implemented+tested | ✓ |
|
||||
| `*print-namespace-maps*` | implemented-untested | ✓ |
|
||||
| `*print-readably*` | implemented+tested | ✓ |
|
||||
| `*read-eval*` | dynamic-var | ✓ |
|
||||
| `*read-eval*` | implemented+tested | ✓ |
|
||||
| `*reader-resolver*` | dynamic-var | |
|
||||
| `*repl*` | dynamic-var | |
|
||||
| `*source-path*` | dynamic-var | ✓ |
|
||||
|
|
@ -63,7 +63,7 @@ UNVERIFIED field; that column will be added as entries land.
|
|||
| `*unchecked-math*` | implemented+tested | ✓ |
|
||||
| `*use-context-classloader*` | dynamic-var | ✓ |
|
||||
| `*verbose-defrecords*` | dynamic-var | |
|
||||
| `*warn-on-reflection*` | implemented-untested | ✓ |
|
||||
| `*warn-on-reflection*` | implemented+tested | ✓ |
|
||||
| `+` | implemented+tested | ✓ |
|
||||
| `+'` | implemented+tested | ✓ |
|
||||
| `-` | implemented+tested | ✓ |
|
||||
|
|
@ -131,7 +131,7 @@ UNVERIFIED field; that column will be added as entries land.
|
|||
| `assoc-in` | implemented+tested | ✓ |
|
||||
| `associative?` | implemented+tested | ✓ |
|
||||
| `atom` | implemented+tested | ✓ |
|
||||
| `await` | implemented-untested | ✓ |
|
||||
| `await` | implemented+tested | ✓ |
|
||||
| `await-for` | agents-taps | ✓ |
|
||||
| `await1` | agents-taps | |
|
||||
| `bases` | jvm-specific | ✓ |
|
||||
|
|
@ -218,7 +218,7 @@ UNVERIFIED field; that column will be added as entries land.
|
|||
| `declare` | implemented+tested | ✓ |
|
||||
| `dedupe` | implemented+tested | ✓ |
|
||||
| `def` | special-form | ✓ |
|
||||
| `default-data-readers` | jvm-specific | ✓ |
|
||||
| `default-data-readers` | implemented+tested | ✓ |
|
||||
| `definline` | jvm-specific | |
|
||||
| `definterface` | implemented+tested | ✓ |
|
||||
| `defmacro` | special-form | ✓ |
|
||||
|
|
@ -375,7 +375,7 @@ UNVERIFIED field; that column will be added as entries land.
|
|||
| `lazy-cat` | implemented+tested | ✓ |
|
||||
| `lazy-seq` | implemented+tested | ✓ |
|
||||
| `let` | implemented+tested | ✓ |
|
||||
| `letfn` | missing-portable | ✓ |
|
||||
| `letfn` | implemented+tested | ✓ |
|
||||
| `line-seq` | implemented+tested | ✓ |
|
||||
| `list` | implemented+tested | ✓ |
|
||||
| `list*` | implemented+tested | ✓ |
|
||||
|
|
@ -512,7 +512,7 @@ UNVERIFIED field; that column will be added as entries land.
|
|||
| `rational?` | implemented+tested | ✓ |
|
||||
| `rationalize` | implemented+tested | ✓ |
|
||||
| `re-find` | implemented+tested | ✓ |
|
||||
| `re-groups` | missing-portable | ✓ |
|
||||
| `re-groups` | implemented+tested | ✓ |
|
||||
| `re-matcher` | implemented+tested | ✓ |
|
||||
| `re-matches` | implemented+tested | ✓ |
|
||||
| `re-pattern` | implemented+tested | ✓ |
|
||||
|
|
@ -558,7 +558,7 @@ UNVERIFIED field; that column will be added as entries land.
|
|||
| `reset-vals!` | implemented+tested | ✓ |
|
||||
| `resolve` | implemented+tested | ✓ |
|
||||
| `rest` | implemented+tested | ✓ |
|
||||
| `restart-agent` | implemented-untested | ✓ |
|
||||
| `restart-agent` | implemented+tested | ✓ |
|
||||
| `resultset-seq` | jvm-specific | ✓ |
|
||||
| `reverse` | implemented+tested | ✓ |
|
||||
| `reversible?` | implemented+tested | ✓ |
|
||||
|
|
|
|||
|
|
@ -33,11 +33,26 @@
|
|||
((null? rs) (jolt-pr-str v))
|
||||
(((caar rs) v) ((cdar rs) v))
|
||||
(else (loop (cdr rs))))))))
|
||||
;; print/println render non-readably: a nested string is raw. jolt-str-render-one
|
||||
;; is exactly that (collections fall through to jolt-pr-str). The print family
|
||||
;; uses this seam, NOT the str fn — which renders readably (below). A top-level nil
|
||||
;; prints "nil" (str renders it ""), so the seam special-cases it.
|
||||
(define (jolt-print-one v) (if (jolt-nil? v) "nil" (jolt-str-render-one v)))
|
||||
(def-var! "clojure.core" "__print1" jolt-print-one)
|
||||
|
||||
;; str: a top-level string/scalar renders as jolt-str-render-one (raw string,
|
||||
;; "Infinity"…), but a COLLECTION renders as its readable form — nested strings
|
||||
;; are QUOTED ((str ["x"]) => "[\"x\"]"), matching the JVM (a collection's
|
||||
;; toString is readable). jolt-pr-readable resolves at call time.
|
||||
(define (jolt-str-one v)
|
||||
(if (or (pvec? v) (pmap? v) (pset? v) (cseq? v) (empty-list-t? v) (jolt-lazyseq? v))
|
||||
(jolt-pr-readable v)
|
||||
(jolt-str-render-one v)))
|
||||
(define (jolt-str . xs)
|
||||
(let loop ((xs xs) (acc '()))
|
||||
(if (null? xs)
|
||||
(apply string-append (reverse acc))
|
||||
(loop (cdr xs) (cons (jolt-str-render-one (car xs)) acc)))))
|
||||
(loop (cdr xs) (cons (jolt-str-one (car xs)) acc)))))
|
||||
|
||||
;; jolt indices are flonums; substring etc. need exact ints.
|
||||
(define (jolt->idx n) (exact (truncate n)))
|
||||
|
|
|
|||
|
|
@ -28,3 +28,43 @@
|
|||
|
||||
;; *print-meta* — when true, pr prints metadata with a ^ prefix; default false.
|
||||
(def-var! "clojure.core" "*print-meta*" #f)
|
||||
|
||||
;; *print-length* / *print-level* — collection print limits, honored by both
|
||||
;; printers (rt.ss jolt-pr-str + printing.ss jolt-pr-readable). nil = unlimited
|
||||
;; (the default); a number truncates elements / collapses depth to "#".
|
||||
;; *print-length* limits a lazy/infinite seq before realizing it.
|
||||
(def-var! "clojure.core" "*print-length*" jolt-nil)
|
||||
(def-var! "clojure.core" "*print-level*" jolt-nil)
|
||||
;; *default-data-reader-fn* — a (fn [tag value]) the reader consults for an
|
||||
;; unregistered #tag before raising; nil = no default handler.
|
||||
(def-var! "clojure.core" "*default-data-reader-fn*" jolt-nil)
|
||||
|
||||
;; Portable clojure.core dynamic vars whose DEFAULT already matches jolt's
|
||||
;; behaviour, so exposing them is sound (resolve/binding work, reads return the
|
||||
;; right value) — not a silent divergence.
|
||||
;;
|
||||
;; *read-eval* — gates #=() read-eval. jolt's reader has no #=, so it reads true
|
||||
;; (no eval-on-read happens regardless); a lib can (binding [*read-eval* false] …).
|
||||
(def-var! "clojure.core" "*read-eval*" #t)
|
||||
;; *print-dup* — gates print-dup (a multimethod that exists); default false.
|
||||
(def-var! "clojure.core" "*print-dup*" #f)
|
||||
;; *print-namespace-maps* — jolt never prints the #:ns{…} map shorthand, so the
|
||||
;; var reads false (accurate); settable for code that toggles it.
|
||||
(def-var! "clojure.core" "*print-namespace-maps*" #f)
|
||||
;; *flush-on-newline* — jolt flushes line output; default true.
|
||||
(def-var! "clojure.core" "*flush-on-newline*" #t)
|
||||
;; *compile-files* — jolt has no separate compile phase that emits .class files.
|
||||
(def-var! "clojure.core" "*compile-files*" #f)
|
||||
;; *math-context* — BigDecimal rounding context; nil = unlimited, jolt's default.
|
||||
(def-var! "clojure.core" "*math-context*" jolt-nil)
|
||||
;; *command-line-args* — the args after the script/-main; nil outside a -m run.
|
||||
(def-var! "clojure.core" "*command-line-args*" jolt-nil)
|
||||
;; *file* — the source file being loaded; "NO_SOURCE_PATH" when none, like the JVM.
|
||||
(def-var! "clojure.core" "*file*" "NO_SOURCE_PATH")
|
||||
|
||||
;; REPL result/exception history. Bound by the REPL after each evaluation; nil
|
||||
;; outside a REPL, which is what reading them returns here.
|
||||
(def-var! "clojure.core" "*1" jolt-nil)
|
||||
(def-var! "clojure.core" "*2" jolt-nil)
|
||||
(def-var! "clojure.core" "*3" jolt-nil)
|
||||
(def-var! "clojure.core" "*e" jolt-nil)
|
||||
|
|
|
|||
|
|
@ -113,7 +113,7 @@
|
|||
(define %h-set? jolt-set?)
|
||||
(set! jolt-set? (lambda (x) (or (htable-sorted-set? x) (%h-set? x))))
|
||||
(def-var! "clojure.core" "set?" jolt-set?)
|
||||
(def-var! "clojure.core" "coll?" (lambda (x) (or (htable-sorted? x) (jrec? x) (jolt-coll-pred? x))))
|
||||
(def-var! "clojure.core" "coll?" (lambda (x) (or (htable-sorted? x) (jrec-collection? x) (jolt-coll-pred? x))))
|
||||
|
||||
;; --- equality / hash ---------------------------------------------------------
|
||||
;; A sorted coll canonicalizes like its unordered counterpart:
|
||||
|
|
|
|||
|
|
@ -54,6 +54,14 @@
|
|||
;; the class NAME of x (string), or nil for nil. (class x) wraps it in a Class
|
||||
;; value (make-class-obj, host-static-classes.ss) so it renders like a JVM Class
|
||||
;; while staying = its name string.
|
||||
;; a raw Chez condition Clojure raises a specific class for (records-interop.ss
|
||||
;; chez-condition-exc-class) reports that JVM class, so (class e) and a
|
||||
;; (thrown? ArityException …) test match — not the opaque :object fallback.
|
||||
(register-class-arm!
|
||||
(lambda (x) (and (chez-condition-exc-class x) #t))
|
||||
(lambda (x) (if (string=? (chez-condition-exc-class x) "ArityException")
|
||||
"clojure.lang.ArityException"
|
||||
"java.lang.IllegalArgumentException")))
|
||||
(define (jolt-class-name x)
|
||||
(let loop ((as jolt-class-arms))
|
||||
(cond ((null? as) (jolt-class-base x))
|
||||
|
|
@ -94,6 +102,7 @@
|
|||
("Charset" . "java.nio.charset.Charset") ("Base64" . "java.util.Base64")
|
||||
("Exception" . "java.lang.Exception")
|
||||
("IllegalArgumentException" . "java.lang.IllegalArgumentException")
|
||||
("ArityException" . "clojure.lang.ArityException")
|
||||
("IllegalStateException" . "java.lang.IllegalStateException")
|
||||
("RuntimeException" . "java.lang.RuntimeException")
|
||||
("UnsupportedOperationException" . "java.lang.UnsupportedOperationException")
|
||||
|
|
@ -165,7 +174,7 @@
|
|||
"java.lang.IndexOutOfBoundsException" "java.io.FileNotFoundException"
|
||||
"java.io.UnsupportedEncodingException"
|
||||
;; clojure.lang.ExceptionInfo / IExceptionInfo compared against (class e)
|
||||
"clojure.lang.ExceptionInfo" "clojure.lang.IExceptionInfo"
|
||||
"clojure.lang.ExceptionInfo" "clojure.lang.IExceptionInfo" "clojure.lang.ArityException"
|
||||
"java.util.regex.Pattern" "java.net.URI" "java.util.UUID"
|
||||
"clojure.lang.PersistentQueue"
|
||||
"clojure.lang.Keyword" "clojure.lang.Symbol" "clojure.lang.Ratio" "clojure.lang.Atom"))
|
||||
|
|
|
|||
|
|
@ -605,6 +605,14 @@
|
|||
(cons "hashCode" (lambda (u) (string-hash (uri-field u 'string))))
|
||||
(cons "equals" (lambda (u o) (and (jhost? o) (string=? (jhost-tag o) "uri")
|
||||
(string=? (uri-field u 'string) (uri-field o 'string)))))))
|
||||
;; (= u1 u2) is value equality by string form (the .equals method above only
|
||||
;; serves explicit (.equals …)); hash matches so a URI works as a map key / set
|
||||
;; member (ring/hiccup compare (URI. "/") values).
|
||||
(define (uri-jhost? x) (and (jhost? x) (string=? (jhost-tag x) "uri")))
|
||||
(register-eq-arm! (lambda (a b) (or (uri-jhost? a) (uri-jhost? b)))
|
||||
(lambda (a b) (and (uri-jhost? a) (uri-jhost? b)
|
||||
(string=? (uri-field a 'string) (uri-field b 'string)))))
|
||||
(register-hash-arm! uri-jhost? (lambda (x) (string-hash (uri-field x 'string))))
|
||||
;; str / pr-str of a uri -> its string form.
|
||||
(register-str-render! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "uri")))
|
||||
(lambda (x) (uri-field x 'string)))
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@
|
|||
'(("ExceptionInfo" . "RuntimeException")
|
||||
("RuntimeException" . "Exception")
|
||||
("IllegalArgumentException" . "RuntimeException")
|
||||
("ArityException" . "IllegalArgumentException")
|
||||
("NumberFormatException" . "IllegalArgumentException")
|
||||
("IllegalStateException" . "RuntimeException")
|
||||
("UnsupportedOperationException" . "RuntimeException")
|
||||
|
|
@ -51,6 +52,24 @@
|
|||
((and (string=? c "ExceptionInfo") (string=? wanted "IExceptionInfo")) #t)
|
||||
(else (let ((p (assoc c exception-parent))) (loop (and p (cdr p))))))))
|
||||
|
||||
;; A raw Chez condition (an arity or non-seqable error Chez itself raised, not a
|
||||
;; jolt ex-info) carries no jolt exception class. Map the ones Clojure raises a
|
||||
;; specific class for, by message, so (class e) and (instance? C e) match the JVM.
|
||||
;; Returns a simple class name or #f.
|
||||
(define (ri-substring? needle hay)
|
||||
(let ((nl (string-length needle)) (hl (string-length hay)))
|
||||
(let loop ((i 0))
|
||||
(cond ((> (+ i nl) hl) #f)
|
||||
((string=? needle (substring hay i (+ i nl))) #t)
|
||||
(else (loop (+ i 1)))))))
|
||||
(define (chez-condition-exc-class v)
|
||||
(and (condition? v) (message-condition? v)
|
||||
(let ((m (condition-message v)))
|
||||
(and (string? m)
|
||||
(cond ((ri-substring? "incorrect number of arguments" m) "ArityException")
|
||||
((ri-substring? "not seqable" m) "IllegalArgumentException")
|
||||
(else #f))))))
|
||||
|
||||
;; instance-check: (type-sym val) — type/protocol membership. Host shims loaded
|
||||
;; later (io, inst-time, natives-array, natives-queue, host-static-classes)
|
||||
;; register an arm with register-instance-check-arm! instead of set!-wrapping
|
||||
|
|
@ -61,6 +80,13 @@
|
|||
(define (register-instance-check-arm! f) ; f: (type-sym val) -> #t | #f | 'pass
|
||||
(set! instance-check-registry (cons f instance-check-registry)))
|
||||
|
||||
;; (instance? C raw-condition): match when C is the condition's mapped class or a
|
||||
;; supertype of it (ArityException is also an IllegalArgumentException, etc.).
|
||||
(register-instance-check-arm!
|
||||
(lambda (type-sym val)
|
||||
(let ((k (chez-condition-exc-class val)))
|
||||
(if k (if (exception-isa? k (last-dot (symbol-t-name type-sym))) #t #f) 'pass))))
|
||||
|
||||
(define (instance-check-base type-sym val)
|
||||
(let ((tname (symbol-t-name type-sym)))
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -65,10 +65,15 @@
|
|||
(set! jolt-nth (case-lambda
|
||||
((coll i) (if (jolt-lazyseq? coll) (%ls-nth (jolt-seq coll) i) (%ls-nth coll i)))
|
||||
((coll i d) (if (jolt-lazyseq? coll) (%ls-nth (jolt-seq coll) i d) (%ls-nth coll i d)))))
|
||||
;; a lazy seq prints as its realized seq — force, then re-dispatch through the printer.
|
||||
(register-pr-str-arm! jolt-lazyseq? (lambda (x) (jolt-pr-str (jolt-seq x))))
|
||||
(register-pr-readable-arm! jolt-lazyseq? (lambda (x) (jolt-pr-readable (jolt-seq x))))
|
||||
(register-str-render! jolt-lazyseq? (lambda (x) (jolt-str-render-one (jolt-seq x))))
|
||||
;; a lazy seq prints as its realized seq — force, then re-dispatch through the
|
||||
;; printer. An empty realized lazy seq is still a sequence, printing "()" (like a
|
||||
;; JVM LazySeq), not "nil" — so (lazy-seq nil) and (rest '(1)) render "()".
|
||||
(register-pr-str-arm! jolt-lazyseq?
|
||||
(lambda (x) (let ((s (jolt-seq x))) (if (jolt-nil? s) "()" (jolt-pr-str s)))))
|
||||
(register-pr-readable-arm! jolt-lazyseq?
|
||||
(lambda (x) (let ((s (jolt-seq x))) (if (jolt-nil? s) "()" (jolt-pr-readable s)))))
|
||||
(register-str-render! jolt-lazyseq?
|
||||
(lambda (x) (let ((s (jolt-seq x))) (if (jolt-nil? s) "()" (jolt-str-render-one s)))))
|
||||
|
||||
;; seq? — a lazy seq IS a seq (predicates.ss's jolt-seq? predates the lazyseq
|
||||
;; record). Unlike the native-op dispatchers above (called via a direct top-level
|
||||
|
|
|
|||
|
|
@ -16,20 +16,15 @@
|
|||
(seq->list (jolt-seq names))))
|
||||
jolt-nil)
|
||||
|
||||
;; --- reader-conditional / re-matcher: tagged maps (reader-conditional? + the
|
||||
;; matcher consumers are overlay tagged-value predicates that read :jolt/type).
|
||||
;; --- reader-conditional: a tagged map (reader-conditional? is an overlay
|
||||
;; tagged-value predicate that reads :jolt/type). re-matcher / re-find / re-groups
|
||||
;; are the stateful matcher API in regex.ss.
|
||||
(define nr-kw-type (keyword "jolt" "type"))
|
||||
(define nr-kw-rc (keyword "jolt" "reader-conditional"))
|
||||
(define nr-kw-form (keyword #f "form"))
|
||||
(define nr-kw-spl (keyword #f "splicing?"))
|
||||
(define nr-kw-mat (keyword "jolt" "matcher"))
|
||||
(define nr-kw-re (keyword #f "re"))
|
||||
(define nr-kw-s (keyword #f "s"))
|
||||
(define nr-kw-pos (keyword #f "pos"))
|
||||
(define (nr-reader-conditional form splicing?)
|
||||
(jolt-hash-map nr-kw-type nr-kw-rc nr-kw-form form nr-kw-spl splicing?))
|
||||
(define (nr-re-matcher re s)
|
||||
(jolt-hash-map nr-kw-type nr-kw-mat nr-kw-re re nr-kw-s s nr-kw-pos 0.0))
|
||||
|
||||
;; --- macroexpand-1 / macroexpand: expand a (quoted) call form via the runtime
|
||||
;; macro table (host-contract hc-macro?/hc-expand-1; forward-referenced, resolved
|
||||
|
|
@ -47,6 +42,13 @@
|
|||
(def-var! "clojure.core" "__reader-features" nr-reader-features-get)
|
||||
(def-var! "clojure.core" "__reader-features-set!" nr-reader-features-set!)
|
||||
(def-var! "clojure.core" "reader-conditional" nr-reader-conditional)
|
||||
(def-var! "clojure.core" "re-matcher" nr-re-matcher)
|
||||
(def-var! "clojure.core" "macroexpand-1" nr-macroexpand-1)
|
||||
|
||||
;; letfn is a special form (the analyzer lowers it to letrec*, checked before any
|
||||
;; macro), but on the JVM it is also a clojure.core macro that (resolve 'letfn)
|
||||
;; finds — like let / loop / fn here. Intern a var so resolution matches; the value
|
||||
;; is never invoked (the analyzer handles every (letfn …) form), and it is NOT
|
||||
;; marked a macro, so macroexpand leaves a letfn form alone (it is special).
|
||||
(def-var! "clojure.core" "letfn"
|
||||
(lambda args (jolt-throw (jolt-ex-info "letfn is a special form" (jolt-hash-map)))))
|
||||
(def-var! "clojure.core" "macroexpand" nr-macroexpand)
|
||||
|
|
|
|||
|
|
@ -17,13 +17,16 @@
|
|||
;; call routes through jolt-invoke. A `reduced` step stops the fold — reduce-seq
|
||||
;; (seq.ss) already short-circuits on a jolt-reduced.
|
||||
;; ============================================================================
|
||||
;; The map transducer's step fn supports multiple inputs ([result input & inputs]),
|
||||
;; so a multi-collection sequence/transduce — or medley's sequence-padded, which
|
||||
;; calls (f acc i1 i2 …) — applies f across all of them: (rf result (apply f inputs)).
|
||||
(define (td-map f)
|
||||
(lambda (rf)
|
||||
(lambda a
|
||||
(case (length a)
|
||||
((0) (jolt-invoke rf))
|
||||
((1) (jolt-invoke rf (car a)))
|
||||
(else (jolt-invoke rf (car a) (jolt-invoke f (cadr a))))))))
|
||||
(else (jolt-invoke rf (car a) (apply jolt-invoke f (cdr a))))))))
|
||||
(define (td-filter pred)
|
||||
(lambda (rf)
|
||||
(lambda a
|
||||
|
|
|
|||
|
|
@ -95,10 +95,10 @@
|
|||
;; chunked-seq? is true for a vector's seq (a real chunked-seq); the overlay's
|
||||
;; always-false stub loaded over the host fn, so re-assert it.
|
||||
(def-var! "clojure.core" "chunked-seq?" na-chunked-seq?)
|
||||
;; record? is a host type check (jrec?), not the overlay's (some? (get x
|
||||
;; :jolt/deftype)) — the get-trick invokes a sorted-map's comparator on
|
||||
;; :jolt/deftype and throws. Matches the JVM (instance? IRecord).
|
||||
(def-var! "clojure.core" "record?" (lambda (x) (jrec? x)))
|
||||
;; record? is a host type check — true only for a defrecord, not a bare deftype
|
||||
;; (jrec-record?), matching the JVM (instance? IRecord). The overlay's
|
||||
;; (some? (get x :jolt/deftype)) get-trick would invoke a sorted-map comparator.
|
||||
(def-var! "clojure.core" "record?" (lambda (x) (jrec-record? x)))
|
||||
|
||||
;; read / read+string over a HOST reader jhost (java.io StringReader/PushbackReader):
|
||||
;; the overlay's IReader protocol only covers the reify map-reader, so a (read
|
||||
|
|
|
|||
|
|
@ -47,25 +47,22 @@
|
|||
((jolt-transient? x)
|
||||
(case (jolt-transient-kind x)
|
||||
((vec) "#<transient vector>") ((set) "#<transient set>") (else "#<transient map>")))
|
||||
((pvec? x)
|
||||
(let ((acc '()))
|
||||
(let loop ((i (fx- (pvec-count x) 1)))
|
||||
(when (fx>=? i 0)
|
||||
(set! acc (cons (jolt-pr-readable (pvec-nth-d x i jolt-nil)) acc))
|
||||
(loop (fx- i 1))))
|
||||
(string-append "[" (jolt-str-join acc) "]")))
|
||||
((pset? x)
|
||||
(string-append "#{" (jolt-str-join (pset-fold x (lambda (e a) (cons (jolt-pr-readable e) a)) '())) "}"))
|
||||
((pmap? x)
|
||||
(string-append "{" (jolt-str-join
|
||||
(pmap-fold x (lambda (k v a)
|
||||
(cons (string-append (jolt-pr-readable k) " " (jolt-pr-readable v)) a)) '())) "}"))
|
||||
((empty-list-t? x) "()")
|
||||
((cseq? x)
|
||||
(string-append "(" (jolt-str-join
|
||||
(let loop ((s x) (acc '()))
|
||||
(if (jolt-nil? s) (reverse acc)
|
||||
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-readable (seq-first s)) acc))))) ")"))
|
||||
((pvec? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "[" (jolt-str-join (jolt-limited-vec-strs x jolt-pr-readable)) "]"))))
|
||||
((pset? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "#{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pset-fold x (lambda (e a) (cons (jolt-pr-readable e) a)) '()))) "}"))))
|
||||
((pmap? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pmap-fold x (lambda (k v a)
|
||||
(cons (string-append (jolt-pr-readable k) " " (jolt-pr-readable v)) a)) '()))) "}"))))
|
||||
((empty-list-t? x) (if (jolt-print-hash?) "#" "()"))
|
||||
((cseq? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "(" (jolt-str-join (jolt-limited-seq-strs x jolt-pr-readable)) ")"))))
|
||||
(else (jolt-pr-str x))))
|
||||
(define (jolt-pr-readable-dispatch x)
|
||||
(let loop ((as jolt-pr-readable-arms))
|
||||
|
|
|
|||
|
|
@ -631,16 +631,38 @@
|
|||
(guard (e (#t #f))
|
||||
(let ((fn (var-deref (symbol-t-ns v) (symbol-t-name v))))
|
||||
(and (procedure? fn) fn)))))))))
|
||||
;; the bare tag SYMBOL for a :#name / :#ns/name reader keyword (strip the leading
|
||||
;; #, split a qualified tag on /). *default-data-reader-fn* receives it.
|
||||
(define (rdr-tag->symbol tag)
|
||||
(let* ((nm (keyword-t-name tag))
|
||||
(bare (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\#))
|
||||
(substring nm 1 (string-length nm)) nm)))
|
||||
(let loop ((i 0))
|
||||
(cond ((>= i (string-length bare)) (jolt-symbol #f bare))
|
||||
((char=? (string-ref bare i) #\/)
|
||||
(jolt-symbol (substring bare 0 i) (substring bare (+ i 1) (string-length bare))))
|
||||
(else (loop (+ i 1)))))))
|
||||
;; *default-data-reader-fn* — a (fn [tag value]) consulted for an unregistered
|
||||
;; tag, or #f when unset/nil. Honors a `binding` (var-deref reads the stack).
|
||||
(define (rdr-default-data-reader-fn)
|
||||
(guard (e (#t #f))
|
||||
(let ((v (var-deref "clojure.core" "*default-data-reader-fn*")))
|
||||
(and (not (jolt-nil? v)) (procedure? v) v))))
|
||||
|
||||
;; read-string / read data seam: construct the value for a #tag literal. #inst,
|
||||
;; #uuid and #"regex" are built in; any other tag is applied from *data-readers*.
|
||||
;; An unregistered tag stays a tagged FORM (lenient — clojure.edn raises instead).
|
||||
;; #uuid and #"regex" are built in; any other tag is applied from *data-readers*,
|
||||
;; then *default-data-reader-fn*. An unregistered tag with no default handler stays
|
||||
;; a tagged FORM (lenient — clojure.edn raises instead).
|
||||
(define (rdr-construct-tag tag inner)
|
||||
(cond
|
||||
((eq? tag (keyword #f "#inst")) (jolt-inst-from-string inner))
|
||||
((eq? tag (keyword #f "#uuid")) (jolt-uuid-from-string inner))
|
||||
((eq? tag (keyword #f "regex")) (jolt-re-pattern inner))
|
||||
(else (let ((fn (rdr-data-reader-fn tag)))
|
||||
(if fn (jolt-invoke fn inner) (rdr-make-tagged tag inner))))))
|
||||
(if fn (jolt-invoke fn inner)
|
||||
(let ((dfn (rdr-default-data-reader-fn)))
|
||||
(if dfn (jolt-invoke dfn (rdr-tag->symbol tag) inner)
|
||||
(rdr-make-tagged tag inner))))))))
|
||||
|
||||
(define (rdr-form->data x)
|
||||
(cond
|
||||
|
|
@ -695,13 +717,16 @@
|
|||
(cond
|
||||
((eq? tag (keyword #f "#uuid")) (jolt-uuid-from-string form))
|
||||
((eq? tag (keyword #f "#inst")) (jolt-inst-from-string form))
|
||||
;; No registered reader: throw a clean, catchable ex-info naming the tag, like
|
||||
;; the JVM's "No reader function for tag foobar" (empty-pmap is a VALUE — the
|
||||
;; old (empty-pmap) applied it as a procedure and crashed the Chez VM).
|
||||
(else (let* ((nm (keyword-t-name tag))
|
||||
(bare (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\#))
|
||||
(substring nm 1 (string-length nm)) nm)))
|
||||
(jolt-throw (jolt-ex-info (string-append "No reader function for tag " bare) empty-pmap))))))
|
||||
;; No registered reader: consult *default-data-reader-fn*, else throw a clean,
|
||||
;; catchable ex-info naming the tag, like the JVM's "No reader function for tag
|
||||
;; foobar" (empty-pmap is a VALUE — the old (empty-pmap) applied it as a
|
||||
;; procedure and crashed the Chez VM).
|
||||
(else (let ((dfn (rdr-default-data-reader-fn)))
|
||||
(if dfn (jolt-invoke dfn (rdr-tag->symbol tag) form)
|
||||
(let* ((nm (keyword-t-name tag))
|
||||
(bare (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\#))
|
||||
(substring nm 1 (string-length nm)) nm)))
|
||||
(jolt-throw (jolt-ex-info (string-append "No reader function for tag " bare) empty-pmap))))))))
|
||||
|
||||
(def-var! "clojure.core" "read-string" jolt-read-string)
|
||||
(def-var! "clojure.core" "__parse-next" jolt-parse-next)
|
||||
|
|
|
|||
|
|
@ -31,6 +31,33 @@
|
|||
;; map (jolt-nil unless non-field keys have been assoc'd on).
|
||||
(define-record-type (jrec make-jrec jrec?) (fields desc vals ext) (nongenerative chez-jrec-v2))
|
||||
(define (jrec-tag r) (jrdesc-tag (jrec-desc r)))
|
||||
|
||||
;; defrecord vs deftype: a defrecord IS a map (map?/seq/keys/assoc over its
|
||||
;; fields); a bare deftype is an opaque object with only its declared interfaces,
|
||||
;; never a map (Clojure semantics). defrecord registers its type tag here; the
|
||||
;; default jrec-as-map behaviour (map?/record?/field-seq) is gated on it, while
|
||||
;; method dispatch (a deftype implementing ISeq/Counted/…) stays open to any jrec.
|
||||
(define chez-record-type-tbl (make-hashtable string-hash string=?))
|
||||
(define (jrec-record? x) (and (jrec? x) (hashtable-ref chez-record-type-tbl (jrec-tag x) #f) #t))
|
||||
;; every deftype/defrecord tag, and a simple-name -> tag index. An extend-protocol
|
||||
;; in a DIFFERENT ns names the type bare (it is :import-ed), so register-method
|
||||
;; resolves "Raw" to its real tag "a.util.Raw" here instead of prepending the
|
||||
;; calling ns. The local ns is preferred, so a same-named local type still wins.
|
||||
(define chez-deftype-tag-set (make-hashtable string-hash string=?))
|
||||
(define chez-simple-name-tag (make-hashtable string-hash string=?))
|
||||
;; a jrec that is coll? — a record, or a deftype implementing a collection
|
||||
;; interface (its seq/count/nth/valAt/cons method is registered). find-method-any-
|
||||
;; protocol is defined later; resolved at call time. An opaque deftype is not coll?.
|
||||
(define (jrec-collection? x)
|
||||
(and (jrec? x)
|
||||
(or (jrec-record? x)
|
||||
(let ((tag (jrec-tag x)))
|
||||
(or (find-method-any-protocol tag "seq")
|
||||
(find-method-any-protocol tag "count")
|
||||
(find-method-any-protocol tag "nth")
|
||||
(find-method-any-protocol tag "valAt")
|
||||
(find-method-any-protocol tag "cons"))))
|
||||
#t))
|
||||
(define jolt-deftype-kw (keyword "jolt" "deftype"))
|
||||
;; unique present-vs-absent sentinel for extension-map lookups (so a present nil
|
||||
;; in the extension map is distinguished from a genuine miss).
|
||||
|
|
@ -338,7 +365,9 @@
|
|||
(define %r-jolt-seq jolt-seq)
|
||||
(set! jolt-seq (lambda (x)
|
||||
(cond ((jrec-cl x "seq") => (lambda (m) (jolt-seq (jolt-invoke m x))))
|
||||
((jrec? x) (list->cseq (jrec-entry-list x)))
|
||||
;; a record seqs its fields; a bare deftype is not seqable (falls through
|
||||
;; to %r-jolt-seq, which errors like the JVM).
|
||||
((jrec-record? x) (list->cseq (jrec-entry-list x)))
|
||||
(else (%r-jolt-seq x)))))
|
||||
(define %r-jolt-conj1 jolt-conj1)
|
||||
(set! jolt-conj1 (lambda (coll x)
|
||||
|
|
@ -350,7 +379,8 @@
|
|||
;; empty? over a jrec: a map-like deftype is empty iff its entry seq is (data
|
||||
;; .priority-map's peek calls (.isEmpty this) -> empty?). jolt-seq is method-first.
|
||||
(define %r-jolt-empty? jolt-empty?)
|
||||
(set! jolt-empty? (lambda (coll) (if (jrec? coll) (jolt-nil? (jolt-seq coll)) (%r-jolt-empty? coll))))
|
||||
(set! jolt-empty? (lambda (coll)
|
||||
(if (jrec-collection? coll) (jolt-nil? (jolt-seq coll)) (%r-jolt-empty? coll))))
|
||||
(define %r-jolt-peek jolt-peek)
|
||||
(set! jolt-peek (lambda (coll)
|
||||
(cond ((jrec-cl coll "peek") => (lambda (m) (jolt-invoke m coll)))
|
||||
|
|
@ -365,10 +395,13 @@
|
|||
;; predicates.ss vars hold a snapshot, so re-def-var! after extending. record? is
|
||||
;; the overlay's (some? (get x :jolt/deftype)) — works for free since the get
|
||||
;; override returns the tag for that key.
|
||||
;; only a defrecord is a map (Clojure: a record IS an associative map); a bare
|
||||
;; deftype is not. coll? additionally covers a deftype implementing a collection
|
||||
;; interface. predicates.ss vars hold a snapshot, so re-def-var! after extending.
|
||||
(define %r-jolt-map? jolt-map?)
|
||||
(set! jolt-map? (lambda (x) (or (jrec? x) (%r-jolt-map? x))))
|
||||
(set! jolt-map? (lambda (x) (or (jrec-record? x) (%r-jolt-map? x))))
|
||||
(def-var! "clojure.core" "map?" jolt-map?)
|
||||
(def-var! "clojure.core" "coll?" (lambda (x) (or (jrec? x) (jolt-coll-pred? x))))
|
||||
(def-var! "clojure.core" "coll?" (lambda (x) (or (jrec-collection? x) (jolt-coll-pred? x))))
|
||||
|
||||
;; ---- protocol registry ------------------------------------------------------
|
||||
;; type-tag -> (proto-name -> (method-name -> fn))
|
||||
|
|
@ -483,6 +516,9 @@
|
|||
;; 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)
|
||||
;; 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)
|
||||
;; record the shape for whole-program inference, keyed by the positional
|
||||
;; ctor var "ns/->Name" the analyzer resolves a (->Name …) call to.
|
||||
(register-record-shape! (string-append (chez-current-ns) "/->" (symbol-t-name name-sym))
|
||||
|
|
@ -559,7 +595,14 @@
|
|||
(when pi (hashtable-set! pi extend-mark #t))))))
|
||||
(define (register-method type-name proto-name method-name fn)
|
||||
(let* ((host (canonical-host-tag type-name))
|
||||
(tag (or host (string-append (chez-current-ns) "." type-name))))
|
||||
(local (string-append (chez-current-ns) "." type-name))
|
||||
;; a host class -> its canonical tag; a deftype defined in THIS ns -> the
|
||||
;; local tag; an :import-ed deftype from another ns -> its real tag via the
|
||||
;; simple-name index; otherwise the local tag (a forward extend).
|
||||
(tag (cond (host host)
|
||||
((hashtable-ref chez-deftype-tag-set local #f) local)
|
||||
((hashtable-ref chez-simple-name-tag type-name #f))
|
||||
(else local))))
|
||||
(register-protocol-method tag proto-name method-name fn)
|
||||
(mark-extend! tag proto-name)
|
||||
jolt-nil))
|
||||
|
|
@ -830,6 +873,14 @@
|
|||
;; yields (jolt-symbol #f (jrec-tag x)), the ns.Name class-name symbol.
|
||||
|
||||
(def-var! "clojure.core" "make-deftype-ctor" make-deftype-ctor)
|
||||
|
||||
;; defrecord marks its type a record (deftype does not), keyed by the same
|
||||
;; "ns.Name" tag make-deftype-ctor bakes — so jrec-record? distinguishes the two.
|
||||
(define (register-record-type! name-sym)
|
||||
(hashtable-set! chez-record-type-tbl
|
||||
(string-append (chez-current-ns) "." (symbol-t-name name-sym)) #t)
|
||||
jolt-nil)
|
||||
(def-var! "clojure.core" "register-record-type!" register-record-type!)
|
||||
(def-var! "clojure.core" "make-protocol" make-protocol)
|
||||
(def-var! "clojure.core" "register-protocol-methods!" register-protocol-methods!)
|
||||
(def-var! "clojure.core" "register-method" register-method)
|
||||
|
|
|
|||
|
|
@ -33,6 +33,14 @@
|
|||
(apply %chez-error args)))
|
||||
(load "vendor/irregex/irregex.scm")
|
||||
|
||||
;; irregex rejects a quantifier applied to anything that already contains one —
|
||||
;; including a GROUP like (a+)* — because sre-repeater? recurses through submatch.
|
||||
;; Java only rejects a DANGLING double quantifier (a**); it allows a quantifier on
|
||||
;; a group whose body is quantified. Restrict the check to a bare leading * / + so
|
||||
;; a** still errors but (a+)* parses (cuerdas's format tokenizer needs this).
|
||||
(set! sre-repeater?
|
||||
(lambda (sre) (and (pair? sre) (memq (car sre) '(* +)) #t)))
|
||||
|
||||
;; Unicode property classes \p{...}: irregex's string syntax has no
|
||||
;; \p{...}, so translate a fixed set of property names
|
||||
;; to ASCII char classes before compiling. ASCII-only — \p{L} would need
|
||||
|
|
@ -92,6 +100,36 @@
|
|||
(write-char c out) (loop (fx+ i 1) #f))
|
||||
(else (write-char c out) (loop (fx+ i 1) in-class))))))))
|
||||
|
||||
;; Inside a [...] class, irregex reads a '-' that follows a shorthand class
|
||||
;; (\w \d \s \W \D \S) as the start of a range and errors ("bad char-set"); Java
|
||||
;; reads it as a literal hyphen (a shorthand can't be a range endpoint). Escape
|
||||
;; such a '-' to \- so the class parses. Only a '-' right after a shorthand and
|
||||
;; not the class terminator is touched; a '-' after a plain char (a real range
|
||||
;; like [a-z]) is left alone.
|
||||
(define (escape-class-shorthand-dash src)
|
||||
(let ((len (string-length src)) (out (open-output-string)))
|
||||
(let loop ((i 0) (in-class #f) (after-shorthand #f))
|
||||
(if (fx>=? i len)
|
||||
(get-output-string out)
|
||||
(let ((c (string-ref src i)))
|
||||
(cond
|
||||
;; an escape pair: \w-style shorthand sets after-shorthand inside a class
|
||||
((and (char=? c #\\) (fx<? (fx+ i 1) len))
|
||||
(let ((n (string-ref src (fx+ i 1))))
|
||||
(write-char c out) (write-char n out)
|
||||
(loop (fx+ i 2) in-class
|
||||
(and in-class (memv n '(#\w #\d #\s #\W #\D #\S)) #t))))
|
||||
((and (not in-class) (char=? c #\[))
|
||||
(write-char c out) (loop (fx+ i 1) #t #f))
|
||||
((and in-class (char=? c #\]))
|
||||
(write-char c out) (loop (fx+ i 1) #f #f))
|
||||
;; the case Java reads as a literal hyphen
|
||||
((and in-class after-shorthand (char=? c #\-)
|
||||
(fx<? (fx+ i 1) len) (not (char=? (string-ref src (fx+ i 1)) #\])))
|
||||
(write-char #\\ out) (write-char #\- out)
|
||||
(loop (fx+ i 1) in-class #f))
|
||||
(else (write-char c out) (loop (fx+ i 1) in-class #f))))))))
|
||||
|
||||
;; Java/Clojure inline flags: a leading (?imsx…) group sets a flag over the whole
|
||||
;; pattern. irregex has the same semantics but as constructor OPTIONS, not inline
|
||||
;; syntax (it rejects (?s)/(?s:…)), so peel any leading flag groups off the source
|
||||
|
|
@ -123,7 +161,8 @@
|
|||
(define-record-type regex-t (fields source irx) (nongenerative jolt-regex-v1))
|
||||
(define (jolt-regex source)
|
||||
(let-values (((opts pat) (regex-parse-flags source)))
|
||||
(make-regex-t source (apply irregex (translate-prop-classes pat) opts))))
|
||||
(make-regex-t source
|
||||
(apply irregex (translate-prop-classes (escape-class-shorthand-dash pat)) opts))))
|
||||
(define (jolt-regex? x) (regex-t? x))
|
||||
(define (jolt-re-pattern x) (if (regex-t? x) x (jolt-regex x)))
|
||||
|
||||
|
|
@ -143,9 +182,44 @@
|
|||
(let ((m (irregex-match (regex-t-irx (jolt-re-pattern re)) s)))
|
||||
(if m (irx-result m) jolt-nil)))
|
||||
|
||||
(define (jolt-re-find re s)
|
||||
(let ((m (irregex-search (regex-t-irx (jolt-re-pattern re)) s)))
|
||||
(if m (irx-result m) jolt-nil)))
|
||||
;; A stateful matcher (java.util.regex.Matcher): the compiled pattern, the target
|
||||
;; string, the next search position, and the last successful irregex match. re-find
|
||||
;; over a matcher steps through non-overlapping matches; re-groups returns the
|
||||
;; groups of the last one.
|
||||
(define-record-type matcher-t
|
||||
(fields irx str (mutable pos) (mutable last))
|
||||
(nongenerative jolt-matcher-v1))
|
||||
(define (jolt-re-matcher re s)
|
||||
(make-matcher-t (regex-t-irx (jolt-re-pattern re)) s 0 #f))
|
||||
(define (jolt-matcher? x) (matcher-t? x))
|
||||
|
||||
;; re-find: stateless over (re s), or stateful over a matcher (advance + remember).
|
||||
(define jolt-re-find
|
||||
(case-lambda
|
||||
((re s)
|
||||
(let ((m (irregex-search (regex-t-irx (jolt-re-pattern re)) s)))
|
||||
(if m (irx-result m) jolt-nil)))
|
||||
((m)
|
||||
(let* ((str (matcher-t-str m))
|
||||
(len (string-length str))
|
||||
(start (matcher-t-pos m))
|
||||
(mm (and (<= start len) (irregex-search (matcher-t-irx m) str start))))
|
||||
(if mm
|
||||
(let ((ms (irregex-match-start-index mm 0))
|
||||
(e (irregex-match-end-index mm 0)))
|
||||
(matcher-t-last-set! m mm)
|
||||
;; advance past this match: to its end, or one past a zero-width match
|
||||
;; (which may sit past the search origin, e.g. a lookahead/boundary).
|
||||
(matcher-t-pos-set! m (if (> e ms) e (+ e 1)))
|
||||
(irx-result mm))
|
||||
(begin (matcher-t-last-set! m #f) jolt-nil))))))
|
||||
|
||||
;; re-groups: the groups of the matcher's last successful find. Throws when no
|
||||
;; match has succeeded, like Clojure's IllegalStateException "No match found".
|
||||
(define (jolt-re-groups m)
|
||||
(let ((last (matcher-t-last m)))
|
||||
(if last (irx-result last)
|
||||
(jolt-throw (jolt-ex-info "No match found" (jolt-hash-map))))))
|
||||
|
||||
;; 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
|
||||
|
|
@ -156,12 +230,17 @@
|
|||
(let loop ((start 0) (acc '()))
|
||||
(let ((m (and (<= start len) (irregex-search irx s start))))
|
||||
(if m
|
||||
(let ((e (irregex-match-end-index m 0)))
|
||||
(loop (if (> e start) e (+ start 1)) (cons (irx-result m) acc)))
|
||||
(let ((ms (irregex-match-start-index m 0))
|
||||
(e (irregex-match-end-index m 0)))
|
||||
;; to the match end, or one past a zero-width match (relative to its
|
||||
;; own start, which may be past the search origin).
|
||||
(loop (if (> e ms) e (+ e 1)) (cons (irx-result m) acc)))
|
||||
(list->cseq (reverse acc)))))))
|
||||
|
||||
(def-var! "clojure.core" "re-pattern" jolt-re-pattern)
|
||||
(def-var! "clojure.core" "re-matches" jolt-re-matches)
|
||||
(def-var! "clojure.core" "re-find" jolt-re-find)
|
||||
(def-var! "clojure.core" "re-seq" jolt-re-seq)
|
||||
(def-var! "clojure.core" "re-matcher" jolt-re-matcher)
|
||||
(def-var! "clojure.core" "re-groups" jolt-re-groups)
|
||||
(def-var! "clojure.core" "regex?" jolt-regex?)
|
||||
|
|
|
|||
|
|
@ -110,6 +110,11 @@
|
|||
;; (pr-str (def x 1)) is "#'ns/x". The prelude's def-var! forms discard the
|
||||
;; return, so this is transparent there.
|
||||
(define (def-var! ns name v) (let ((c (jolt-var ns name))) (var-cell-root-set! c v) (var-cell-defined?-set! c #t) c))
|
||||
;; jolt.host/throwable — build a typed throwable a library can throw so (class …),
|
||||
;; instance?, .getMessage and ex-message all reflect the named JVM class (e.g. an
|
||||
;; http client throwing java.net.ConnectException). Strictly better than a
|
||||
;; hand-rolled :jolt/ex-info table, which carries only the class.
|
||||
(def-var! "jolt.host" "throwable" jolt-host-throwable)
|
||||
;; var def-time metadata: the :def emit passes the def's reader meta
|
||||
;; (^:private / ^Type tag / docstring -> {:doc}) here, stored in an eq side-table
|
||||
;; keyed by the cell. jolt-meta (natives-meta.ss) merges it onto {:ns :name},
|
||||
|
|
@ -185,6 +190,59 @@
|
|||
;; bare nil renders as the empty string (a nil ELEMENT inside a collection still
|
||||
;; prints "nil", which jolt-pr-str handles).
|
||||
(define (jolt-final-str x) (if (jolt-nil? x) "" (jolt-pr-str x)))
|
||||
;; --- *print-level* / *print-length* -----------------------------------------
|
||||
;; Both vars default to nil (= unlimited). A non-nil number limits collection
|
||||
;; nesting depth / element count in BOTH printers (jolt-pr-str here and
|
||||
;; jolt-pr-readable in printing.ss). Cells captured lazily — the vars are def'd
|
||||
;; after rt.ss. The nil default takes a fast path: jolt-print-hash? is #f and the
|
||||
;; limited-string walkers never truncate.
|
||||
(define plevel-cell #f)
|
||||
(define plength-cell #f)
|
||||
(define (jolt-print-level)
|
||||
(unless plevel-cell (set! plevel-cell (jolt-var "clojure.core" "*print-level*")))
|
||||
(let ((v (jolt-var-get plevel-cell))) (and (number? v) v)))
|
||||
(define (jolt-print-length)
|
||||
(unless plength-cell (set! plength-cell (jolt-var "clojure.core" "*print-length*")))
|
||||
(let ((v (jolt-var-get plength-cell))) (and (number? v) v)))
|
||||
(define jolt-print-depth (make-thread-parameter 0))
|
||||
;; A collection at depth >= *print-level* renders as "#". The top-level collection
|
||||
;; is depth 0, so *print-level* 0 collapses any collection, 1 keeps the outermost.
|
||||
(define (jolt-print-hash?)
|
||||
(let ((lvl (jolt-print-level))) (and lvl (fx>=? (jolt-print-depth) lvl))))
|
||||
;; Rendered element strings of a vector (by index), honoring *print-length*: at
|
||||
;; most N, then "...". render-one runs at the current (already bumped) depth.
|
||||
(define (jolt-limited-vec-strs x render-one)
|
||||
(let ((len (pvec-count x)) (lim (jolt-print-length)))
|
||||
(let loop ((i 0) (acc '()))
|
||||
(cond ((fx>=? i len) (reverse acc))
|
||||
((and lim (fx>=? i lim)) (reverse (cons "..." acc)))
|
||||
(else (loop (fx+ i 1) (cons (render-one (pvec-nth-d x i jolt-nil)) acc)))))))
|
||||
;; Rendered element strings of a seq, walked lazily so an infinite seq is realized
|
||||
;; only up to *print-length*.
|
||||
(define (jolt-limited-seq-strs s render-one)
|
||||
(let ((lim (jolt-print-length)))
|
||||
(let loop ((s s) (i 0) (acc '()))
|
||||
(cond ((jolt-nil? s) (reverse acc))
|
||||
((and lim (fx>=? i lim)) (reverse (cons "..." acc)))
|
||||
(else (loop (jolt-seq (seq-more s)) (fx+ i 1) (cons (render-one (seq-first s)) acc)))))))
|
||||
;; Truncate an already-collected element-string list (set / map, finite) to
|
||||
;; *print-length*, appending "..." when more remain.
|
||||
(define (jolt-limited-list-strs strs)
|
||||
(let ((lim (jolt-print-length)))
|
||||
(if (not lim) strs
|
||||
(let loop ((s strs) (i 0) (acc '()))
|
||||
(cond ((null? s) (reverse acc))
|
||||
((fx>=? i lim) (reverse (cons "..." acc)))
|
||||
(else (loop (cdr s) (fx+ i 1) (cons (car s) acc))))))))
|
||||
;; bump the print depth around a collection's element rendering — but only when
|
||||
;; *print-level* is set, since depth is consulted only to enforce it. With the
|
||||
;; common nil default this is a plain begin, so printing pays no parameterize.
|
||||
(define-syntax with-deeper-print
|
||||
(syntax-rules ()
|
||||
((_ body ...) (if (jolt-print-level)
|
||||
(parameterize ((jolt-print-depth (fx+ (jolt-print-depth) 1))) body ...)
|
||||
(begin body ...)))))
|
||||
|
||||
;; A host shim registers a type's str-style rendering via register-pr-str-arm! (or
|
||||
;; register-pr-arm! in printing.ss for both printers at once) instead of
|
||||
;; set!-wrapping jolt-pr-str. Disjoint types, checked before the base cases.
|
||||
|
|
@ -205,18 +263,23 @@
|
|||
(if (or (jolt-nil? ns) (not ns) (eq? ns '())) (symbol-t-name x)
|
||||
(string-append ns "/" (symbol-t-name x)))))
|
||||
((regex-t? x) (string-append "#\"" (regex-t-source x) "\""))
|
||||
((pvec? x) (let ((acc '())) (let loop ((i (fx- (pvec-count x) 1)))
|
||||
(when (fx>=? i 0) (set! acc (cons (jolt-pr-str (pvec-nth-d x i jolt-nil)) acc)) (loop (fx- i 1))))
|
||||
(string-append "[" (jolt-str-join acc) "]")))
|
||||
((pset? x) (string-append "#{" (jolt-str-join (pset-fold x (lambda (e a) (cons (jolt-pr-str e) a)) '())) "}"))
|
||||
((pmap? x) (string-append "{" (jolt-str-join
|
||||
(pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '())) "}"))
|
||||
;; lists / cons / lazy seqs all print as (...) — forces a finite seq.
|
||||
((empty-list-t? x) "()")
|
||||
((cseq? x) (string-append "(" (jolt-str-join
|
||||
(let loop ((s x) (acc '()))
|
||||
(if (jolt-nil? s) (reverse acc)
|
||||
(loop (jolt-seq (seq-more s)) (cons (jolt-pr-str (seq-first s)) acc))))) ")"))
|
||||
((pvec? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "[" (jolt-str-join (jolt-limited-vec-strs x jolt-pr-str)) "]"))))
|
||||
((pset? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "#{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pset-fold x (lambda (e a) (cons (jolt-pr-str e) a)) '()))) "}"))))
|
||||
((pmap? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "{" (jolt-str-join (jolt-limited-list-strs
|
||||
(pmap-fold x (lambda (k v a) (cons (string-append (jolt-pr-str k) " " (jolt-pr-str v)) a)) '()))) "}"))))
|
||||
;; lists / cons / lazy seqs all print as (...) — forces a finite seq (or up to
|
||||
;; *print-length* of an infinite one).
|
||||
((empty-list-t? x) (if (jolt-print-hash?) "#" "()"))
|
||||
((cseq? x) (if (jolt-print-hash?) "#"
|
||||
(with-deeper-print
|
||||
(string-append "(" (jolt-str-join (jolt-limited-seq-strs x jolt-pr-str)) ")"))))
|
||||
(else (format "~a" x))))
|
||||
(define (jolt-pr-str x)
|
||||
(let loop ((as jolt-pr-str-arms))
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
|
|
@ -85,10 +85,25 @@
|
|||
;; the seq leaf ops the emitter lowers core fns to
|
||||
;; ============================================================================
|
||||
(define (jolt-first x) (let ((s (jolt-seq x))) (if (jolt-nil? s) jolt-nil (seq-first s))))
|
||||
(define (jolt-rest x) ; () when the seq has 0/1 elements (NOT nil)
|
||||
;; rest = Clojure's more(): the tail as a (possibly empty) seq, NOT nil, and
|
||||
;; WITHOUT realizing it. A forced cseq (list / realized chain) hands back its tail
|
||||
;; directly. An UNFORCED tail (vector / string / lazy-seq cell) is returned as a
|
||||
;; deferred seq so (rest s) does not realize the next node — matching Clojure,
|
||||
;; where (rest (iterate f x)) does not call f and a side-effecting lazy seq is
|
||||
;; realized one element at a time. next = (seq (rest s)) still realizes one.
|
||||
;; jolt-make-lazy-seq (lazy-bridge.ss) resolves at call time.
|
||||
(define (jolt-rest x)
|
||||
(let ((s (jolt-seq x)))
|
||||
(if (jolt-nil? s) jolt-empty-list
|
||||
(let ((m (seq-more s))) (if (jolt-nil? m) jolt-empty-list m)))))
|
||||
(cond
|
||||
((jolt-nil? s) jolt-empty-list)
|
||||
((cseq-forced? s) (let ((m (cseq-tail s))) (if (jolt-nil? m) jolt-empty-list m)))
|
||||
;; the lazyseq forces to a seq (cseq | nil); an empty realized lazyseq is
|
||||
;; still a sequence value, printing "()" (see lazy-bridge.ss), so (rest s)
|
||||
;; is never nil even when the tail is empty. jolt-seq coerces seq-more's
|
||||
;; result (which may be jolt-empty-list, e.g. map's tail) back to cseq | nil,
|
||||
;; the contract force-lazyseq relies on — else (seq (rest s)) of an empty
|
||||
;; tail yields a truthy empty-list and walkers (distinct, dedupe) overrun.
|
||||
(else (jolt-make-lazy-seq (lambda () (jolt-seq (seq-more s))))))))
|
||||
(define (jolt-next x) ; nil when the rest is empty
|
||||
;; next = (seq (rest x)): the rest must be RE-SEQ'd so an empty tail collapses to
|
||||
;; nil. seq-more on a lazy seq (e.g. map's) forces to jolt-empty-list, which is
|
||||
|
|
@ -246,11 +261,21 @@
|
|||
((start end) (range-bounded start end 1))
|
||||
((start end step) (range-bounded start end step))))
|
||||
|
||||
;; An empty take result is () (jolt-empty-list), NOT nil — (take 0 coll) and
|
||||
;; (take n []) are empty seqs in Clojure, so (= () (take 0 [:a])) and printing
|
||||
;; "()" hold. jolt-empty-list seqs back to nil, so it also terminates the lazy
|
||||
;; tail when n hits 0 mid-stream (see map-seq).
|
||||
;; The LAST element (n=1) terminates without touching the rest, so (take n s)
|
||||
;; realizes exactly n elements of a side-effecting seq — matching Clojure, where
|
||||
;; (take 0 (rest s)) never seqs coll. Realizing one more, as forcing seq-more at
|
||||
;; the boundary would, over-runs the source by one (medley's sequence-padded).
|
||||
(define (jolt-take n coll)
|
||||
(let ((n (->idx n)))
|
||||
(let loop ((n n) (s (jolt-seq coll)))
|
||||
(if (or (fx<=? n 0) (jolt-nil? s)) jolt-nil
|
||||
(cseq-lazy (seq-first s) (lambda () (loop (fx- n 1) (jolt-seq (seq-more s)))))))))
|
||||
(cond
|
||||
((or (fx<=? n 0) (jolt-nil? s)) jolt-empty-list)
|
||||
((fx=? n 1) (cseq-lazy (seq-first s) (lambda () jolt-empty-list)))
|
||||
(else (cseq-lazy (seq-first s) (lambda () (loop (fx- n 1) (jolt-seq (seq-more s))))))))))
|
||||
(define (jolt-drop n coll)
|
||||
(let loop ((n (->idx n)) (s (jolt-seq coll)))
|
||||
(if (or (fx<=? n 0) (jolt-nil? s)) (if (jolt-nil? s) jolt-empty-list s)
|
||||
|
|
|
|||
|
|
@ -59,11 +59,13 @@
|
|||
;; nil, which prints as "nil" (str yields ""). Only the top-level arg needs the
|
||||
;; guard; nil nested in a collection already renders as "nil" via the collection
|
||||
;; printer.
|
||||
;; print renders non-readably (__print1): a nested string is raw, unlike str/pr
|
||||
;; which quote it. (print ["x"]) => [x], (str ["x"]) => ["x"].
|
||||
(defn print [& xs]
|
||||
(__write (loop [out "" s (seq xs) first? true]
|
||||
(if s
|
||||
(let [x (first s)
|
||||
r (if (nil? x) "nil" (str x))]
|
||||
r (__print1 x)]
|
||||
(recur (str out (if first? "" " ") r) (next s) false))
|
||||
out)))
|
||||
nil)
|
||||
|
|
|
|||
|
|
@ -613,6 +613,8 @@
|
|||
;; deftype already defines ->name (= the ctor); no (name. …) interop needed,
|
||||
;; so defrecord compiles too. map->name builds via that ctor.
|
||||
(deftype ~name-sym ~fields)
|
||||
;; mark the type a record (map?/record?/field-seq); a bare deftype is not.
|
||||
(register-record-type! (quote ~name-sym))
|
||||
;; build via the positional ctor for declared fields, then carry any
|
||||
;; remaining keys as extension fields (JVM keeps them on the record).
|
||||
(def ~mapf (fn* [~m]
|
||||
|
|
|
|||
|
|
@ -96,8 +96,12 @@
|
|||
([n x] (take n (repeat x))))
|
||||
|
||||
;; --- iterate ---
|
||||
;; f is applied lazily, inside the tail thunk — (first (iterate f x)) is x with no
|
||||
;; call to f, matching clojure.lang.Iterate. Wrapping the whole body in lazy-seq
|
||||
;; instead would force (f x) the moment the head realizes (it is an eager argument
|
||||
;; to cons), realizing one step ahead.
|
||||
(defn iterate [f x]
|
||||
(lazy-seq (cons x (iterate f (f x)))))
|
||||
(cons x (lazy-seq (iterate f (f x)))))
|
||||
|
||||
|
||||
;; --- partition-all --- (transducer + [n coll] + [n step coll])
|
||||
|
|
|
|||
|
|
@ -89,13 +89,19 @@
|
|||
(cond
|
||||
;; (is (thrown? Class body...))
|
||||
(thrown-form? form "thrown?")
|
||||
(let [klass (name (second form))
|
||||
(let [klass-sym (second form)
|
||||
klass (name klass-sym)
|
||||
body (nthrest form 2)]
|
||||
`(try
|
||||
~@body
|
||||
(clojure.test/fail! (str "expected " '~form " to throw" (when ~msg (str " — " ~msg))))
|
||||
(catch Throwable e#
|
||||
(if (clojure.test/class-match? e# ~klass)
|
||||
;; instance? honors the exception hierarchy (a literal class symbol), so
|
||||
;; (thrown? IllegalArgumentException …) matches an ArityException subclass
|
||||
;; like the JVM; class-match? is the simple-name fallback for a class jolt
|
||||
;; models only by name.
|
||||
(if (or (clojure.core/instance? ~klass-sym e#)
|
||||
(clojure.test/class-match? e# ~klass))
|
||||
(clojure.test/inc-pass!)
|
||||
(clojure.test/fail! (str "expected throw of " ~klass " but got " (clojure.core/class e#)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -48,6 +48,11 @@
|
|||
[smap form]
|
||||
(prewalk (fn [x] (if (contains? smap x) (get smap x) x)) form))
|
||||
|
||||
(defn macroexpand-all
|
||||
"Recursively performs all possible macroexpansions in form."
|
||||
[form]
|
||||
(prewalk (fn [x] (if (seq? x) (macroexpand x) x)) form))
|
||||
|
||||
(defn keywordize-keys
|
||||
[m]
|
||||
(let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))]
|
||||
|
|
|
|||
|
|
@ -1823,6 +1823,21 @@
|
|||
{:suite "regex / re-seq" :label "all matches" :expected "[\"1\" \"22\" \"333\"]" :actual "(re-seq #\"\\d+\" \"a1b22c333\")"}
|
||||
{:suite "regex / re-seq" :label "empty when none" :expected "nil" :actual "(seq (re-seq #\"z\" \"abc\"))"}
|
||||
{:suite "regex / re-seq" :label "words" :expected "[\"foo\" \"bar\"]" :actual "(re-seq #\"\\w+\" \"foo bar\")"}
|
||||
{:suite "regex / char-class dash" :label "dash after \\w is literal" :expected "\"a_b-c\"" :actual "(re-matches #\"[\\w-_]+\" \"a_b-c\")"}
|
||||
{:suite "regex / char-class dash" :label "dash + escaped dot in class" :expected "\"a.b_c-d\"" :actual "(re-matches #\"[\\w-_\\.]+\" \"a.b_c-d\")"}
|
||||
{:suite "regex / char-class dash" :label "trailing dash in class" :expected "[\"a-b\" \"c-d\"]" :actual "(vec (re-seq #\"[\\w-]+\" \"a-b c-d\"))"}
|
||||
{:suite "regex / nested quantifier" :label "(X+)* parses and matches" :expected "true" :actual "(boolean (re-matches #\"([^%]+)*(%(d))?\" \"abc\"))"}
|
||||
{:suite "regex / matcher" :label "re-find over a matcher" :expected "\"1\"" :actual "(re-find (re-matcher #\"\\d+\" \"a1b22\"))"}
|
||||
{:suite "regex / matcher" :label "stateful step + re-groups" :expected "[[\"12-34\" \"12\" \"34\"] [\"12-34\" \"12\" \"34\"] [\"56-78\" \"56\" \"78\"] nil]" :actual "(let [m (re-matcher #\"(\\d+)-(\\d+)\" \"12-34 56-78\")] [(re-find m) (re-groups m) (re-find m) (re-find m)])"}
|
||||
{:suite "regex / matcher" :label "re-groups before a match throws" :expected :throws :actual "(re-groups (re-matcher #\"\\d\" \"abc\"))"}
|
||||
{:suite "dynamic vars / portable defaults" :label "default reads" :expected "[true false true false]" :actual "[*read-eval* *print-dup* *flush-on-newline* *compile-files*]"}
|
||||
{:suite "dynamic vars / portable defaults" :label "binding *read-eval*" :expected "false" :actual "(binding [*read-eval* false] *read-eval*)"}
|
||||
{:suite "special forms / letfn" :label "mutual recursion" :expected "true" :actual "(letfn [(e? [n] (if (zero? n) true (o? (dec n)))) (o? [n] (if (zero? n) false (e? (dec n))))] (e? 10))"}
|
||||
{:suite "core vars / present and callable" :label "*out* *err* *warn-on-reflection* await restart-agent" :expected "[true true false true true]" :actual "[(boolean *out*) (boolean *err*) *warn-on-reflection* (ifn? await) (ifn? restart-agent)]"}
|
||||
{:suite "exceptions / runtime error classes" :label "arity error is ArityException" :expected "true" :actual "(instance? clojure.lang.ArityException (try ((fn [a b] a) 1) (catch Throwable e e)))"}
|
||||
{:suite "exceptions / runtime error classes" :label "ArityException is an IllegalArgumentException" :expected "true" :actual "(instance? IllegalArgumentException (try ((fn [a b] a) 1) (catch Throwable e e)))"}
|
||||
{:suite "exceptions / runtime error classes" :label "non-seqable is IllegalArgumentException" :expected "true" :actual "(instance? IllegalArgumentException (try (doall (mapcat identity 0)) (catch Throwable e e)))"}
|
||||
{:suite "dynamic vars / portable defaults" :label "*data-readers* map, *math-context* nil" :expected "[true true]" :actual "[(map? *data-readers*) (nil? *math-context*)]"}
|
||||
{:suite "regex / re-pattern & string ops" :label "re-pattern build" :expected "\"hi\"" :actual "(re-find (re-pattern \"\\\\w+\") \"hi!\")"}
|
||||
{:suite "regex / re-pattern & string ops" :label "re-pattern is regex?" :expected "true" :actual "(regex? (re-pattern \"a\"))"}
|
||||
{:suite "regex / re-pattern & string ops" :label "split on regex" :expected "[\"a\" \"b\" \"c\"]" :actual "(do (require '[clojure.string :as s]) (s/split \"a1b2c\" #\"\\d\"))"}
|
||||
|
|
@ -3236,4 +3251,31 @@
|
|||
{:suite "vectors / large trie" :label "assoc in a large vector" :expected "[1098 :x 1100]" :actual "(let [v (assoc (vec (range 1100)) 1099 :x)] [(nth v 1098) (nth v 1099) (count v)])"}
|
||||
{:suite "vectors / large trie" :label "pop down across a level boundary" :expected "[1023 1022]" :actual "(let [p (pop (vec (range 1024)))] [(count p) (peek p)])"}
|
||||
{:suite "vectors / large trie" :label "pop to empty then rebuild" :expected "[0 5]" :actual "(let [e (loop [v (vec (range 100))] (if (seq v) (recur (pop v)) v))] [(count e) (count (into e (range 5)))])"}
|
||||
{:suite "printer / print-length" :label "truncates an infinite seq before realizing it" :expected "true" :actual "(= \"(0 1 2 ...)\" (binding [*print-length* 3] (pr-str (range))))"}
|
||||
{:suite "printer / print-length" :label "truncates a vector with ellipsis" :expected "true" :actual "(= \"[1 2 ...]\" (binding [*print-length* 2] (pr-str [1 2 3 4])))"}
|
||||
{:suite "printer / print-length" :label "exactly N elements prints no ellipsis" :expected "true" :actual "(= \"(0 1 2)\" (binding [*print-length* 3] (pr-str (range 3))))"}
|
||||
{:suite "printer / print-length" :label "nil default is unlimited" :expected "true" :actual "(= \"[1 2 3 4 5]\" (pr-str [1 2 3 4 5]))"}
|
||||
{:suite "printer / print-level" :label "collapses a collection past the level to #" :expected "true" :actual "(= \"[:a [:b #]]\" (binding [*print-level* 2] (pr-str [:a [:b [:c 1]]])))"}
|
||||
{:suite "printer / print-level" :label "level 0 collapses the top collection" :expected "true" :actual "(= \"#\" (binding [*print-level* 0] (pr-str [1 2])))"}
|
||||
{:suite "printer / print-level" :label "level 1 keeps the outermost collection" :expected "true" :actual "(= \"[# 3]\" (binding [*print-level* 1] (pr-str [[1 2] 3])))"}
|
||||
{:suite "printer / print-level" :label "scalars print regardless of level" :expected "true" :actual "(= \"[1 2]\" (binding [*print-level* 1] (pr-str [1 2])))"}
|
||||
{:suite "reader / default-data-reader-fn" :label "consulted for an unregistered tag" :expected "true" :actual "(= [(quote foo) 42] (binding [*default-data-reader-fn* (fn [tag v] [tag v])] (read-string \"#foo 42\")))"}
|
||||
{:suite "printer / print-vars" :label "print-length / print-level / default-data-reader-fn default to nil" :expected "[true true true]" :actual "[(nil? *print-length*) (nil? *print-level*) (nil? *default-data-reader-fn*)]"}
|
||||
{:suite "seqs / laziness" :label "an empty lazy seq is () not nil" :expected "true" :actual "(= () (lazy-seq nil))"}
|
||||
{:suite "seqs / laziness" :label "rest of a one-element coll is ()" :expected "true" :actual "(= () (rest [1]))"}
|
||||
{:suite "seqs / laziness" :label "first of iterate does not call f" :expected "true" :actual "(let [a (atom 0)] (first (iterate (fn [x] (swap! a inc) (inc x)) 0)) (= 0 @a))"}
|
||||
{:suite "seqs / laziness" :label "rest of iterate does not realize the next element" :expected "true" :actual "(let [a (atom 0)] (rest (iterate (fn [x] (swap! a inc) (inc x)) 0)) (= 0 @a))"}
|
||||
{:suite "seqs / laziness" :label "take from an infinite iterate" :expected "[0 1 2 3 4]" :actual "(vec (take 5 (iterate inc 0)))"}
|
||||
{:suite "seqs / laziness" :label "distinct over a rest-derived seq does not overrun" :expected "2" :actual "(count (distinct (map inc (rest [10 20 30]))))"}
|
||||
{:suite "transducers / map multi-input" :label "the map transducer applies f across all inputs" :expected "[6]" :actual "(((map +) conj) [] 1 2 3)"}
|
||||
{:suite "transducers / map multi-input" :label "single input is unchanged" :expected "[3]" :actual "(((map +) conj) [] 3)"}
|
||||
{:suite "records / deftype is not a map" :label "a bare deftype is neither map? nor record?, a defrecord is both" :expected "[false false true true]" :actual "(do (deftype DT [a]) (defrecord DR [a]) [(map? (->DT 1)) (record? (->DT 1)) (map? (->DR 1)) (record? (->DR 1))])"}
|
||||
{:suite "printer / str vs print" :label "str of a vector quotes nested strings" :expected "true" :actual "(= \"[\\\"x\\\"]\" (str [\"x\"]))"}
|
||||
{:suite "printer / str vs print" :label "print-str of a vector leaves strings raw" :expected "true" :actual "(= \"[x]\" (print-str [\"x\"]))"}
|
||||
{:suite "printer / str vs print" :label "str of a map quotes nested strings" :expected "true" :actual "(= \"{\\\"a\\\" \\\"b\\\"}\" (str {\"a\" \"b\"}))"}
|
||||
{:suite "printer / str vs print" :label "print-str of a map leaves strings raw" :expected "true" :actual "(= \"{:a x}\" (print-str {:a \"x\"}))"}
|
||||
{:suite "printer / str vs print" :label "infinity inside a collection prints readably in str" :expected "true" :actual "(= \"[##Inf]\" (str [##Inf]))"}
|
||||
{:suite "interop / uri equality" :label "URIs are value-equal and usable as set members" :expected "[true true]" :actual "[(= (java.net.URI. \"/\") (java.net.URI. \"/\")) (= #{(java.net.URI. \"/\")} #{(java.net.URI. \"/\")})]"}
|
||||
{:suite "stdlib / clojure.walk" :label "macroexpand-all expands a form" :expected "true" :actual "(do (require (quote clojure.walk)) (seq? (clojure.walk/macroexpand-all (quote (when true 1)))))"}
|
||||
{:suite "regex / re-seq zero-width" :label "a zero-width match advances by one without repeating" :expected "[\"a\" \"\" \"a\" \"\"]" :actual "(vec (re-seq #\"a*\" \"aba\"))"}
|
||||
]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue