General fixes shaken out by clojure/tools.reader
Running clojure.tools.reader's own suite on jolt surfaced a batch of general gaps (all runtime, JVM-certified, no re-mint — reader.ss is loaded at runtime and jolt-core has no octal literals, so selfhost holds): Reader: - (load "rel") resolves a non-/ path against the current namespace's directory, like Clojure — (load "common_tests") from clojure.tools.reader-test loads clojure/tools/common_tests.clj. Was resolved against the roots directly. - Octal integer literals: 042 reads as 34, not decimal 42; octal string escapes (\377 is one char, not \0 + "00"). \oNNN char octal already worked. - (symbol nil name) now equals (symbol name) and the reader literal — a nil namespace is the #f no-ns sentinel, not jolt-nil (jolt= compares ns by equal?). clojure.test: - thrown-with-msg? honors the class hierarchy (instance?) before falling back to a simple-name match, so (thrown-with-msg? RuntimeException ...) matches an ExceptionInfo, like thrown? already did. Host interop (java layer): - java.util.regex: Pattern.matcher / Matcher.matches / .group / .groupCount / .find, and Pattern/compile. - clojure.lang: RT/map, PersistentList/create, PersistentHashSet/createWithCheck. - java.lang.Character: digit / isDigit / isWhitespace / valueOf. - java.util.LinkedList (Deque surface over the ArrayList backing); ArrayList / LinkedList are now seqable. - BigInteger 2-arg ctor (string, radix) + .negate / .bitLength / .signum / .abs; BigInt/fromBigInteger and Numbers/reduceBigInt (identity on jolt's exact ints). Suite: reader_test 22/30, reader-edn_test 13/16. The remaining failures are fundamental numeric-model differences (no BigDecimal type; BigInt and Long are one exact-integer type) or need JVM reflection (record/ctor tagged literals via getConstructors) — out of scope. make test green (+8 corpus rows, 0 new divergences), shakesmoke byte-identical.
This commit is contained in:
Yogthos
parent
850a84c272
commit
e16085402b
9 changed files with 217 additions and 21 deletions
|
|
@ -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).
|
||||
|
|
@ -433,8 +478,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 +617,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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue