From 1dcd4678e8d3feaa306eebf77442b4b264ea0a77 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 23 Jun 2026 01:42:33 -0400 Subject: [PATCH] Deduplicate small host helpers - str-join delegates to str-join-strs (it only adds the per-element render). - loader: extract resolve-on-roots; find-ns-file and load both use it. - NumberFormat registers its short + FQ names from one shared member list. - inst-time's private floor-div/floor-mod renamed inst-floor-* so they don't read as the math.ss reals version. Left the fold/inline/types pure-fn sets and the keyword/symbol ns builders alone: those are file-local and semantically distinct (e.g. the intern key uses NUL, not "/"), so merging them would be wrong. --- host/chez/host-static.ss | 13 +++++-------- host/chez/inst-time.ss | 12 ++++++------ host/chez/loader.ss | 33 +++++++++++++++------------------ host/chez/natives-str.ss | 9 +++------ 4 files changed, 29 insertions(+), 38 deletions(-) diff --git a/host/chez/host-static.ss b/host/chez/host-static.ss index a71889d..18d5da4 100644 --- a/host/chez/host-static.ss +++ b/host/chez/host-static.ss @@ -328,14 +328,11 @@ (cons "setMaximumFractionDigits" (lambda (self d) (vector-set! (jhost-state self) 2 (jnum->exact d)) jolt-nil)) (cons "setMinimumFractionDigits" (lambda (self d) (vector-set! (jhost-state self) 1 (jnum->exact d)) jolt-nil)) (cons "setGroupingUsed" (lambda (self b) (vector-set! (jhost-state self) 0 (jolt-truthy? b)) jolt-nil)))) -(register-class-statics! "NumberFormat" - (list (cons "getInstance" (lambda _ (nf-make #t 0 3))) - (cons "getNumberInstance" (lambda _ (nf-make #t 0 3))) - (cons "getIntegerInstance" (lambda _ (nf-make #t 0 0))))) -(register-class-statics! "java.text.NumberFormat" - (list (cons "getInstance" (lambda _ (nf-make #t 0 3))) - (cons "getNumberInstance" (lambda _ (nf-make #t 0 3))) - (cons "getIntegerInstance" (lambda _ (nf-make #t 0 0))))) +(let ((nf-statics (list (cons "getInstance" (lambda _ (nf-make #t 0 3))) + (cons "getNumberInstance" (lambda _ (nf-make #t 0 3))) + (cons "getIntegerInstance" (lambda _ (nf-make #t 0 0)))))) + (register-class-statics! "NumberFormat" nf-statics) + (register-class-statics! "java.text.NumberFormat" nf-statics)) (register-class-statics! "Class" ;; an array descriptor ("[C", "[I", …) is its own class token (so instance? and diff --git a/host/chez/inst-time.ss b/host/chez/inst-time.ss index ec2cb1b..e14899b 100644 --- a/host/chez/inst-time.ss +++ b/host/chez/inst-time.ss @@ -93,16 +93,16 @@ (define (pad2 n) (if (< n 10) (string-append "0" (number->string n)) (number->string n))) (define (pad4 n) (let ((s (number->string n))) (string-append (make-string (max 0 (- 4 (string-length s))) #\0) s))) (define (pad3 n) (let ((s (number->string n))) (string-append (make-string (max 0 (- 3 (string-length s))) #\0) s))) -(define (floor-div a b) (let ((q (quotient a b)) (r (remainder a b))) (if (and (not (= r 0)) (< (* a b) 0)) (- q 1) q))) -(define (floor-mod a b) (- a (* (floor-div a b) b))) +(define (inst-floor-div a b) (let ((q (quotient a b)) (r (remainder a b))) (if (and (not (= r 0)) (< (* a b) 0)) (- q 1) q))) +(define (inst-floor-mod a b) (- a (* (inst-floor-div a b) b))) (define (inst-fields ms) ; -> list (y mo d hh mm ss frac dow) - (let* ((total-s (floor-div (exact (truncate ms)) 1000)) + (let* ((total-s (inst-floor-div (exact (truncate ms)) 1000)) (frac (- (exact (truncate ms)) (* total-s 1000))) - (days (floor-div total-s 86400)) - (sod (floor-mod total-s 86400)) + (days (inst-floor-div total-s 86400)) + (sod (inst-floor-mod total-s 86400)) (hh (quotient sod 3600)) (mm (quotient (remainder sod 3600) 60)) (ss (remainder sod 60)) - (dow (floor-mod (+ days 4) 7))) ; 1970-01-01 = Thursday; 0=Sunday + (dow (inst-floor-mod (+ days 4) 7))) ; 1970-01-01 = Thursday; 0=Sunday (call-with-values (lambda () (civil-from-days days)) (lambda (y mo d) (list y mo d hh mm ss frac dow))))) diff --git a/host/chez/loader.ss b/host/chez/loader.ss index a0087b9..1e8b75c 100644 --- a/host/chez/loader.ss +++ b/host/chez/loader.ss @@ -35,15 +35,17 @@ (loop (cdr cs) '() (cons (list->string (reverse seg)) segs))) (else (loop (cdr cs) (cons (car cs) seg) segs))))) -(define (find-ns-file name) - (let ((rel (ns-name->rel name))) - (let loop ((roots source-roots)) - (if (null? roots) #f - (let ((clj (string-append (car roots) "/" rel ".clj")) - (cljc (string-append (car roots) "/" rel ".cljc"))) - (cond ((file-exists? clj) clj) - ((file-exists? cljc) cljc) - (else (loop (cdr roots))))))))) +;; First existing /rel.clj or /rel.cljc on the search roots, else #f. +(define (resolve-on-roots rel) + (let loop ((roots source-roots)) + (if (null? roots) #f + (let ((clj (string-append (car roots) "/" rel ".clj")) + (cljc (string-append (car roots) "/" rel ".cljc"))) + (cond ((file-exists? clj) clj) + ((file-exists? cljc) cljc) + (else (loop (cdr roots)))))))) + +(define (find-ns-file name) (resolve-on-roots (ns-name->rel name))) ;; --- the loaded set --------------------------------------------------------- ;; Seeded with every namespace that already has vars at load time — the baked @@ -170,15 +172,10 @@ (for-each (lambda (p) (let* ((rel (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/)) - (substring p 1 (string-length p)) p))) - (let loop ((roots source-roots)) - (if (null? roots) - (error #f "Could not locate resource on source roots" p) - (let ((clj (string-append (car roots) "/" rel ".clj")) - (cljc (string-append (car roots) "/" rel ".cljc"))) - (cond ((file-exists? clj) (load-jolt-file clj)) - ((file-exists? cljc) (load-jolt-file cljc)) - (else (loop (cdr roots))))))))) + (substring p 1 (string-length p)) p)) + (f (resolve-on-roots rel))) + (if f (load-jolt-file f) + (error #f "Could not locate resource on source roots" p)))) paths) jolt-nil) (def-var! "clojure.core" "load" jolt-load) diff --git a/host/chez/natives-str.ss b/host/chez/natives-str.ss index f5c34c6..58f182f 100644 --- a/host/chez/natives-str.ss +++ b/host/chez/natives-str.ss @@ -196,13 +196,10 @@ (if (fx stringify each element (Clojure str), join by sep. +;; str-join-strs (defined below) does the join; here we just render each element. (define (str-join coll . opt) - (let ((sep (if (pair? opt) (jolt-str-render-one (car opt)) "")) - (items (map jolt-str-render-one (seq->list coll)))) - (let loop ((xs items) (first #t) (acc '())) - (cond ((null? xs) (apply string-append (reverse acc))) - (first (loop (cdr xs) #f (cons (car xs) acc))) - (else (loop (cdr xs) #f (cons (car xs) (cons sep acc)))))))) + (let ((sep (if (pair? opt) (jolt-str-render-one (car opt)) ""))) + (str-join-strs (map jolt-str-render-one (seq->list coll)) sep))) ;; (re-split irx s limit) -> parts, splitting at each match. Keeps interior AND ;; trailing empty strings (the clojure.string wrapper drops trailing for limit 0);