feat: add errdefer and defvariant (Zig-inspired)
ober
568f8b64009eeb99f66e76a0524bdf4009448f55
new file mode 100644 --- /dev/null +++ b/implement-me.md @@ -0,0 +1,66 @@ +# Jerboa Runtime: Features to Implement + +## GC Finalizer Safety Net for Unclosed Resources + +**ID:** jerboa-finalizer-safety-net +**Impact:** high +**Votes:** 1 + +### What + +Register Chez guardians on resource-acquiring functions (`sqlite-open`, `tcp-connect`, `open-input-file`, etc.). When a resource is garbage collected without being explicitly closed, log a warning that includes the allocation site. This catches resource leaks that `with-resource` would have prevented, without crashing. + +### Why + +Claude-generated code frequently forgets `with-resource` and uses bare `(let ([db (sqlite-open ...)]) ...)`. The connection leaks silently and is only discovered in production under load. With a finalizer safety net, a warning appears in the log during testing so the leak is caught early. + +### Example + +``` +WARNING: sqlite handle #7 GC'd without close — allocated at handler.ss:42 +``` + +Developer then wraps the `sqlite-open` in `with-resource`. Bug fixed before production. + +### How to Implement + +In the relevant resource-opening functions (e.g. `sqlite-open` in `lib/std/db/sqlite.sls`, `tcp-connect` in `lib/std/net/tcp.sls`), register a Chez guardian after the resource is created: + +```scheme +;; After creating the resource handle: +(let ([guardian (make-guardian)]) + (guardian handle) + (spawn + (lambda () + (let loop () + (let ([collected (guardian)]) + (when collected + (unless (resource-closed? collected) + (log-warning + (str "WARNING: " (resource-type-name collected) + " handle GC'd without close" + (if (resource-alloc-site collected) + (str " — allocated at " (resource-alloc-site collected)) + "")))) + (loop))))))) +``` + +Key details: +- Use `make-guardian` (Chez SRFI-115 guardian API) +- The guardian thread should be a daemon thread (low priority, doesn't prevent exit) +- Capture the allocation site via `(call-with-current-continuation ...)` or a `(fluid-let ([*alloc-site* (current-source-location)]) ...)` wrapper at the call site +- The warning should go to `current-error-port`, not `current-output-port` +- This is opt-in per module — add to: `(std db sqlite)`, `(std net tcp)`, `(std net request)`, `(std os file)` at minimum + +### Affected Modules + +- `lib/std/db/sqlite.sls` — `sqlite-open` +- `lib/std/net/tcp.sls` — `tcp-connect`, `tcp-listen` +- `lib/std/net/request.sls` — any connection-holding handle +- `lib/std/os/file.sls` — file handles opened without `with-resource` + +### Notes + +- The warning must NOT prevent GC or cause a crash — it is purely informational +- In production, this can be silenced via `(set-resource-leak-warning! #f)` +- This is a runtime change to the standard library, not an MCP tool new file mode 100644 --- /dev/null +++ b/lib/std/errdefer.sls @@ -0,0 +1,68 @@ +#!chezscheme +;;; (std errdefer) — Error-path cleanup (Zig-inspired) +;;; +;;; Provides `errdefer` — a form that registers cleanup code to run +;;; ONLY when the dynamic extent exits via an exception. +;;; +;;; Unlike `unwind-protect` which always runs cleanup: +;;; (unwind-protect body cleanup) ; cleanup runs on success OR error +;;; +;;; `errdefer` cancels cleanup on normal exit: +;;; (errdefer cleanup body ...) ; cleanup only runs on error +;;; +;;; Multiple errdefers stack in LIFO order (like Zig). + +(library (std errdefer) + (export + errdefer + errdefer* + with-errdefer) + + (import (chezscheme)) + + ;; errdefer: single cleanup expression, single body expression + ;; (errdefer cleanup body) — cleanup runs only if body raises an exception + ;; + ;; Implementation: Use a success flag that gets set after body completes. + ;; The dynamic-wind after thunk checks the flag and only runs cleanup if false. + (define-syntax errdefer + (syntax-rules () + [(_ cleanup body) + (let ([ok? #f]) + (dynamic-wind + (lambda () (void)) + (lambda () + (let ([result body]) + (set! ok? #t) + result)) + (lambda () + (unless ok? cleanup))))] + [(_ cleanup body body* ...) + (errdefer cleanup (begin body body* ...))])) + + ;; errdefer*: multiple body forms with begin + ;; (errdefer* cleanup body1 body2 ...) — same as errdefer but cleaner for multi-form bodies + (define-syntax errdefer* + (syntax-rules () + [(_ cleanup body ...) + (errdefer cleanup (begin body ...))])) + + ;; with-errdefer: Zig-style stacking of multiple errdefers + ;; (with-errdefer ([cleanup1] [cleanup2] ...) body ...) + ;; + ;; Cleanups are registered in order but fire in LIFO order on error. + ;; This matches Zig's errdefer semantics where: + ;; errdefer a(); + ;; errdefer b(); + ;; // on error: b() then a() + (define-syntax with-errdefer + (syntax-rules () + ;; Base case: no cleanups left, just run body + [(_ () body ...) + (begin body ...)] + ;; Recursive case: wrap body in errdefer for this cleanup + [(_ ([cleanup] rest ...) body ...) + (errdefer cleanup + (with-errdefer (rest ...) body ...))])) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/lib/std/variant.sls @@ -0,0 +1,306 @@ +#!chezscheme +;;; (std variant) — Exhaustive variant matching (Zig/Rust-inspired) +;;; +;;; Provides `defvariant` for declaring closed sum types (tagged unions) +;;; with compile-time exhaustiveness checking via `match-variant`. +;;; +;;; Example: +;;; (defvariant shape +;;; (circle radius) +;;; (rect width height) +;;; (triangle base height)) +;;; +;;; Generates: +;;; - shape/circle, shape/rect, shape/triangle — constructors +;;; - shape/circle?, shape/rect?, shape/triangle? — predicates +;;; - shape/circle-radius, shape/rect-width, etc. — accessors +;;; - shape? — variant-wide predicate (any variant) +;;; - shape/variants — '(circle rect triangle) — the closed tag set +;;; +;;; Usage: +;;; (match-variant shape val +;;; [(circle r) (* pi r r)] +;;; [(rect w h) (* w h)]) +;;; ;; ERROR at expand time: unhandled variant: triangle +;;; +;;; Use `_` or `else` to explicitly opt out of exhaustiveness checking. + +(library (std variant) + (export + defvariant + match-variant + variant-tags + variant? + *variant-registry*) + + (import (chezscheme)) + + ;; --- Runtime registry for variant types --- + ;; Maps variant-name → list of (tag-sym field-count pred acc ...) + ;; where pred/acc are actual procedure references + (define *variant-registry* (make-eq-hashtable)) + + ;; --- Compile-time registry (meta phase) --- + ;; Maps variant-name → list of (tag-sym field-count pred-name acc-name ...) + ;; where pred-name/acc-name are symbols + (meta define *ct-variant-registry* (make-eq-hashtable)) + + ;; variant-tags: get the list of tag symbols for a variant type + (define (variant-tags name) + (let ([info (hashtable-ref *variant-registry* name #f)]) + (if info + (map car info) + (error 'variant-tags "unknown variant type" name)))) + + ;; variant?: check if a value is an instance of any variant of the named type + (define (variant? name val) + (let ([info (hashtable-ref *variant-registry* name #f)]) + (if info + (exists (lambda (entry) + (let ([pred (caddr entry)]) + (pred val))) + info) + (error 'variant? "unknown variant type" name)))) + + ;; --- Helper macro for generating a single variant case record --- + ;; Uses syntax-rules to avoid Chez define-record-type expansion issues. + ;; Generates: + ;; - An internal record type with Chez-standard naming + ;; - Public aliases for constructor, predicate, and accessors + (define-syntax %define-variant-case + (syntax-rules () + ;; No fields case + [(_ ctor-name pred-name ()) + (begin + (define-record-type ctor-name (fields)))] + ;; With fields: (field acc) ... + [(_ ctor-name pred-name ((field acc) ...)) + (begin + (define-record-type ctor-name + (fields (immutable field acc) ...)))])) + + ;; --- Compile-time helpers (meta) --- + + ;; Parse a variant case: (tag field ...) + ;; Returns: (tag-sym (field ...) ctor-name pred-name (acc-name ...)) + (meta define (parse-variant-case var-name case-stx) + (syntax-case case-stx () + [(tag field ...) + (let* ([tag-sym (syntax->datum #'tag)] + [fields (syntax->list #'(field ...))] + [field-syms (map syntax->datum fields)] + [var-str (symbol->string var-name)] + [tag-str (symbol->string tag-sym)]) + (list tag-sym + field-syms + ;; constructor: var-name/tag + (string->symbol (format "~a/~a" var-str tag-str)) + ;; predicate: var-name/tag? + (string->symbol (format "~a/~a?" var-str tag-str)) + ;; accessors: var-name/tag-field for each field + (map (lambda (f) + (string->symbol + (format "~a/~a-~a" var-str tag-str (symbol->string f)))) + field-syms)))])) + + ;; --- defvariant macro --- + ;; + ;; (defvariant name (tag1 field ...) (tag2 field ...) ...) + ;; + ;; Two-phase expansion: + ;; 1. At compile time: register type info in *ct-variant-registry* for match-variant + ;; 2. At runtime: define records, predicates, accessors, and register in *variant-registry* + + (define-syntax defvariant + (lambda (stx) + (syntax-case stx () + [(_ name case ...) + (identifier? #'name) + (let* ([var-name (syntax->datum #'name)] + [var-str (symbol->string var-name)] + [cases (map (lambda (c) (parse-variant-case var-name c)) + (syntax->list #'(case ...)))] + ;; Generate names + [any-pred (string->symbol (format "~a?" var-str))] + [variants-list (string->symbol (format "~a/variants" var-str))] + ;; Build compile-time registry entry: + ;; Each case: (tag-sym field-count pred-name acc-names...) + [ct-entry (map (lambda (c) + (cons (car c) ; tag + (cons (length (cadr c)) ; field-count + (cons (cadddr c) ; pred-name + (car (cddddr c)))))) ; acc-names + cases)]) + + ;; Register at compile time for match-variant + (hashtable-set! *ct-variant-registry* var-name ct-entry) + + (with-syntax + ([any-pred-id (datum->syntax #'name any-pred)] + [variants-id (datum->syntax #'name variants-list)] + [name-sym (datum->syntax #'name `',var-name)] + [(tag-sym ...) (datum->syntax #'name + (map car cases))] + ;; Generate record definitions for each case using the helper macro + [(record-def ...) + (map (lambda (c) + (let ([fields (cadr c)] + [ctor (caddr c)] + [accs (car (cddddr c))]) + (with-syntax ([ctor-id (datum->syntax #'name ctor)] + [pred-id (datum->syntax #'name (cadddr c))] + ;; Build ((field acc) ...) pairs + [(field-acc ...) + (map (lambda (f a) + (datum->syntax #'name (list f a))) + fields accs)]) + #'(%define-variant-case ctor-id pred-id (field-acc ...))))) + cases)] + ;; Generate constructor aliases: (define ctor-name make-ctor-name) + [(ctor-alias ...) + (map (lambda (c) + (let ([ctor (caddr c)]) + (with-syntax ([ctor-id (datum->syntax #'name ctor)] + [make-ctor-id (datum->syntax #'name + (string->symbol + (format "make-~a" ctor)))]) + #'(define ctor-id make-ctor-id)))) + cases)] + ;; Predicate names for the any-pred check + [(pred-name ...) (map (lambda (c) (datum->syntax #'name (cadddr c))) + cases)] + ;; Runtime registry entry: holds actual procedures + [registry-expr + (datum->syntax #'name + `(list + ,@(map (lambda (c) + `(list ',(car c) + ,(length (cadr c)) + ,(cadddr c) ; pred proc + ,@(car (cddddr c)))) ; acc procs + cases)))]) + #'(begin + record-def ... + ctor-alias ... + (define (any-pred-id x) + (or (pred-name x) ...)) + (define variants-id '(tag-sym ...)) + (hashtable-set! *variant-registry* name-sym registry-expr))))]))) + + ;; --- match-variant macro --- + ;; + ;; (match-variant type-name expr clause ...) + ;; + ;; Where clause is: [(tag var ...) body ...] + ;; [_ body ...] ; explicit wildcard, suppresses check + ;; [else body ...] ; explicit else, suppresses check + ;; + ;; At expand time: checks that all variants are covered (unless _ or else present) + ;; using the compile-time registry. + + (define-syntax match-variant + (lambda (stx) + ;; Helper: extract tag names from clauses + (define (clause-tags clauses) + (let loop ([cls clauses] [tags '()] [has-wild? #f]) + (if (null? cls) + (cons (reverse tags) has-wild?) + (let* ([clause (car cls)] + [pat (car (syntax->list clause))] + [pat-d (syntax->datum pat)]) + (cond + [(eq? pat-d '_) (loop (cdr cls) tags #t)] + [(eq? pat-d 'else) (loop (cdr cls) tags #t)] + [(and (pair? pat-d) (symbol? (car pat-d))) + (loop (cdr cls) (cons (car pat-d) tags) has-wild?)] + [else (loop (cdr cls) tags has-wild?)]))))) + + ;; Helper: compile a single clause to match code + ;; type-info is from compile-time registry: ((tag field-count pred-name acc-name ...) ...) + (define (compile-clause tmp-stx clause type-info fail-stx) + (let* ([parts (syntax->list clause)] + [pat (car parts)] + [pat-d (syntax->datum pat)] + [body-stx (cdr parts)]) + (cond + ;; Wildcard _ + [(eq? pat-d '_) + #`(begin #,@body-stx)] + ;; else clause + [(eq? pat-d 'else) + #`(begin #,@body-stx)] + ;; Variant case: (tag var ...) + [(pair? pat-d) + (let* ([pat-list (syntax->list pat)] + [tag-stx (car pat-list)] + [tag-sym (syntax->datum tag-stx)] + [entry (assq tag-sym type-info)]) + (if (not entry) + (syntax-violation 'match-variant + (format "unknown variant tag: ~a" tag-sym) pat) + (let* ([pred-name (caddr entry)] + [acc-names (cdddr entry)] + [var-stxs (cdr pat-list)] + [n-vars (length var-stxs)] + [n-accs (length acc-names)]) + (unless (= n-vars n-accs) + (syntax-violation 'match-variant + (format "wrong number of bindings for ~a: expected ~a, got ~a" + tag-sym n-accs n-vars) + clause)) + (with-syntax ([pred-id (datum->syntax tag-stx pred-name)] + [(acc-id ...) (datum->syntax tag-stx acc-names)] + [(var-id ...) var-stxs] + [tmp tmp-stx] + [fail fail-stx] + [(body-expr ...) body-stx]) + #'(if (pred-id tmp) + (let ([var-id (acc-id tmp)] ...) + body-expr ...) + fail)))))] + [else + (syntax-violation 'match-variant + "invalid match clause" clause)]))) + + ;; Compile all clauses into nested if + (define (compile-clauses tmp-stx clauses type-info) + (if (null? clauses) + #`(error 'match-variant "no matching clause" #,tmp-stx) + (let ([clause (car clauses)] + [rest (cdr clauses)]) + (compile-clause tmp-stx clause type-info + (compile-clauses tmp-stx rest type-info))))) + + (syntax-case stx () + [(_ type-name expr clause ...) + (identifier? #'type-name) + (let* ([type-sym (syntax->datum #'type-name)] + ;; Use compile-time registry + [type-info (hashtable-ref *ct-variant-registry* type-sym #f)]) + ;; Check if type is registered + (unless type-info + (syntax-violation 'match-variant + (format "unknown variant type: ~a (hint: defvariant must appear before match-variant in the same compilation unit)" type-sym) + #'type-name)) + + ;; Check exhaustiveness + (let* ([clauses (syntax->list #'(clause ...))] + [result (clause-tags clauses)] + [covered-tags (car result)] + [has-wildcard? (cdr result)] + [all-tags (map car type-info)] + [missing (filter (lambda (t) (not (memq t covered-tags))) all-tags)]) + ;; Only error if no wildcard and there are missing tags + (when (and (not has-wildcard?) (not (null? missing))) + (syntax-violation 'match-variant + (format "unhandled variant(s): ~a" missing) + stx)) + + ;; Generate match code + (let ([tmp (car (generate-temporaries '(val)))]) + (with-syntax ([tmp-id tmp] + [match-body (compile-clauses tmp clauses type-info)]) + #'(let ([tmp-id expr]) + match-body)))))]))) + + ) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-errdefer.ss @@ -0,0 +1,122 @@ +#!chezscheme +;;; Test: errdefer — error-path cleanup + +(import (std errdefer)) + +(define pass 0) +(define fail 0) + +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([r expr] [e expected]) + (if (equal? r e) + (set! pass (+ pass 1)) + (begin + (set! fail (+ fail 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write r) + (display " expected ") (write e) (newline))))])) + +;; Helper: track cleanup calls +(define cleanup-log '()) +(define (log-cleanup! msg) + (set! cleanup-log (append cleanup-log (list msg)))) +(define (reset-log!) + (set! cleanup-log '())) + +;; --- Test 1: errdefer does NOT run on success --- +(reset-log!) +(let ([result (errdefer (log-cleanup! 'cleanup-ran) + (+ 1 2))]) + (chk result => 3) + (chk cleanup-log => '())) ; cleanup should NOT run + +;; --- Test 2: errdefer DOES run on exception --- +(reset-log!) +(guard (exn [#t 'caught]) + (errdefer (log-cleanup! 'cleanup-ran) + (error 'test "intentional error"))) +(chk cleanup-log => '(cleanup-ran)) ; cleanup should run + +;; --- Test 3: errdefer with multiple body forms --- +(reset-log!) +(let ([result (errdefer (log-cleanup! 'cleanup) + (log-cleanup! 'body1) + (log-cleanup! 'body2) + 42)]) + (chk result => 42) + ;; Body logs should be there, cleanup should NOT + (chk cleanup-log => '(body1 body2))) + +;; --- Test 4: errdefer* variant --- +(reset-log!) +(let ([result (errdefer* (log-cleanup! 'cleanup) + (+ 10 20))]) + (chk result => 30) + (chk cleanup-log => '())) + +;; --- Test 5: LIFO stacking with with-errdefer (success) --- +(reset-log!) +(let ([result (with-errdefer + ([(log-cleanup! 'first)] + [(log-cleanup! 'second)] + [(log-cleanup! 'third)]) + (+ 1 1))]) + (chk result => 2) + (chk cleanup-log => '())) ; no cleanup on success + +;; --- Test 6: LIFO stacking with with-errdefer (error) --- +(reset-log!) +(guard (exn [#t 'caught]) + (with-errdefer + ([(log-cleanup! 'first)] + [(log-cleanup! 'second)] + [(log-cleanup! 'third)]) + (error 'test "boom"))) +;; Should run in LIFO order: third, second, first +(chk cleanup-log => '(third second first)) + +;; --- Test 7: Partial success with stacked errdefers --- +;; If error happens after some errdefers complete, only remaining ones fire +(reset-log!) +(guard (exn [#t 'caught]) + (errdefer (log-cleanup! 'outer) + (log-cleanup! 'setup) + (errdefer (log-cleanup! 'inner) + (log-cleanup! 'middle) + (error 'test "error in inner")))) +;; Order: setup runs, middle runs, inner and outer cleanup fire +(chk cleanup-log => '(setup middle inner outer)) + +;; --- Test 8: Real-world pattern: resource cleanup on error --- +(define resources '()) +(define (acquire-resource name) + (set! resources (cons name resources)) + name) +(define (release-resource name) + (set! resources (filter (lambda (x) (not (equal? x name))) resources))) + +(set! resources '()) +(let ([r (errdefer (release-resource 'temp-file) + (acquire-resource 'temp-file) + ;; Simulate success: "rename" the file + 'renamed)]) + (chk r => 'renamed) + ;; Resource should still be held (cleanup didn't run) + (chk resources => '(temp-file))) + +(set! resources '()) +(guard (exn [#t 'caught]) + (errdefer (release-resource 'temp-file) + (acquire-resource 'temp-file) + (error 'test "operation failed"))) +;; Resource should be released (cleanup ran) +(chk resources => '()) + +;; --- Summary --- +(newline) +(display "errdefer: ") +(display pass) (display " passed, ") +(display fail) (display " failed") (newline) +(when (> fail 0) (exit 1)) new file mode 100644 --- /dev/null +++ b/tests/test-variant.ss @@ -0,0 +1,156 @@ +#!chezscheme +;;; Test: variant — exhaustive variant matching + +(import (std variant)) + +(define pass 0) +(define fail 0) + +(define-syntax chk + (syntax-rules (=>) + [(_ expr => expected) + (let ([r expr] [e expected]) + (if (equal? r e) + (set! pass (+ pass 1)) + (begin + (set! fail (+ fail 1)) + (display "FAIL: ") (write 'expr) + (display " => ") (write r) + (display " expected ") (write e) (newline))))])) + +;; --- Define a simple variant type --- +(defvariant shape + (circle radius) + (rect width height) + (triangle base height)) + +;; --- Test 1: Constructors work --- +(let ([c (shape/circle 5)]) + (chk (shape/circle? c) => #t) + (chk (shape/rect? c) => #f) + (chk (shape? c) => #t)) + +(let ([r (shape/rect 10 20)]) + (chk (shape/rect? r) => #t) + (chk (shape/circle? r) => #f) + (chk (shape? r) => #t)) + +(let ([t (shape/triangle 6 8)]) + (chk (shape/triangle? t) => #t) + (chk (shape? t) => #t)) + +;; --- Test 2: Accessors work --- +(let ([c (shape/circle 7)]) + (chk (shape/circle-radius c) => 7)) + +(let ([r (shape/rect 3 4)]) + (chk (shape/rect-width r) => 3) + (chk (shape/rect-height r) => 4)) + +(let ([t (shape/triangle 5 12)]) + (chk (shape/triangle-base t) => 5) + (chk (shape/triangle-height t) => 12)) + +;; --- Test 3: variant-tags returns the tag list --- +(chk (variant-tags 'shape) => '(circle rect triangle)) + +;; --- Test 4: shape/variants binding --- +(chk shape/variants => '(circle rect triangle)) + +;; --- Test 5: match-variant with exhaustive coverage --- +(define (area s) + (match-variant shape s + [(circle r) (* 3.14159 r r)] + [(rect w h) (* w h)] + [(triangle b h) (* 0.5 b h)])) + +(chk (area (shape/circle 10)) => 314.159) +(chk (area (shape/rect 3 4)) => 12) +(chk (area (shape/triangle 6 8)) => 24.0) + +;; --- Test 6: match-variant with wildcard (suppresses exhaustiveness) --- +(define (describe s) + (match-variant shape s + [(circle r) "a circle"] + [_ "not a circle"])) + +(chk (describe (shape/circle 1)) => "a circle") +(chk (describe (shape/rect 2 3)) => "not a circle") +(chk (describe (shape/triangle 4 5)) => "not a circle") + +;; --- Test 7: match-variant with else (also suppresses exhaustiveness) --- +(define (is-rect? s) + (match-variant shape s + [(rect w h) #t] + [else #f])) + +(chk (is-rect? (shape/rect 1 2)) => #t) +(chk (is-rect? (shape/circle 1)) => #f) + +;; --- Test 8: Multiple variant types --- +(defvariant result + (ok value) + (err message code)) + +(let ([success (result/ok 42)]) + (chk (result/ok? success) => #t) + (chk (result/ok-value success) => 42)) + +(let ([failure (result/err "oops" 500)]) + (chk (result/err? failure) => #t) + (chk (result/err-message failure) => "oops") + (chk (result/err-code failure) => 500)) + +(define (unwrap-result r) + (match-variant result r + [(ok v) v] + [(err msg code) (error 'unwrap msg code)])) + +(chk (unwrap-result (result/ok 100)) => 100) + +;; --- Test 9: Zero-field variants --- +(defvariant option + (some value) + (none)) + +(let ([n (option/none)]) + (chk (option/none? n) => #t) + (chk (option? n) => #t)) + +(let ([s (option/some 42)]) + (chk (option/some? s) => #t) + (chk (option/some-value s) => 42)) + +(define (option-or opt default) + (match-variant option opt + [(some v) v] + [(none) default])) + +(chk (option-or (option/some 10) 0) => 10) +(chk (option-or (option/none) 0) => 0) + +;; --- Test 10: Nested variant matching --- +(define (map-option f opt) + (match-variant option opt + [(some v) (option/some (f v))] + [(none) (option/none)])) + +(let ([doubled (map-option (lambda (x) (* x 2)) (option/some 21))]) + (chk (option/some? doubled) => #t) + (chk (option/some-value doubled) => 42)) + +(let ([mapped-none (map-option (lambda (x) (* x 2)) (option/none))]) + (chk (option/none? mapped-none) => #t)) + +;; --- Test 11: variant? runtime check --- +(chk (variant? 'shape (shape/circle 1)) => #t) +(chk (variant? 'shape (shape/rect 2 3)) => #t) +(chk (variant? 'option (option/some 1)) => #t) +(chk (variant? 'option (option/none)) => #t) + +;; --- Summary --- +(newline) +(display "variant: ") +(display pass) (display " passed, ") +(display fail) (display " failed") (newline) +(when (> fail 0) (exit 1)) new file mode 100644 --- /dev/null +++ b/zig-ideas.md @@ -0,0 +1,98 @@ +# Zig-Inspired Ideas for Jerboa + +## 1. `errdefer` — Error-Path Cleanup ✅ IMPLEMENTED + +**Library:** `(std errdefer)` + +### Usage + +```scheme +(import (std errdefer)) + +;; Basic form: cleanup runs only on error +(errdefer (delete-file tmp) + (write-file tmp data) + (rename-file tmp dest)) ;; on success, errdefer is cancelled + +;; Multiple body forms +(errdefer* (cleanup-resource res) + (setup-phase-1) + (setup-phase-2) + (final-result)) + +;; LIFO stacking with with-errdefer +(with-errdefer + ([(release-resource-a)] + [(release-resource-b)] + [(release-resource-c)]) + ;; on error: c, b, a cleanup runs in reverse order + (acquire-resources) + (do-work)) +``` + +### Exports + +- `errdefer` — single cleanup, single/multiple body forms +- `errdefer*` — single cleanup, multiple body forms (cleaner syntax) +- `with-errdefer` — stack multiple cleanups with LIFO order on error + +--- + +## 2. Exhaustive Variant Matching — `defvariant` ✅ IMPLEMENTED + +**Library:** `(std variant)` + +### Usage + +```scheme +(import (std variant)) + +;; Define a closed sum type +(defvariant shape + (circle radius) + (rect width height) + (triangle base height)) + +;; Generates: +;; - shape/circle, shape/rect, shape/triangle — constructors +;; - shape/circle?, shape/rect?, shape/triangle? — predicates +;; - shape/circle-radius, shape/rect-width, etc. — accessors +;; - shape? — variant-wide predicate +;; - shape/variants — '(circle rect triangle) — closed tag set + +;; Exhaustive matching (error at expand time if incomplete) +(match-variant shape s + [(circle r) (* 3.14159 r r)] + [(rect w h) (* w h)] + [(triangle b h) (* 0.5 b h)]) + +;; Non-exhaustive with explicit wildcard (suppresses check) +(match-variant shape s + [(circle r) "it's a circle"] + [_ "not a circle"]) + +;; Non-exhaustive with else +(match-variant shape s + [(rect w h) #t] + [else #f]) +``` + +### Exports + +- `defvariant` — define a closed sum type with multiple variants +- `match-variant` — exhaustive pattern matching with compile-time checking +- `variant-tags` — get the list of tag symbols for a variant type +- `variant?` — check if a value is any variant of the named type +- `*variant-registry*` — runtime registry (for advanced use) + +### Design Notes + +- Exhaustiveness checking happens at compile/expand time via a meta-phase registry +- Missing variants cause a `syntax-violation` at expansion +- Wildcard `_` or `else` suppresses exhaustiveness checking +- Zero-field variants are supported: `(defvariant option (some value) (none))` +- Multiple variant types can coexist independently + +--- + +## Original Design Notes (Preserved for Reference)