Migrate 16 small .sls -> .ss (define and macro-only files)
ober
f81cae3a8a641e5181f69f5e271c30eae0c85d65
deleted file mode 100644 --- a/lib/std/cafe.sls +++ /dev/null @@ -1,22 +0,0 @@ -#!chezscheme -;;; (std cafe) — REPL customization -;;; -;;; Re-exports Chez's cafe (REPL) customization parameters. - -(library (std cafe) - (export waiter-prompt-string waiter-prompt-and-read - new-cafe cafe-eval reset-handler) - - (import (chezscheme)) - - ;; cafe-eval: evaluate an expression in the interaction environment - (define (cafe-eval expr) - (eval expr (interaction-environment))) - - ;; All other exports are Chez built-ins: - ;; waiter-prompt-string: parameter for prompt text - ;; waiter-prompt-and-read: parameter for custom read proc - ;; new-cafe: launch nested REPL - ;; reset-handler: parameter for reset behavior - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/cafe.ss @@ -0,0 +1,23 @@ +#!chezscheme +;;; (std cafe) — REPL customization +;;; +;;; Re-exports Chez's cafe (REPL) customization parameters. + +(library (std cafe) + (export waiter-prompt-string waiter-prompt-and-read + new-cafe cafe-eval reset-handler) + + (import (chezscheme) + (only (jerboa core) def)) + + ;; cafe-eval: evaluate an expression in the interaction environment + (def (cafe-eval expr) + (eval expr (interaction-environment))) + + ;; All other exports are Chez built-ins: + ;; waiter-prompt-string: parameter for prompt text + ;; waiter-prompt-and-read: parameter for custom read proc + ;; new-cafe: launch nested REPL + ;; reset-handler: parameter for reset behavior + +) ;; end library deleted file mode 100644 --- a/lib/std/compress/zlib.sls +++ /dev/null @@ -1,31 +0,0 @@ -#!chezscheme -;;; :std/compress/zlib -- Compression (wraps chez-zlib) -;;; Requires: chez_zlib_shim.so (zlib) - -(library (std compress zlib) - (export - gzip-bytevector gunzip-bytevector - deflate-bytevector inflate-bytevector - gzip-data? - safe-gunzip-bytevector safe-inflate-bytevector - *zlib-max-decompressed-size*) - - (import (chezscheme) (chez-zlib)) - - (define *zlib-max-decompressed-size* (make-parameter (* 100 1024 1024))) ;; 100MB - - (define (safe-gunzip-bytevector bv) - (let ((result (gunzip-bytevector bv))) - (when (> (bytevector-length result) (*zlib-max-decompressed-size*)) - (error 'safe-gunzip-bytevector "decompressed size exceeds limit" - (bytevector-length result) (*zlib-max-decompressed-size*))) - result)) - - (define (safe-inflate-bytevector bv) - (let ((result (inflate-bytevector bv))) - (when (> (bytevector-length result) (*zlib-max-decompressed-size*)) - (error 'safe-inflate-bytevector "decompressed size exceeds limit" - (bytevector-length result) (*zlib-max-decompressed-size*))) - result)) - - ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/compress/zlib.ss @@ -0,0 +1,32 @@ +#!chezscheme +;;; :std/compress/zlib -- Compression (wraps chez-zlib) +;;; Requires: chez_zlib_shim.so (zlib) + +(library (std compress zlib) + (export + gzip-bytevector gunzip-bytevector + deflate-bytevector inflate-bytevector + gzip-data? + safe-gunzip-bytevector safe-inflate-bytevector + *zlib-max-decompressed-size*) + + (import (chezscheme) (chez-zlib) + (only (jerboa core) def)) + + (def *zlib-max-decompressed-size* (make-parameter (* 100 1024 1024))) ;; 100MB + + (def (safe-gunzip-bytevector bv) + (let ([result (gunzip-bytevector bv)]) + (when (> (bytevector-length result) (*zlib-max-decompressed-size*)) + (error 'safe-gunzip-bytevector "decompressed size exceeds limit" + (bytevector-length result) (*zlib-max-decompressed-size*))) + result)) + + (def (safe-inflate-bytevector bv) + (let ([result (inflate-bytevector bv)]) + (when (> (bytevector-length result) (*zlib-max-decompressed-size*)) + (error 'safe-inflate-bytevector "decompressed size exceeds limit" + (bytevector-length result) (*zlib-max-decompressed-size*))) + result)) + + ) ;; end library deleted file mode 100644 --- a/lib/std/crypto/compare.sls +++ /dev/null @@ -1,34 +0,0 @@ -#!chezscheme -;;; (std crypto compare) — Timing-safe comparison for secret material -;;; -;;; string=? and equal? short-circuit on first difference, leaking -;;; information via timing side channels. These functions always examine -;;; every byte, preventing timing attacks on password hashes, HMAC -;;; verification, API keys, and session tokens. - -(library (std crypto compare) - (export timing-safe-equal? timing-safe-string=?) - - (import (chezscheme)) - - (define (timing-safe-equal? a b) - ;; Constant-time bytevector comparison. - ;; Returns #t iff A and B have the same length and contents. - ;; Always examines every byte — no early exit on mismatch. - (let ([alen (bytevector-length a)] - [blen (bytevector-length b)]) - (if (not (= alen blen)) - #f - (let loop ([i 0] [acc 0]) - (if (>= i alen) - (zero? acc) - (loop (+ i 1) - (bitwise-ior acc - (bitwise-xor (bytevector-u8-ref a i) - (bytevector-u8-ref b i))))))))) - - (define (timing-safe-string=? a b) - ;; Constant-time string comparison via UTF-8 encoding. - (timing-safe-equal? (string->utf8 a) (string->utf8 b))) - - ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/crypto/compare.ss @@ -0,0 +1,35 @@ +#!chezscheme +;;; (std crypto compare) — Timing-safe comparison for secret material +;;; +;;; string=? and equal? short-circuit on first difference, leaking +;;; information via timing side channels. These functions always examine +;;; every byte, preventing timing attacks on password hashes, HMAC +;;; verification, API keys, and session tokens. + +(library (std crypto compare) + (export timing-safe-equal? timing-safe-string=?) + + (import (chezscheme) + (only (jerboa core) def)) + + (def (timing-safe-equal? a b) + ;; Constant-time bytevector comparison. + ;; Returns #t iff A and B have the same length and contents. + ;; Always examines every byte — no early exit on mismatch. + (let ([alen (bytevector-length a)] + [blen (bytevector-length b)]) + (if (not (= alen blen)) + #f + (let loop ([i 0] [acc 0]) + (if (>= i alen) + (zero? acc) + (loop (+ i 1) + (bitwise-ior acc + (bitwise-xor (bytevector-u8-ref a i) + (bytevector-u8-ref b i))))))))) + + (def (timing-safe-string=? a b) + ;; Constant-time string comparison via UTF-8 encoding. + (timing-safe-equal? (string->utf8 a) (string->utf8 b))) + + ) ;; end library deleted file mode 100644 --- a/lib/std/guardian.sls +++ /dev/null @@ -1,44 +0,0 @@ -#!chezscheme -;;; (std guardian) — GC Guardian for resource cleanup -;;; -;;; Wraps Chez's guardian system for GC-triggered finalization. -;;; Register objects for cleanup; poll guardians to reclaim resources. - -(library (std guardian) - (export make-guardian guardian-register! guardian-drain! - with-guardian) - - (import (chezscheme)) - - ;; Re-export Chez's make-guardian (returns a guardian procedure) - ;; Guardian usage: - ;; (define g (make-guardian)) - ;; (g obj) ; register obj - ;; (g) ; retrieve one collected obj, or #f - - ;; Register an object with a guardian - (define (guardian-register! guardian obj) - (guardian obj)) - - ;; Drain all collected objects from a guardian, call finalizer on each - (define (guardian-drain! guardian finalizer) - (let loop () - (let ([obj (guardian)]) - (when obj - (finalizer obj) - (loop))))) - - ;; Create a guardian, register obj, and ensure cleanup runs on GC - ;; Returns the object so it can be used - (define (with-guardian obj finalizer) - (let ([g (make-guardian)]) - (g obj) - ;; Register a collect-request handler to drain - (collect-request-handler - (let ([old (collect-request-handler)]) - (lambda () - (old) - (guardian-drain! g finalizer)))) - obj)) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/guardian.ss @@ -0,0 +1,45 @@ +#!chezscheme +;;; (std guardian) — GC Guardian for resource cleanup +;;; +;;; Wraps Chez's guardian system for GC-triggered finalization. +;;; Register objects for cleanup; poll guardians to reclaim resources. + +(library (std guardian) + (export make-guardian guardian-register! guardian-drain! + with-guardian) + + (import (chezscheme) + (only (jerboa core) def)) + + ;; Re-export Chez's make-guardian (returns a guardian procedure) + ;; Guardian usage: + ;; (define g (make-guardian)) + ;; (g obj) ; register obj + ;; (g) ; retrieve one collected obj, or #f + + ;; Register an object with a guardian + (def (guardian-register! guardian obj) + (guardian obj)) + + ;; Drain all collected objects from a guardian, call finalizer on each + (def (guardian-drain! guardian finalizer) + (let loop () + (let ([obj (guardian)]) + (when obj + (finalizer obj) + (loop))))) + + ;; Create a guardian, register obj, and ensure cleanup runs on GC + ;; Returns the object so it can be used + (def (with-guardian obj finalizer) + (let ([g (make-guardian)]) + (g obj) + ;; Register a collect-request handler to drain + (collect-request-handler + (let ([old (collect-request-handler)]) + (lambda () + (old) + (guardian-drain! g finalizer)))) + obj)) + +) ;; end library deleted file mode 100644 --- a/lib/std/misc/cont-marks.sls +++ /dev/null @@ -1,43 +0,0 @@ -#!chezscheme -;;; (std misc cont-marks) — Continuation marks (SRFI 157-style API) -;;; -;;; Provides SRFI 157-compatible names on top of Chez Scheme's native -;;; continuation mark support (with-continuation-mark, current-continuation-marks, -;;; call-with-immediate-continuation-mark). -;;; -;;; Chez uses the names continuation-marks->list and continuation-marks-first; -;;; this library re-exports them as continuation-mark-set->list and -;;; continuation-mark-set-first for SRFI 157 / Racket compatibility. -;;; -;;; Note: Chez uses eq? for key comparison. Use symbols or fixnums as keys. -;;; String/pair keys work only if the same object is used for set and lookup. -;;; -;;; Note: call-with-immediate-continuation-mark takes (key default proc), -;;; not (key proc default) as in some Racket documentation. -;;; -;;; (with-continuation-mark 'key 'val -;;; (continuation-mark-set->list (current-continuation-marks) 'key)) -;;; => (val) - -(library (std misc cont-marks) - (export with-continuation-mark - current-continuation-marks - continuation-mark-set->list - continuation-mark-set-first - continuation-marks? - call-with-immediate-continuation-mark) - (import (chezscheme)) - - ;; SRFI 157-style aliases for Chez Scheme's native functions. - ;; Chez names: continuation-marks->list, continuation-marks-first - ;; SRFI 157 names: continuation-mark-set->list, continuation-mark-set-first - - (define continuation-mark-set->list continuation-marks->list) - - (define continuation-mark-set-first continuation-marks-first) - - ;; with-continuation-mark, current-continuation-marks, - ;; call-with-immediate-continuation-mark, and continuation-marks? - ;; are re-exported directly from (chezscheme). - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/misc/cont-marks.ss @@ -0,0 +1,44 @@ +#!chezscheme +;;; (std misc cont-marks) — Continuation marks (SRFI 157-style API) +;;; +;;; Provides SRFI 157-compatible names on top of Chez Scheme's native +;;; continuation mark support (with-continuation-mark, current-continuation-marks, +;;; call-with-immediate-continuation-mark). +;;; +;;; Chez uses the names continuation-marks->list and continuation-marks-first; +;;; this library re-exports them as continuation-mark-set->list and +;;; continuation-mark-set-first for SRFI 157 / Racket compatibility. +;;; +;;; Note: Chez uses eq? for key comparison. Use symbols or fixnums as keys. +;;; String/pair keys work only if the same object is used for set and lookup. +;;; +;;; Note: call-with-immediate-continuation-mark takes (key default proc), +;;; not (key proc default) as in some Racket documentation. +;;; +;;; (with-continuation-mark 'key 'val +;;; (continuation-mark-set->list (current-continuation-marks) 'key)) +;;; => (val) + +(library (std misc cont-marks) + (export with-continuation-mark + current-continuation-marks + continuation-mark-set->list + continuation-mark-set-first + continuation-marks? + call-with-immediate-continuation-mark) + (import (chezscheme) + (only (jerboa core) def)) + + ;; SRFI 157-style aliases for Chez Scheme's native functions. + ;; Chez names: continuation-marks->list, continuation-marks-first + ;; SRFI 157 names: continuation-mark-set->list, continuation-mark-set-first + + (def continuation-mark-set->list continuation-marks->list) + + (def continuation-mark-set-first continuation-marks-first) + + ;; with-continuation-mark, current-continuation-marks, + ;; call-with-immediate-continuation-mark, and continuation-marks? + ;; are re-exported directly from (chezscheme). + +) ;; end library deleted file mode 100644 --- a/lib/std/misc/shuffle.sls +++ /dev/null @@ -1,27 +0,0 @@ -#!chezscheme -;;; :std/misc/shuffle -- List and vector shuffling - -(library (std misc shuffle) - (export shuffle shuffle!) - - (import (chezscheme)) - - (define (shuffle! v) - ;; Fisher-Yates in-place shuffle of a vector - (let ((n (vector-length v))) - (let loop ((i (- n 1))) - (when (> i 0) - (let* ((j (random (+ i 1))) - (tmp (vector-ref v i))) - (vector-set! v i (vector-ref v j)) - (vector-set! v j tmp) - (loop (- i 1))))) - v)) - - (define (shuffle lst) - ;; Shuffle a list, returning a new list - (let* ((v (list->vector lst))) - (shuffle! v) - (vector->list v))) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/misc/shuffle.ss @@ -0,0 +1,28 @@ +#!chezscheme +;;; :std/misc/shuffle -- List and vector shuffling + +(library (std misc shuffle) + (export shuffle shuffle!) + + (import (chezscheme) + (only (jerboa core) def)) + + (def (shuffle! v) + ;; Fisher-Yates in-place shuffle of a vector + (let ([n (vector-length v)]) + (let loop ([i (- n 1)]) + (when (> i 0) + (let* ([j (random (+ i 1))] + [tmp (vector-ref v i)]) + (vector-set! v i (vector-ref v j)) + (vector-set! v j tmp) + (loop (- i 1))))) + v)) + + (def (shuffle lst) + ;; Shuffle a list, returning a new list + (let* ([v (list->vector lst)]) + (shuffle! v) + (vector->list v))) + +) ;; end library deleted file mode 100644 --- a/lib/std/misc/timeout.sls +++ /dev/null @@ -1,47 +0,0 @@ -#!chezscheme -;;; (std misc timeout) — Timeout-wrapped operations using Chez engines -;;; -;;; Leverages Chez Scheme's unique engine system for preemptive time-slicing. -;;; Engines provide tick-based fuel at compiler-inserted safe points. -;;; -;;; (with-timeout 1.0 'timed-out (lambda () (long-computation))) -;;; => result or 'timed-out - -(library (std misc timeout) - (export with-timeout make-timeout-value timeout-value timeout-value? - timeout-value-message call-with-timeout) - - (import (chezscheme)) - - ;; Sentinel for timeout - (define-record-type timeout-value - (fields message) - (protocol - (lambda (new) - (case-lambda - [() (new "operation timed out")] - [(msg) (new msg)])))) - - ;; Run thunk with a timeout using Chez engines. - ;; seconds: time limit (inexact, in seconds) - ;; default: value returned on timeout - ;; thunk: computation to run - (define (with-timeout seconds default thunk) - ;; Convert seconds to ticks (rough estimate: ~10M ticks/second) - (let* ([ticks (max 1 (inexact->exact (round (* seconds 10000000))))] - [eng (make-engine thunk)]) - (eng ticks - ;; completed: (ticks-left value) - (lambda (ticks-left value) value) - ;; expired: (new-engine) - (lambda (new-engine) default)))) - - ;; Procedural variant returning (values result timed-out?) - (define (call-with-timeout seconds thunk) - (let* ([ticks (max 1 (inexact->exact (round (* seconds 10000000))))] - [eng (make-engine thunk)]) - (eng ticks - (lambda (ticks-left value) (values value #f)) - (lambda (new-engine) (values (make-timeout-value) #t))))) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/misc/timeout.ss @@ -0,0 +1,52 @@ +#!chezscheme +;;; (std misc timeout) — Timeout-wrapped operations using Chez engines +;;; +;;; Leverages Chez Scheme's unique engine system for preemptive time-slicing. +;;; Engines provide tick-based fuel at compiler-inserted safe points. +;;; +;;; (with-timeout 1.0 'timed-out (lambda () (long-computation))) +;;; => result or 'timed-out + +(library (std misc timeout) + (export with-timeout make-timeout-value timeout-value timeout-value? + timeout-value-message call-with-timeout) + + (import (chezscheme) + (only (jerboa core) def defstruct)) + + ;; Sentinel for timeout. Use a thin wrapper so both + ;; (make-timeout-value) -> default message + ;; (make-timeout-value "msg") -> custom message + ;; remain valid call shapes for existing callers. + (defstruct %timeout-value (message)) + (def timeout-value %timeout-value::t) + (def timeout-value? %timeout-value?) + (def timeout-value-message %timeout-value-message) + (def make-timeout-value + (case-lambda + [() (make-%timeout-value "operation timed out")] + [(msg) (make-%timeout-value msg)])) + + ;; Run thunk with a timeout using Chez engines. + ;; seconds: time limit (inexact, in seconds) + ;; default: value returned on timeout + ;; thunk: computation to run + (def (with-timeout seconds default thunk) + ;; Convert seconds to ticks (rough estimate: ~10M ticks/second) + (let* ([ticks (max 1 (inexact->exact (round (* seconds 10000000))))] + [eng (make-engine thunk)]) + (eng ticks + ;; completed: (ticks-left value) + (lambda (ticks-left value) value) + ;; expired: (new-engine) + (lambda (new-engine) default)))) + + ;; Procedural variant returning (values result timed-out?) + (def (call-with-timeout seconds thunk) + (let* ([ticks (max 1 (inexact->exact (round (* seconds 10000000))))] + [eng (make-engine thunk)]) + (eng ticks + (lambda (ticks-left value) (values value #f)) + (lambda (new-engine) (values (make-timeout-value) #t))))) + +) ;; end library deleted file mode 100644 --- a/lib/std/misc/with-destroy.sls +++ /dev/null @@ -1,41 +0,0 @@ -#!chezscheme -;;; (std misc with-destroy) — RAII-style resource management -;;; -;;; Ensure cleanup (destroy) runs on scope exit. -;;; Pattern: (with-destroy (obj (make-resource)) body ...) -;;; Calls (destroy obj) on scope exit (normal or exception). - -(library (std misc with-destroy) - (export with-destroy with-destroys) - - (import (chezscheme)) - - ;; with-destroy: bind resource, run body, call destroy on exit - ;; destroy-proc defaults to a generic 'destroy' method dispatch - (define-syntax with-destroy - (syntax-rules () - [(_ ((var init) destroy-proc) body body* ...) - (let ([var init]) - (dynamic-wind - void - (lambda () body body* ...) - (lambda () (destroy-proc var))))] - [(_ (var init) body body* ...) - ;; Default: call close-port if port, otherwise noop - (let ([var init]) - (dynamic-wind - void - (lambda () body body* ...) - (lambda () - (when (port? var) (close-port var)))))])) - - ;; with-destroys: multiple resources - (define-syntax with-destroys - (syntax-rules () - [(_ () body body* ...) - (begin body body* ...)] - [(_ ((binding ...) rest ...) body body* ...) - (with-destroy (binding ...) - (with-destroys (rest ...) body body* ...))])) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/misc/with-destroy.ss @@ -0,0 +1,41 @@ +#!chezscheme +;;; (std misc with-destroy) — RAII-style resource management +;;; +;;; Ensure cleanup (destroy) runs on scope exit. +;;; Pattern: (with-destroy (obj (make-resource)) body ...) +;;; Calls (destroy obj) on scope exit (normal or exception). + +(library (std misc with-destroy) + (export with-destroy with-destroys) + + (import (chezscheme)) + + ;; with-destroy: bind resource, run body, call destroy on exit + ;; destroy-proc defaults to a generic 'destroy' method dispatch + (define-syntax with-destroy + (syntax-rules () + [(_ ((var init) destroy-proc) body body* ...) + (let ([var init]) + (dynamic-wind + void + (lambda () body body* ...) + (lambda () (destroy-proc var))))] + [(_ (var init) body body* ...) + ;; Default: call close-port if port, otherwise noop + (let ([var init]) + (dynamic-wind + void + (lambda () body body* ...) + (lambda () + (when (port? var) (close-port var)))))])) + + ;; with-destroys: multiple resources + (define-syntax with-destroys + (syntax-rules () + [(_ () body body* ...) + (begin body body* ...)] + [(_ ((binding ...) rest ...) body body* ...) + (with-destroy (binding ...) + (with-destroys (rest ...) body body* ...))])) + +) ;; end library deleted file mode 100644 --- a/lib/std/port-position.sls +++ /dev/null @@ -1,41 +0,0 @@ -#!chezscheme -;;; (std port-position) — Port position tracking -;;; -;;; Re-exports Chez's port position API for seekable I/O. - -(library (std port-position) - (export port-position set-port-position! - port-has-port-position? port-has-set-port-position!? - file-port-length) - - (import (chezscheme)) - - ;; file-port-length: get file size by seeking to end - ;; Uses port-file-descriptor + fstat via foreign procedure - (define c-fstat-size - (let () - ;; Use stat struct; on Linux x86-64, st_size is at offset 48 - ;; Instead, use a simpler approach: read file-length from path - ;; For ports opened with open-file-*-port, we can use Chez's file-length - ;; if we have the path. As fallback, save pos, read to end, restore. - #f)) - - (define (file-port-length port) - (unless (and (port-has-port-position? port) - (port-has-set-port-position!? port)) - (error 'file-port-length "port does not support positioning" port)) - (let ([saved (port-position port)]) - ;; Read to end to find length - (let loop () - (let ([b (get-u8 port)]) - (if (eof-object? b) - (let ([len (port-position port)]) - (set-port-position! port saved) - len) - (loop)))))) - - ;; Note: port-position, set-port-position!, - ;; port-has-port-position?, port-has-set-port-position!? - ;; are all Chez built-ins re-exported. - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/port-position.ss @@ -0,0 +1,33 @@ +#!chezscheme +;;; (std port-position) — Port position tracking +;;; +;;; Re-exports Chez's port position API for seekable I/O. + +(library (std port-position) + (export port-position set-port-position! + port-has-port-position? port-has-set-port-position!? + file-port-length) + + (import (chezscheme) + (only (jerboa core) def)) + + ;; file-port-length: get file size by seeking to end + (def (file-port-length port) + (unless (and (port-has-port-position? port) + (port-has-set-port-position!? port)) + (error 'file-port-length "port does not support positioning" port)) + (let ([saved (port-position port)]) + ;; Read to end to find length + (let loop () + (let ([b (get-u8 port)]) + (if (eof-object? b) + (let ([len (port-position port)]) + (set-port-position! port saved) + len) + (loop)))))) + + ;; Note: port-position, set-port-position!, + ;; port-has-port-position?, port-has-set-port-position!? + ;; are all Chez built-ins re-exported. + +) ;; end library deleted file mode 100644 --- a/lib/std/record-meta.sls +++ /dev/null @@ -1,34 +0,0 @@ -#!chezscheme -;;; (std record-meta) — Advanced record type introspection -;;; -;;; Re-exports Chez's record type descriptor (RTD) introspection system. - -(library (std record-meta) - (export record-type-descriptor record-constructor-descriptor - record-type-name record-type-parent - record-type-field-names record-type-field-count - record-type-uid record-type-generative? - record-type-sealed? record-type-opaque? - record-rtd record? record-type-descriptor?) - - (import (chezscheme)) - - ;; record-type-field-count: number of fields including inherited - (define (record-type-field-count rtd) - (vector-length (record-type-field-names rtd))) - - ;; All other exports are Chez built-ins: - ;; record-type-descriptor: get RTD from an instance - ;; record-constructor-descriptor: get RCD - ;; record-type-name: RTD → symbol - ;; record-type-parent: RTD → parent RTD or #f - ;; record-type-field-names: RTD → vector of field name symbols - ;; record-type-uid: RTD → uid symbol - ;; record-type-generative?: RTD → bool - ;; record-type-sealed?: RTD → bool - ;; record-type-opaque?: RTD → bool - ;; record-rtd: instance → RTD - ;; record?: any → bool - ;; record-type-descriptor?: any → bool - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/record-meta.ss @@ -0,0 +1,35 @@ +#!chezscheme +;;; (std record-meta) — Advanced record type introspection +;;; +;;; Re-exports Chez's record type descriptor (RTD) introspection system. + +(library (std record-meta) + (export record-type-descriptor record-constructor-descriptor + record-type-name record-type-parent + record-type-field-names record-type-field-count + record-type-uid record-type-generative? + record-type-sealed? record-type-opaque? + record-rtd record? record-type-descriptor?) + + (import (chezscheme) + (only (jerboa core) def)) + + ;; record-type-field-count: number of fields including inherited + (def (record-type-field-count rtd) + (vector-length (record-type-field-names rtd))) + + ;; All other exports are Chez built-ins: + ;; record-type-descriptor: get RTD from an instance + ;; record-constructor-descriptor: get RCD + ;; record-type-name: RTD → symbol + ;; record-type-parent: RTD → parent RTD or #f + ;; record-type-field-names: RTD → vector of field name symbols + ;; record-type-uid: RTD → uid symbol + ;; record-type-generative?: RTD → bool + ;; record-type-sealed?: RTD → bool + ;; record-type-opaque?: RTD → bool + ;; record-rtd: instance → RTD + ;; record?: any → bool + ;; record-type-descriptor?: any → bool + +) ;; end library deleted file mode 100644 --- a/lib/std/srfi/srfi-143.sls +++ /dev/null @@ -1,34 +0,0 @@ -#!chezscheme -;;; :std/srfi/143 -- SRFI-143 Fixnums -;;; Wraps Chez Scheme's fixnum operations to provide the SRFI-143 API. -;;; Most names already exist in Chez; we re-export them and add constants. - -(library (std srfi srfi-143) - (export - fixnum? - fx-width fx-greatest fx-least - fx+ fx- fx* - fxquotient fxremainder - fxabs - fxnot fxand fxior fxxor - fxarithmetic-shift-left fxarithmetic-shift-right - fx= fx< fx> fx<= fx>= - fxzero? fxpositive? fxnegative? - fxeven? fxodd? - fxmin fxmax) - - (import (chezscheme)) - - ;; Constants (SRFI-143 uses hyphenated names) - (define fx-width (fixnum-width)) - (define fx-greatest (greatest-fixnum)) - (define fx-least (least-fixnum)) - - ;; All other exports (fx+, fx-, fx*, fxquotient, fxremainder, fxabs, - ;; fxnot, fxand, fxior, fxxor, fxarithmetic-shift-left, - ;; fxarithmetic-shift-right, fx=, fx<, fx>, fx<=, fx>=, - ;; fxzero?, fxpositive?, fxnegative?, fxeven?, fxodd?, - ;; fxmin, fxmax, fixnum?) are already provided by Chez with the - ;; same names and semantics -- they are re-exported automatically. - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/srfi/srfi-143.ss @@ -0,0 +1,35 @@ +#!chezscheme +;;; :std/srfi/143 -- SRFI-143 Fixnums +;;; Wraps Chez Scheme's fixnum operations to provide the SRFI-143 API. +;;; Most names already exist in Chez; we re-export them and add constants. + +(library (std srfi srfi-143) + (export + fixnum? + fx-width fx-greatest fx-least + fx+ fx- fx* + fxquotient fxremainder + fxabs + fxnot fxand fxior fxxor + fxarithmetic-shift-left fxarithmetic-shift-right + fx= fx< fx> fx<= fx>= + fxzero? fxpositive? fxnegative? + fxeven? fxodd? + fxmin fxmax) + + (import (chezscheme) + (only (jerboa core) def)) + + ;; Constants (SRFI-143 uses hyphenated names) + (def fx-width (fixnum-width)) + (def fx-greatest (greatest-fixnum)) + (def fx-least (least-fixnum)) + + ;; All other exports (fx+, fx-, fx*, fxquotient, fxremainder, fxabs, + ;; fxnot, fxand, fxior, fxxor, fxarithmetic-shift-left, + ;; fxarithmetic-shift-right, fx=, fx<, fx>, fx<=, fx>=, + ;; fxzero?, fxpositive?, fxnegative?, fxeven?, fxodd?, + ;; fxmin, fxmax, fixnum?) are already provided by Chez with the + ;; same names and semantics -- they are re-exported automatically. + +) ;; end library deleted file mode 100644 --- a/lib/std/srfi/srfi-145.sls +++ /dev/null @@ -1,17 +0,0 @@ -#!chezscheme -;;; :std/srfi/145 -- Assumptions (SRFI-145) -;;; (assume expr message ...) asserts that expr is true. -;;; If expr is false, signals an error with the given messages. - -(library (std srfi srfi-145) - (export assume) - - (import (chezscheme)) - - (define-syntax assume - (syntax-rules () - [(_ expr rest ...) - (unless expr - (error 'assume "assumption violated" 'expr rest ...))])) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/srfi/srfi-145.ss @@ -0,0 +1,17 @@ +#!chezscheme +;;; :std/srfi/145 -- Assumptions (SRFI-145) +;;; (assume expr message ...) asserts that expr is true. +;;; If expr is false, signals an error with the given messages. + +(library (std srfi srfi-145) + (export assume) + + (import (chezscheme)) + + (define-syntax assume + (syntax-rules () + [(_ expr rest ...) + (unless expr + (error 'assume "assumption violated" 'expr rest ...))])) + +) ;; end library deleted file mode 100644 --- a/lib/std/srfi/srfi-212.sls +++ /dev/null @@ -1,15 +0,0 @@ -#!chezscheme -;;; :std/srfi/212 -- Aliases (SRFI-212) -;;; (alias new-name old-name) creates a binding identical to old-name. -;;; Works for both variables and syntax. - -(library (std srfi srfi-212) - (export alias) - - (import (except (chezscheme) alias)) - - (define-syntax alias - (syntax-rules () - [(_ new old) - (define-syntax new (identifier-syntax old))])) -) new file mode 100644 --- /dev/null +++ b/lib/std/srfi/srfi-212.ss @@ -0,0 +1,15 @@ +#!chezscheme +;;; :std/srfi/212 -- Aliases (SRFI-212) +;;; (alias new-name old-name) creates a binding identical to old-name. +;;; Works for both variables and syntax. + +(library (std srfi srfi-212) + (export alias) + + (import (except (chezscheme) alias)) + + (define-syntax alias + (syntax-rules () + [(_ new old) + (define-syntax new (identifier-syntax old))])) +) deleted file mode 100644 --- a/lib/std/srfi/srfi-8.sls +++ /dev/null @@ -1,15 +0,0 @@ -#!chezscheme -;;; :std/srfi/8 -- SRFI-8 receive: Binding to values of multiple-value expressions -;;; (receive formals expr body ...) binds the values of expr to formals. - -(library (std srfi srfi-8) - (export receive) - - (import (chezscheme)) - - (define-syntax receive - (syntax-rules () - [(_ formals expr body ...) - (call-with-values (lambda () expr) (lambda formals body ...))])) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/srfi/srfi-8.ss @@ -0,0 +1,15 @@ +#!chezscheme +;;; :std/srfi/8 -- SRFI-8 receive: Binding to values of multiple-value expressions +;;; (receive formals expr body ...) binds the values of expr to formals. + +(library (std srfi srfi-8) + (export receive) + + (import (chezscheme)) + + (define-syntax receive + (syntax-rules () + [(_ formals expr body ...) + (call-with-values (lambda () expr) (lambda formals body ...))])) + +) ;; end library deleted file mode 100644 --- a/lib/std/trace.sls +++ /dev/null @@ -1,26 +0,0 @@ -#!chezscheme -;;; (std trace) — Function tracing and debugging -;;; -;;; Re-exports Chez's built-in tracing system with convenience wrappers. - -(library (std trace) - (export trace-define trace-lambda trace-let - untrace trace-output-port - trace-calls) - - (import (chezscheme)) - - ;; trace-define, trace-lambda, trace-let are Chez built-ins (re-exported) - ;; untrace is a Chez built-in (re-exported) - ;; trace-output-port is a Chez parameter (re-exported) - - ;; Convenience: trace multiple procedures by name, run body, untrace - (define-syntax trace-calls - (syntax-rules () - [(_ (proc ...) body body* ...) - (dynamic-wind - (lambda () (trace proc) ...) - (lambda () body body* ...) - (lambda () (untrace proc) ...))])) - -) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/trace.ss @@ -0,0 +1,26 @@ +#!chezscheme +;;; (std trace) — Function tracing and debugging +;;; +;;; Re-exports Chez's built-in tracing system with convenience wrappers. + +(library (std trace) + (export trace-define trace-lambda trace-let + untrace trace-output-port + trace-calls) + + (import (chezscheme)) + + ;; trace-define, trace-lambda, trace-let are Chez built-ins (re-exported) + ;; untrace is a Chez built-in (re-exported) + ;; trace-output-port is a Chez parameter (re-exported) + + ;; Convenience: trace multiple procedures by name, run body, untrace + (define-syntax trace-calls