f5455115a0
Running clojure.core.match (a macro-heavy library that builds its compiler out of deftypes implementing clojure.lang interfaces) shook out a cluster of general gaps. Its own suite goes from not-loading to 111/115 assertions. - deftype/defrecord implementing a clojure.lang collection interface now drives the core fns: Indexed -> nth, Counted -> count, Associative -> assoc, ILookup -> get/valAt (non-field keys only, so a method's own field bindings don't recurse), ISeq -> seq/first/rest, IPersistentCollection -> conj, IFn -> the value is callable. A jrec is still a map of fields by default; the interface method wins when declared. - Multi-arity inline methods are grouped into one fn (a type with (nth [_ i]) and (nth [_ i x]) kept only the last before). Built as data, not a nested syntax-quote, so a `(= ~ocr ~l) method body keeps its unquotes. - instance?/satisfies? recognize a protocol a type implements, including a MARKER protocol with no methods (core.match's IPseudoPattern) — deftype/defrecord now record protocol satisfaction even with zero methods. Added ILookup/Indexed/ Counted to the instance? taxonomy for the built-in collections. - Syntax-quote: a fully-qualified class name (clojure.lang.ILookup) stays bare instead of being namespace-qualified; (unquote x) is detected in a lazy seq (a macro that builds its template with map, e.g. deftype's rewrite-set). - clojure.set union/intersection/difference are variadic (& sets) + union 0-arity. - java map view methods: keySet/values/entrySet/size/isEmpty. - deprecated java.util.Date getters (getYear/getMonth/...) + the multi-arg (Date. year-1900 month0 date hrs min) constructor. Seed change (deftype/defrecord macros + clojure.set) -> re-minted; the rest are runtime. 11 JVM-certified corpus rows; make test + shakesmoke green.
121 lines
6.6 KiB
Scheme
121 lines
6.6 KiB
Scheme
;; records-interop.ss — JVM-emulation taxonomy split out of records.ss: the
|
|
;; ex-info class accessors, the exception supertype hierarchy, and instance-check
|
|
;; / case-string (the (instance? Class x) decision table). Loaded right after
|
|
;; records.ss; instance-check forward-refs nothing in records.ss at load time.
|
|
|
|
;; pmap? guard: ex-info maps are plain hash-maps, never sorted-map htables — and a
|
|
;; bare jolt-get on a sorted-map would invoke its comparator on :jolt/type and throw.
|
|
(define (ex-info-map? v)
|
|
(and (pmap? v) (jolt=2 (jolt-get v jolt-kw-ex-type jolt-nil) jolt-kw-ex-info)))
|
|
(define (ex-info-class v)
|
|
(let ((c (jolt-get v jolt-kw-class jolt-nil)))
|
|
(if (string? c) c "clojure.lang.ExceptionInfo")))
|
|
;; immediate-parent chain of the JVM exception hierarchy (simple names). Drives
|
|
;; instance? across exception supertypes — (instance? Throwable (ex-info …)) etc.
|
|
(define exception-parent
|
|
'(("ExceptionInfo" . "RuntimeException")
|
|
("RuntimeException" . "Exception")
|
|
("IllegalArgumentException" . "RuntimeException")
|
|
("NumberFormatException" . "IllegalArgumentException")
|
|
("IllegalStateException" . "RuntimeException")
|
|
("UnsupportedOperationException" . "RuntimeException")
|
|
("ArithmeticException" . "RuntimeException")
|
|
("NullPointerException" . "RuntimeException")
|
|
("ClassCastException" . "RuntimeException")
|
|
("IndexOutOfBoundsException" . "RuntimeException")
|
|
("ConcurrentModificationException" . "RuntimeException")
|
|
("NoSuchElementException" . "RuntimeException")
|
|
("UncheckedIOException" . "RuntimeException")
|
|
("InterruptedException" . "Exception")
|
|
("IOException" . "Exception")
|
|
("FileNotFoundException" . "IOException")
|
|
("UnsupportedEncodingException" . "IOException")
|
|
("UnknownHostException" . "IOException")
|
|
("SocketException" . "IOException")
|
|
("ConnectException" . "IOException")
|
|
("SocketTimeoutException" . "IOException")
|
|
("MalformedURLException" . "IOException")
|
|
("SSLException" . "IOException")
|
|
("Exception" . "Throwable")
|
|
("Error" . "Throwable")
|
|
("AssertionError" . "Error")
|
|
("Throwable" . "Object")))
|
|
;; Is `wanted` (simple name) `cls` or a supertype of it? ExceptionInfo also
|
|
;; implements the IExceptionInfo interface.
|
|
(define (exception-isa? cls wanted)
|
|
(let loop ((c cls))
|
|
(cond ((not c) #f)
|
|
((string=? c wanted) #t)
|
|
((and (string=? c "ExceptionInfo") (string=? wanted "IExceptionInfo")) #t)
|
|
(else (let ((p (assoc c exception-parent))) (loop (and p (cdr p))))))))
|
|
|
|
;; 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
|
|
;; instance-check; an arm returns #t/#f to decide or 'pass to defer to the next.
|
|
;; Newest arm is checked first (matches the old outermost-wins set! order).
|
|
;; instance-check-base is the JVM taxonomy fallback when no arm decides.
|
|
(define instance-check-registry '())
|
|
(define (register-instance-check-arm! f) ; f: (type-sym val) -> #t | #f | 'pass
|
|
(set! instance-check-registry (cons f instance-check-registry)))
|
|
|
|
(define (instance-check-base type-sym val)
|
|
(let ((tname (symbol-t-name type-sym)))
|
|
(cond
|
|
((jrec? val)
|
|
(let ((tag (jrec-tag val)))
|
|
(or (string=? tag tname)
|
|
(and (> (string-length tag) (string-length tname))
|
|
(string=? (substring tag (- (string-length tag) (string-length tname)) (string-length tag)) tname))
|
|
;; a protocol/interface the type implements (defprotocol generates an
|
|
;; interface; (instance? SomeProtocol record) is true when the record
|
|
;; implements it — core.match dispatches on instance? IPatternCompile).
|
|
(type-satisfies? tag tname)
|
|
(type-satisfies? tag (last-dot tname)))))
|
|
((jreify? val) (let ((short (last-dot tname)))
|
|
;; every Clojure reify implements IObj/IMeta (carries metadata).
|
|
(or (member short '("IObj" "IMeta"))
|
|
(and (memp (lambda (p) (string=? (last-dot p) short)) (jreify-protos val)) #t))))
|
|
((ex-info-map? val) (exception-isa? (last-dot (ex-info-class val)) (last-dot tname)))
|
|
(else (case-string tname val)))))
|
|
|
|
(define (instance-check type-sym0 val)
|
|
;; a Class value as the type arg (instance? (class x) y) -> use its name string.
|
|
(let* ((type-sym (if (jclass? type-sym0) (jclass-name type-sym0) type-sym0))
|
|
(ts (if (and (string? type-sym)
|
|
(or (= 0 (string-length type-sym))
|
|
(not (char=? (string-ref type-sym 0) #\[))))
|
|
(jolt-symbol #f type-sym)
|
|
type-sym)))
|
|
(let loop ((rs instance-check-registry))
|
|
(if (null? rs)
|
|
(instance-check-base ts val)
|
|
(let ((r ((car rs) ts val)))
|
|
(if (eq? r 'pass) (loop (cdr rs)) r))))))
|
|
(define (case-string tname val)
|
|
(cond
|
|
((member tname '("Number" "java.lang.Number")) (number? val))
|
|
((member tname '("Long" "java.lang.Long" "Integer" "java.lang.Integer"))
|
|
(and (number? val) (exact? val) (integer? val)))
|
|
((member tname '("Double" "java.lang.Double" "Float" "java.lang.Float")) (and (number? val) (flonum? val)))
|
|
((member tname '("Ratio" "clojure.lang.Ratio")) (and (number? val) (exact? val) (rational? val) (not (integer? val))))
|
|
((member tname '("String" "java.lang.String" "CharSequence" "java.lang.CharSequence")) (string? val))
|
|
((member tname '("Boolean" "java.lang.Boolean")) (boolean? val))
|
|
((member tname '("Character" "java.lang.Character")) (char? val))
|
|
((member tname '("Keyword" "clojure.lang.Keyword")) (keyword? val))
|
|
((member tname '("Symbol" "clojure.lang.Symbol")) (jolt-symbol? val))
|
|
((member tname '("Atom" "clojure.lang.Atom")) (jolt-atom? val))
|
|
((member tname '("IFn" "clojure.lang.IFn" "Fn" "clojure.lang.Fn")) (procedure? val))
|
|
((member tname '("Pattern" "java.util.regex.Pattern")) (regex-t? val))
|
|
((member tname '("URI" "java.net.URI"))
|
|
(and (jhost? val) (string=? (jhost-tag val) "uri")))
|
|
((member tname '("File" "java.io.File")) (jfile? val))
|
|
((member tname '("UUID" "java.util.UUID")) (juuid? val))
|
|
(else #f)))
|
|
|
|
;; str of a record uses a custom (Object toString) impl if the type defines one
|
|
;; (deftype with no default toString relies on this); otherwise the map form
|
|
;; without the leading # (Clojure's record .toString). converters.ss loads before
|
|
;; records.ss, so this set! sees the registry — forward refs resolve at call time.
|
|
|
|
(def-var! "clojure.core" "instance-check" instance-check)
|