Hi, There are some hygiene issues in defstruct egg, where old, new, and old-make symbols are not renamed.
(defstruct a new) (defstruct b old-make) (a-new (update-a (make-a) #:new 1)) ; => #<a> (make-b) ; => Error: call of non-procedure: #f The issue telegraphs to typed-records egg as well. The attached patch should remedy that. -- Stan ----8<---- From 685c376818a97767a725e7bbb96f23424218b53b Mon Sep 17 00:00:00 2001 From: Stanislav Kljuhhin <[email protected]> Date: Wed, 4 Feb 2026 13:21:30 +0100 Subject: [PATCH] Fix defstruct hygiene Symbols old, new, and old-make were not renamed, causing issues should a field bear one of those names. --- defstruct.scm | 19 +++++++++++-------- tests/run.scm | 16 ++++++++++++++-- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/defstruct.scm b/defstruct.scm index ff5211b..2677b2c 100644 --- a/defstruct.scm +++ b/defstruct.scm @@ -64,6 +64,9 @@ (%eq? (rename 'eq?)) (%let (rename 'let)) (%uninitialized (rename 'uninitialized)) + (%old-make (rename 'old-make)) + (%old (rename 'old)) + (%new (rename 'new)) (%case (rename 'case)) (%loop (rename 'loop)) (%obj (rename 'obj)) @@ -75,9 +78,9 @@ `(,%begin (,%define-record ,type-name ,@no-init-fields ,@(map car init-fields)) (,%define ,make - (,%let ((old-make ,make)) + (,%let ((,%old-make ,make)) (,%lambda (#!key ,@fields) - (old-make ,@no-init-fields ,@(map car init-fields))))) + (,%old-make ,@no-init-fields ,@(map car init-fields))))) (,%define ,set (,%let ((,%uninitialized (,%list 'uninitialized))) (,%lambda (,%obj #!key ,@(map (lambda (f) @@ -92,10 +95,10 @@ ,%obj))) (,%define ,copy (,%let ((,%uninitialized (,%list 'uninitialized))) - (,%lambda (old #!key ,@(map (lambda (f) + (,%lambda (,%old #!key ,@(map (lambda (f) (list f %uninitialized)) field-names)) - (let ((new (,make ,@(fold (lambda (f rest) + (,%let ((,%new (,make ,@(fold (lambda (f rest) (cons (string->keyword (symbol->string f)) (cons %uninitialized rest))) @@ -104,12 +107,12 @@ (lambda (f) `(,%if (,%eq? ,f ,%uninitialized) (,(string->symbol (conc type-name "-" f "-set!")) - new - (,(string->symbol (conc type-name "-" f)) old)) + ,%new + (,(string->symbol (conc type-name "-" f)) ,%old)) (,(string->symbol (conc type-name "-" f "-set!")) - new ,f))) + ,%new ,f))) field-names) - new)))) + ,%new)))) (,%define ,to-alist (,%lambda (,%obj) (,%list . ,(map diff --git a/tests/run.scm b/tests/run.scm index d0e66ec..eea48be 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -46,12 +46,24 @@ (test '() (complex-field-1 c2)))) (test-group "hygiene" - (defstruct ini-capture (uninitialized 1)) + (defstruct ini-capture (uninitialized 1) (new 3) (old 5) (old-make 7)) (define i1 (make-ini-capture)) (test 1 (ini-capture-uninitialized (update-ini-capture i1))) (test 2 (ini-capture-uninitialized (update-ini-capture i1 uninitialized: 2))) (set-ini-capture! i1 uninitialized: 'uninitialized) - (test 'uninitialized (ini-capture-uninitialized i1))) + (test 'uninitialized (ini-capture-uninitialized i1)) + (test 3 (ini-capture-new (update-ini-capture i1))) + (test 4 (ini-capture-new (update-ini-capture i1 new: 4))) + (set-ini-capture! i1 new: 'new) + (test 'new (ini-capture-new i1)) + (test 5 (ini-capture-old (update-ini-capture i1))) + (test 6 (ini-capture-old (update-ini-capture i1 old: 6))) + (set-ini-capture! i1 old: 'old) + (test 'old (ini-capture-old i1)) + (test 7 (ini-capture-old-make (update-ini-capture i1))) + (test 8 (ini-capture-old-make (update-ini-capture i1 old-make: 8))) + (set-ini-capture! i1 old-make: 'old-make) + (test 'old-make (ini-capture-old-make i1))) (test-group "alist conversion" (define rec1 (make-complex field-1: 1 field-2: 2 field-3: 3 field-4: 4)) -- 2.52.0 ----8<----
