[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 16/88: define-generic, define-extended-generic are hygie
From: |
Andy Wingo |
Subject: |
[Guile-commits] 16/88: define-generic, define-extended-generic are hygienic syntax |
Date: |
Fri, 23 Jan 2015 15:25:26 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 7cb88cbc922ebaeefe4a33da17b97d85522601a9
Author: Andy Wingo <address@hidden>
Date: Sun Jan 4 15:35:25 2015 -0500
define-generic, define-extended-generic are hygienic syntax
* module/oop/goops.scm (define-generic, define-extended-generic):
(define-extended-generics): Reimplement using syntax-case.
---
module/oop/goops.scm | 55 ++++++++++++++++++++++++++++---------------------
1 files changed, 31 insertions(+), 24 deletions(-)
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 000294e..15bbf95 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -732,30 +732,37 @@
;; Apparently the desired semantics are that we extend previous
;; procedural definitions, but that if `name' was already a generic, we
;; overwrite its definition.
-(define-macro (define-generic name)
- (if (not (symbol? name))
- (goops-error "bad generic function name: ~S" name))
- `(define ,name
- (if (and (defined? ',name) (is-a? ,name <generic>))
- (make <generic> #:name ',name)
- (ensure-generic (if (defined? ',name) ,name #f) ',name))))
-
-(define-macro (define-extended-generic name val)
- (if (not (symbol? name))
- (goops-error "bad generic function name: ~S" name))
- `(define ,name (make-extended-generic ,val ',name)))
-
-(define-macro (define-extended-generics names . args)
- (let ((prefixes (get-keyword #:prefix args #f)))
- (if prefixes
- `(begin
- ,@(map (lambda (name)
- `(define-extended-generic ,name
- (list ,@(map (lambda (prefix)
- (symbol-append prefix name))
- prefixes))))
- names))
- (goops-error "no prefixes supplied"))))
+(define-syntax define-generic
+ (lambda (x)
+ (syntax-case x ()
+ ((define-generic name) (symbol? (syntax->datum #'name))
+ #'(define name
+ (if (and (defined? 'name) (is-a? name <generic>))
+ (make <generic> #:name 'name)
+ (ensure-generic (if (defined? 'name) name #f) 'name)))))))
+
+(define-syntax define-extended-generic
+ (lambda (x)
+ (syntax-case x ()
+ ((define-extended-generic name val) (symbol? (syntax->datum #'name))
+ #'(define name (make-extended-generic val 'name))))))
+
+(define-syntax define-extended-generics
+ (lambda (x)
+ (define (id-append ctx a b)
+ (datum->syntax ctx (symbol-append (syntax->datum a) (syntax->datum b))))
+ (syntax-case x ()
+ ((define-extended-generic (name ...) #:prefix (prefix ...))
+ (and (and-map symbol? (syntax->datum #'(name ...)))
+ (and-map symbol? (syntax->datum #'(prefix ...))))
+ (with-syntax ((((val ...)) (map (lambda (name)
+ (map (lambda (prefix)
+ (id-append name prefix name))
+ #'(prefix ...)))
+ #'(name ...))))
+ #'(begin
+ (define-extended-generic name (list val ...))
+ ...))))))
(define* (make-generic #:optional name)
(make <generic> #:name name))
- [Guile-commits] 02/88: Mark two coverage tests as XFAIL, (continued)
- [Guile-commits] 02/88: Mark two coverage tests as XFAIL, Andy Wingo, 2015/01/23
- [Guile-commits] 03/88: %compute-applicable-methods in Scheme, Andy Wingo, 2015/01/23
- [Guile-commits] 07/88: More useless goops.c code removal, Andy Wingo, 2015/01/23
- [Guile-commits] 05/88: Rewrite %method-more-specific? to be in Scheme, Andy Wingo, 2015/01/23
- [Guile-commits] 06/88: Remove unused macros in goops.c, Andy Wingo, 2015/01/23
- [Guile-commits] 04/88: Deprecate C interfaces scm_compute_applicable_methods, scm_find_method, Andy Wingo, 2015/01/23
- [Guile-commits] 09/88: %init-goops-builtins is an extension, not a global, Andy Wingo, 2015/01/23
- [Guile-commits] 10/88: Preparation for more GOOPS refactorings, Andy Wingo, 2015/01/23
- [Guile-commits] 08/88: compute-cpl implementation only in Scheme, Andy Wingo, 2015/01/23
- [Guile-commits] 14/88: Deprecate scm_basic_make_class, Andy Wingo, 2015/01/23
- [Guile-commits] 16/88: define-generic, define-extended-generic are hygienic syntax,
Andy Wingo <=
- [Guile-commits] 12/88: Remove declarations without definitions, Andy Wingo, 2015/01/23
- [Guile-commits] 17/88: Remove unused *goops-module* definition., Andy Wingo, 2015/01/23
- [Guile-commits] 20/88: Deprecate scm_no_applicable_method C export, Andy Wingo, 2015/01/23
- [Guile-commits] 23/88: Remove unused `default-slot-definition-class' <class> slot, Andy Wingo, 2015/01/23
- [Guile-commits] 24/88: Remove unused CPP defines naming <method> slots, Andy Wingo, 2015/01/23
- [Guile-commits] 15/88: `class' is a hygienic macro, Andy Wingo, 2015/01/23
- [Guile-commits] 22/88: Remove useless scm_s_slot_set_x export, Andy Wingo, 2015/01/23
- [Guile-commits] 11/88: Remove unused %fast-slot-ref / %fast-slot-set! from GOOPS, Andy Wingo, 2015/01/23
- [Guile-commits] 27/88: Remove hashset slots from GOOPS classes, Andy Wingo, 2015/01/23
- [Guile-commits] 25/88: Generics with setters have <applicable-struct-with-setter> layout, Andy Wingo, 2015/01/23