diff options
| author | David Thompson <dthompson@vistahigherlearning.com> | 2021-01-29 21:02:23 -0500 |
|---|---|---|
| committer | David Thompson <dthompson@vistahigherlearning.com> | 2021-01-29 21:02:23 -0500 |
| commit | 096dcb8e10678f7ec4aec17edba74e91f1384911 (patch) | |
| tree | 4584b3619b372728b31ebf367b38c7805499dc15 | |
| parent | c0fe5b574808b095b613577369b569981bd55487 (diff) | |
guix: Add missing Guile patch.
| -rw-r--r-- | 0001-goops-Preserve-all-slot-options-in-redefinable-class.patch | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/0001-goops-Preserve-all-slot-options-in-redefinable-class.patch b/0001-goops-Preserve-all-slot-options-in-redefinable-class.patch new file mode 100644 index 0000000..f47668b --- /dev/null +++ b/0001-goops-Preserve-all-slot-options-in-redefinable-class.patch @@ -0,0 +1,46 @@ +From cbc434527938182389ebe72c258587d137a85891 Mon Sep 17 00:00:00 2001 +From: David Thompson <dthompson@vistahigherlearning.com> +Date: Fri, 29 Jan 2021 11:04:56 -0500 +Subject: [PATCH] goops: Preserve all slot options in redefinable classes. + +* module/goops.scm (compute-slots): Fix <redefinable-class> slot + transformation. +--- + module/oop/goops.scm | 16 +++++++++------- + 1 file changed, 9 insertions(+), 7 deletions(-) + +diff --git a/module/oop/goops.scm b/module/oop/goops.scm +index df6df4f7b..a80be6a7a 100644 +--- a/module/oop/goops.scm ++++ b/module/oop/goops.scm +@@ -3081,18 +3081,20 @@ var{initargs}." + (slot-definition-name s))) + (ref (slot-definition-slot-ref/raw s*)) + (set! (slot-definition-slot-set! s*))) +- (make (class-of s) #:name (slot-definition-name s) +- #:getter (slot-definition-getter s) +- #:setter (slot-definition-setter s) +- #:accessor (slot-definition-accessor s) +- #:init-keyword (slot-definition-init-keyword s) +- #:init-thunk (slot-definition-init-thunk s) ++ (apply make (class-of s) + #:allocation #:virtual + ;; TODO: Make faster. + #:slot-ref (lambda (o) + (ref (slot-ref o 'indirect-slots))) + #:slot-set! (lambda (o v) +- (set! (slot-ref o 'indirect-slots) v))))) ++ (set! (slot-ref o 'indirect-slots) v)) ++ (let loop ((options (slot-definition-options s))) ++ (match options ++ (() '()) ++ (((or #:allocation #:slot-ref #:slot-set!) _ . rest) ++ (loop rest)) ++ ((kw arg . rest) ++ (cons* kw arg (loop rest)))))))) + (else s))) + (unless (equal? (list-head slots (length static-slots)) + static-slots) +-- +2.25.1 + |