simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Deduplicate small host helpers

Browse source 
- 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
Download patch file Download diff file Expand all files Collapse all files

11
host/chez/host-static.ss
View file

@ -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)))
(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! "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)))))
(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

12
host/chez/inst-time.ss
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)))))

21
host/chez/loader.ss
View file

@ -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)))
;; First existing <root>/rel.clj or <root>/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)))))))))
(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)

9
host/chez/natives-str.ss
View file

@ -196,13 +196,10 @@
(if (fx<? i 0) jolt-nil i)))
;; (str-join coll [sep]) -> 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);