real BigDecimal type (bigdec, M literals)

bigdec / 1.5M / 0.0M silently produced doubles. Add a jbigdec value type
{unscaled, scale} over Chez exact integers (host/chez/bigdec.ss): value =
unscaled * 10^-scale. An M-suffix literal reads to a :bigdec form that the back
end lowers to jolt-bigdec-from-string (same IR-leaf path as #inst/#uuid); bigdec
coerces a number/string. Equality is by value (1.0M = 1.00M true, 3M = 3 false),
str drops the M and pr keeps it, class is java.math.BigDecimal, decimal? is true.
Arithmetic contagion isn't modelled (out of scope). The old corpus cases passed
spuriously as doubles; they now exercise a genuine BigDecimal.
This commit is contained in:
Yogthos 2026-06-22 00:01:01 -04:00
parent 7db5fabc8d
commit ab96650fbb
10 changed files with 288 additions and 191 deletions

83
host/chez/bigdec.ss Normal file
View file

@ -0,0 +1,83 @@
;; BigDecimal (jolt-i2jm). A jbigdec is {unscaled, scale} over Chez arbitrary-
;; precision exact integers; its value is unscaled * 10^-scale (1.5M = {15,1},
;; 1.00M = {100,2}, 3M = {3,0}). M-suffix literals read to a :bigdec form that the
;; back end lowers to jolt-bigdec-from-string; bigdec coerces a number/string.
;; Equality is by value (1.0M = 1.00M), str drops the M, pr keeps it, class is
;; java.math.BigDecimal. Arithmetic contagion is not modelled (jolt-i2jm scope).
(define-record-type jbigdec (fields unscaled scale) (nongenerative chez-jbigdec-v1))
(define (bd-index-char s ch)
(let loop ((i 0))
(cond ((>= i (string-length s)) #f)
((char=? (string-ref s i) ch) i)
(else (loop (+ i 1))))))
;; "1.50" -> {150,2}; "3" -> {3,0}; "-0.0" -> {0,1}; ".5" -> {5,1}.
(define (jolt-bigdec-from-string s)
(let* ((neg (and (> (string-length s) 0) (char=? (string-ref s 0) #\-)))
(sgn (and (> (string-length s) 0) (or neg (char=? (string-ref s 0) #\+))))
(s1 (if sgn (substring s 1 (string-length s)) s))
(sign (if neg -1 1))
(dot (bd-index-char s1 #\.)))
(if dot
(let* ((intp (substring s1 0 dot))
(fracp (substring s1 (+ dot 1) (string-length s1)))
(digs (string-append intp fracp))
(unscaled (if (= 0 (string-length digs)) 0 (string->number digs))))
(make-jbigdec (* sign unscaled) (string-length fracp)))
(make-jbigdec (* sign (string->number s1)) 0))))
;; bigdec coercion: a bigdec is itself; an exact integer keeps scale 0; a string
;; or any other number routes through its decimal text.
(define (jolt-bigdec x)
(cond
((jbigdec? x) x)
((and (number? x) (exact? x) (integer? x)) (make-jbigdec x 0))
((string? x) (jolt-bigdec-from-string x))
((number? x) (jolt-bigdec-from-string (jolt-num->string x)))
(else (error #f "bigdec: cannot coerce" x))))
;; value equality: unscaled_a * 10^scale_b == unscaled_b * 10^scale_a.
(define (jbigdec=? a b)
(= (* (jbigdec-unscaled a) (expt 10 (jbigdec-scale b)))
(* (jbigdec-unscaled b) (expt 10 (jbigdec-scale a)))))
;; render the decimal text (no M): insert the point `scale` digits from the right.
(define (jbigdec->string bd)
(let* ((u (jbigdec-unscaled bd)) (sc (jbigdec-scale bd))
(neg (< u 0)) (digs (number->string (abs u))))
(string-append
(if neg "-" "")
(if (<= sc 0)
digs
(let* ((padded (if (<= (string-length digs) sc)
(string-append (make-string (- (+ sc 1) (string-length digs)) #\0) digs)
digs))
(pl (string-length padded)))
(string-append (substring padded 0 (- pl sc)) "." (substring padded (- pl sc) pl)))))))
;; --- wire into the value model ----------------------------------------------
(def-var! "clojure.core" "bigdec" jolt-bigdec)
;; equality: a bigdec equals only another bigdec, by value (matching (= 3M 3) = false).
(define %bd-jolt=2 jolt=2)
(set! jolt=2 (lambda (a b)
(cond ((and (jbigdec? a) (jbigdec? b)) (jbigdec=? a b))
((or (jbigdec? a) (jbigdec? b)) #f)
(else (%bd-jolt=2 a b)))))
;; str drops the M; pr/pr-str keep it.
(define %bd-str-render jolt-str-render-one)
(set! jolt-str-render-one (lambda (x) (if (jbigdec? x) (jbigdec->string x) (%bd-str-render x))))
(define %bd-pr-str jolt-pr-str)
(set! jolt-pr-str (lambda (x) (if (jbigdec? x) (string-append (jbigdec->string x) "M") (%bd-pr-str x))))
(define %bd-pr-readable jolt-pr-readable)
(set! jolt-pr-readable (lambda (x) (if (jbigdec? x) (string-append (jbigdec->string x) "M") (%bd-pr-readable x))))
;; class / decimal?
(define %bd-class jolt-class)
(set! jolt-class (lambda (x) (if (jbigdec? x) "java.math.BigDecimal" (%bd-class x))))
(def-var! "clojure.core" "class" jolt-class)
(set! jolt-decimal? (lambda (x) (jbigdec? x)))
(def-var! "clojure.core" "decimal?" jolt-decimal?)

View file

@ -35,6 +35,7 @@
(define hc-kw-regex (keyword #f "regex")) (define hc-kw-regex (keyword #f "regex"))
(define hc-kw-inst (keyword #f "#inst")) (define hc-kw-inst (keyword #f "#inst"))
(define hc-kw-uuid (keyword #f "#uuid")) (define hc-kw-uuid (keyword #f "#uuid"))
(define hc-kw-bigdec (keyword #f "bigdec"))
;; --- form predicates -------------------------------------------------------- ;; --- form predicates --------------------------------------------------------
(define (hc-sym? x) (symbol-t? x)) (define (hc-sym? x) (symbol-t? x))
@ -62,6 +63,8 @@
(define (hc-regex? x) (hc-tagged-of x hc-kw-regex)) (define (hc-regex? x) (hc-tagged-of x hc-kw-regex))
(define (hc-inst? x) (hc-tagged-of x hc-kw-inst)) (define (hc-inst? x) (hc-tagged-of x hc-kw-inst))
(define (hc-uuid? x) (hc-tagged-of x hc-kw-uuid)) (define (hc-uuid? x) (hc-tagged-of x hc-kw-uuid))
(define (hc-bigdec? x) (hc-tagged-of x hc-kw-bigdec))
(define (hc-bigdec-source x) (jolt-get x hc-kw-form))
;; A live namespace value spliced into a form (e.g. `(str ~*ns*) in a macro): ;; A live namespace value spliced into a form (e.g. `(str ~*ns*) in a macro):
;; the analyzer can't carry an opaque runtime value, so recognize a jns and ;; the analyzer can't carry an opaque runtime value, so recognize a jns and
;; reconstruct it by name at the call site (jolt-8sha). ;; reconstruct it by name at the call site (jolt-8sha).
@ -299,6 +302,8 @@
(def-var! "jolt.host" "form-uuid?" hc-uuid?) (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?" hc-ns-value?)
(def-var! "jolt.host" "form-ns-value-name" hc-ns-value-name) (def-var! "jolt.host" "form-ns-value-name" hc-ns-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) (def-var! "jolt.host" "form-elements" hc-elements)
(def-var! "jolt.host" "form-vec-items" hc-vec-items) (def-var! "jolt.host" "form-vec-items" hc-vec-items)
(def-var! "jolt.host" "form-set-items" hc-set-items) (def-var! "jolt.host" "form-set-items" hc-set-items)

View file

@ -134,10 +134,12 @@
((and (> blen 1) (char=? (string-ref body (- blen 1)) #\N)) ((and (> blen 1) (char=? (string-ref body (- blen 1)) #\N))
(let ((n (string->number (substring body 0 (- blen 1))))) (let ((n (string->number (substring body 0 (- blen 1)))))
(and n (integer? n) (* sign n)))) (and n (integer? n) (* sign n))))
;; bigdecimal suffix M -> double ;; bigdecimal suffix M -> a :bigdec form carrying the numeric text; the back
;; end lowers it to a runtime jbigdec (jolt-i2jm).
((and (> blen 1) (char=? (string-ref body (- blen 1)) #\M)) ((and (> blen 1) (char=? (string-ref body (- blen 1)) #\M))
(let ((n (string->number (substring body 0 (- blen 1))))) (let ((n (string->number (substring body 0 (- blen 1)))))
(and n (exact->inexact (* sign n))))) (and n (real? n)
(rdr-make-tagged (keyword #f "bigdec") (substring tok 0 (- len 1))))))
(else (else
(let ((n (string->number tok))) ; tok carries its own sign (let ((n (string->number tok))) ; tok carries its own sign
;; keep exactness: "42" -> exact int, "3.14"/"1e3" -> flonum. ;; keep exactness: "42" -> exact int, "3.14"/"1e3" -> flonum.

View file

@ -347,3 +347,8 @@
;; thread macros, def-var!'d into clojure.core.async. After concurrency.ss (reuses ;; thread macros, def-var!'d into clojure.core.async. After concurrency.ss (reuses
;; ms->duration) and the collection/seq layer. ;; ms->duration) and the collection/seq layer.
(load "host/chez/async.ss") (load "host/chez/async.ss")
;; BigDecimal (jolt-i2jm): the jbigdec value type + bigdec/decimal?/class/equality/
;; printing. Loads LAST so its set!-wraps of jolt-class/jolt=2/the printers sit
;; outermost over every earlier extension.
(load "host/chez/bigdec.ss")

View file

@ -90,7 +90,6 @@
"type of record" "chunked-seq? always false" "type of record" "chunked-seq? always false"
"close on throw" "macroexpand-1" "close on throw" "macroexpand-1"
"bean is the map" "proxy resolves nil" "bean is the map" "proxy resolves nil"
"bigdec" "bigdec int M" "bigdec suffix M"
"transient vector" "transient map" "transient vector" "transient map"
"atom override fires nested" "atom override fires nested"
"reader conditional" "reader cond :jolt" "reader cond no match" "reader conditional" "reader cond :jolt" "reader cond no match"

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

View file

@ -798,8 +798,7 @@
(defn clojure-version [] "1.11.0-jolt") (defn clojure-version [] "1.11.0-jolt")
;; Jolt numbers are doubles; no BigDecimal, no ratios. ;; bigdec is a host fn (host/chez/bigdec.ss) — a real BigDecimal value type.
(defn bigdec [x] (* 1.0 x))
(defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {}))) (defn numerator [x] (throw (ex-info "numerator requires a ratio (Jolt has no ratios)" {})))
(defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {}))) (defn denominator [x] (throw (ex-info "denominator requires a ratio (Jolt has no ratios)" {})))

View file

@ -23,6 +23,7 @@
form-map-pairs form-set-items form-special? compile-ns form-map-pairs form-set-items form-special? compile-ns
form-regex? form-regex-source form-regex? form-regex-source
form-inst? form-inst-source form-uuid? form-uuid-source form-inst? form-inst-source form-uuid? form-uuid-source
form-bigdec? form-bigdec-source
form-ns-value? form-ns-value-name form-ns-value? form-ns-value-name
form-macro? form-expand-1 resolve-global form-macro? form-expand-1 resolve-global
form-sym-meta host-intern! form-syntax-quote-lower form-sym-meta host-intern! form-syntax-quote-lower
@ -463,6 +464,9 @@
;; end emits a runtime inst/uuid value (host/chez/inst-time.ss). ;; end emits a runtime inst/uuid value (host/chez/inst-time.ss).
(form-inst? form) {:op :inst :source (form-inst-source form)} (form-inst? form) {:op :inst :source (form-inst-source form)}
(form-uuid? form) {:op :uuid :source (form-uuid-source form)} (form-uuid? form) {:op :uuid :source (form-uuid-source form)}
;; bigdecimal literal (1.5M) -> a :bigdec leaf; the back end emits a runtime
;; jbigdec built from the numeric text.
(form-bigdec? form) {:op :bigdec :source (form-bigdec-source form)}
;; a live namespace value spliced into a form (~*ns* in a macro) -> a ;; 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. ;; :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)} (form-ns-value? form) {:op :the-ns :name (form-ns-value-name form)}

View file

@ -404,6 +404,8 @@
;; #inst / #uuid literals -> runtime inst / uuid values. ;; #inst / #uuid literals -> runtime inst / uuid values.
:inst (str "(jolt-inst-from-string " (chez-str-lit (:source node)) ")") :inst (str "(jolt-inst-from-string " (chez-str-lit (:source node)) ")")
:uuid (str "(jolt-uuid-from-string " (chez-str-lit (:source node)) ")") :uuid (str "(jolt-uuid-from-string " (chez-str-lit (:source node)) ")")
;; bigdecimal literal (1.5M) -> a runtime jbigdec from its numeric text.
:bigdec (str "(jolt-bigdec-from-string " (chez-str-lit (:source node)) ")")
;; a namespace value spliced into a form (~*ns*) -> reconstruct by name. ;; a namespace value spliced into a form (~*ns*) -> reconstruct by name.
:the-ns (str "(intern-ns! " (chez-str-lit (:name node)) ")") :the-ns (str "(intern-ns! " (chez-str-lit (:name node)) ")")
;; (.method target arg*) -> jolt-host-call for an rt-shimmed method, else ;; (.method target arg*) -> jolt-host-call for an rt-shimmed method, else