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.
This commit is contained in:
Yogthos 2026-06-23 01:42:33 -04:00
parent 14547bd1d5
commit 1dcd4678e8
4 changed files with 29 additions and 38 deletions

View file

@ -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)))))