diff --git a/docs/MODULES.md b/docs/MODULES.md index 2cf3b33..304aeff 100644 --- a/docs/MODULES.md +++ b/docs/MODULES.md @@ -26,10 +26,10 @@ composed and where a given `.ss` fits. - **Value model**: `values.ss` (nil/numbers/keywords/symbols), `collections.ss` (persistent vec + HAMT map/set), `seq.ss` + `lazy-bridge.ss` (seqs, lazy-seqs), `transients.ss`, `records.ss` + `records-interop.ss`. -- **Native `clojure.core` shims**: `natives-*.ss` (array/coll/meta/misc/num/parity/ - queue/seq/str/xform), plus `predicates.ss`, `converters.ss`, `printing.ss`. +- **Native `clojure.core` shims**: `natives-*.ss` (array/coll/format/meta/misc/num/ + queue/reader/seq/str/transduce), plus `predicates.ss`, `converters.ss`, `printing.ss`. - **Vars / namespaces / dynamics**: `vars.ss`, `ns.ss`, `dyn-binding.ss` (the - thread-local binding stack), `dynamic-vars.ss` (a few `*…*` constant defaults), + thread-local binding stack), `dynamic-var-defaults.ss` (a few `*…*` constant defaults), `atoms.ss`, `multimethods.ss`. - **Host interop**: `host-class.ss` (class tokens + method dispatch), `host-static.ss` (interop registry core) + `host-static-methods.ss` (`Class/member` diff --git a/host/chez/dynamic-vars.ss b/host/chez/dynamic-var-defaults.ss similarity index 70% rename from host/chez/dynamic-vars.ss rename to host/chez/dynamic-var-defaults.ss index 6718e39..8fc26ac 100644 --- a/host/chez/dynamic-vars.ss +++ b/host/chez/dynamic-var-defaults.ss @@ -1,6 +1,8 @@ -;; dynamic vars — the handful of clojure.core dynamic vars that aren't emitted into -;; the prelude. These two are plain constants; *ns* (a namespace object) needs a -;; value type with get-see-through and map?=false and is tracked separately. Loaded +;; dynamic-var-defaults.ss — default values for the handful of clojure.core dynamic +;; vars that aren't emitted into the prelude (*clojure-version*, *assert*, …). Plain +;; constant def-var!s; *ns* (a namespace object) needs a value type with +;; get-see-through and map?=false and is tracked separately. The binding-stack +;; machinery (binding / var-set / thread-bound?) lives in dyn-binding.ss. Loaded ;; from rt.ss after the value model + def-var!. ;; *clojure-version* — a map {:major 1 :minor 11 :incremental 0 :qualifier nil}. diff --git a/host/chez/natives-format.ss b/host/chez/natives-format.ss new file mode 100644 index 0000000..0334b4e --- /dev/null +++ b/host/chez/natives-format.ss @@ -0,0 +1,62 @@ +;; natives-format.ss — a small %-format engine for clojure.core `format` over the +;; all-flonum number model: %d (integer), %s (str), %f / %.Nf (fixed-point), %x/%X +;; (hex int), %o (octal), %c (char int), %b (boolean), %% (literal). Enough for the +;; corpus, not the full Java Formatter spec. Loaded after natives-misc.ss (uses +;; jolt-str-render-one via converters + jolt-truthy?). + +(define (->long x) (exact (truncate x))) +(define (pad-left s n c) (if (fx>=? (string-length s) n) s (string-append (make-string (fx- n (string-length s)) c) s))) +(define (fmt-float x prec) + (let* ((neg (< x 0)) (ax (abs x)) + (scale (expt 10 prec)) + (scaled (round (* (inexact ax) scale))) + (i (exact (truncate (/ scaled scale)))) + (frac (exact (truncate (- scaled (* i scale)))))) + (string-append (if neg "-" "") + (number->string i) + (if (fx>? prec 0) (string-append "." (pad-left (number->string frac) prec #\0)) "")))) +(define (jolt-format fmt . args) + (let ((out (open-output-string))) + (let loop ((i 0) (as args)) + (if (fx>=? i (string-length fmt)) + (get-output-string out) + (let ((c (string-ref fmt i))) + (if (char=? c #\%) + ;; parse a directive: %[-][0][width][.prec]conv + (let scan ((j (fx+ i 1)) (left #f) (zero #f) (width #f) (prec #f) (seen-dot #f)) + (let ((d (string-ref fmt j))) + (cond + ((char=? d #\%) (write-char #\% out) (loop (fx+ j 1) as)) + ((and (not seen-dot) (not width) (char=? d #\-)) + (scan (fx+ j 1) #t zero width prec seen-dot)) + ((and (not seen-dot) (not width) (char=? d #\0)) + (scan (fx+ j 1) left #t width prec seen-dot)) + ((char=? d #\.) (scan (fx+ j 1) left zero width 0 #t)) + ((and (char>=? d #\0) (char<=? d #\9)) + (if seen-dot + (scan (fx+ j 1) left zero width (fx+ (fx* (or prec 0) 10) (fx- (char->integer d) 48)) seen-dot) + (scan (fx+ j 1) left zero (fx+ (fx* (or width 0) 10) (fx- (char->integer d) 48)) prec seen-dot))) + (else + (let* ((a (if (null? as) jolt-nil (car as))) + (rest (if (null? as) '() (cdr as))) + (s (case d + ((#\d) (number->string (->long a))) + ((#\s) (jolt-str-render-one a)) + ((#\f) (fmt-float a (or prec 6))) + ((#\x) (number->string (->long a) 16)) + ((#\X) (string-upcase (number->string (->long a) 16))) + ((#\o) (number->string (->long a) 8)) + ((#\b) (if (jolt-truthy? a) "true" "false")) + ((#\c) (string (integer->char (->long a)))) + (else (string #\% d)))) + ;; pad to width: left-justify with spaces, else right-justify + ;; (zero-pad only a right-justified number). + (s (if (and width (fxlong x) (exact (truncate x))) -(define (pad-left s n c) (if (fx>=? (string-length s) n) s (string-append (make-string (fx- n (string-length s)) c) s))) -(define (fmt-float x prec) - (let* ((neg (< x 0)) (ax (abs x)) - (scale (expt 10 prec)) - (scaled (round (* (inexact ax) scale))) - (i (exact (truncate (/ scaled scale)))) - (frac (exact (truncate (- scaled (* i scale)))))) - (string-append (if neg "-" "") - (number->string i) - (if (fx>? prec 0) (string-append "." (pad-left (number->string frac) prec #\0)) "")))) -(define (jolt-format fmt . args) - (let ((out (open-output-string))) - (let loop ((i 0) (as args)) - (if (fx>=? i (string-length fmt)) - (get-output-string out) - (let ((c (string-ref fmt i))) - (if (char=? c #\%) - ;; parse a directive: %[-][0][width][.prec]conv - (let scan ((j (fx+ i 1)) (left #f) (zero #f) (width #f) (prec #f) (seen-dot #f)) - (let ((d (string-ref fmt j))) - (cond - ((char=? d #\%) (write-char #\% out) (loop (fx+ j 1) as)) - ((and (not seen-dot) (not width) (char=? d #\-)) - (scan (fx+ j 1) #t zero width prec seen-dot)) - ((and (not seen-dot) (not width) (char=? d #\0)) - (scan (fx+ j 1) left #t width prec seen-dot)) - ((char=? d #\.) (scan (fx+ j 1) left zero width 0 #t)) - ((and (char>=? d #\0) (char<=? d #\9)) - (if seen-dot - (scan (fx+ j 1) left zero width (fx+ (fx* (or prec 0) 10) (fx- (char->integer d) 48)) seen-dot) - (scan (fx+ j 1) left zero (fx+ (fx* (or width 0) 10) (fx- (char->integer d) 48)) prec seen-dot))) - (else - (let* ((a (if (null? as) jolt-nil (car as))) - (rest (if (null? as) '() (cdr as))) - (s (case d - ((#\d) (number->string (->long a))) - ((#\s) (jolt-str-render-one a)) - ((#\f) (fmt-float a (or prec 6))) - ((#\x) (number->string (->long a) 16)) - ((#\X) (string-upcase (number->string (->long a) 16))) - ((#\o) (number->string (->long a) 8)) - ((#\b) (if (jolt-truthy? a) "true" "false")) - ((#\c) (string (integer->char (->long a)))) - (else (string #\% d)))) - ;; pad to width: left-justify with spaces, else right-justify - ;; (zero-pad only a right-justified number). - (s (if (and width (fx