CL 风格宏中的多个(定义)
我目前正在学习如何在Scheme中编写CL风格的宏(define-macro)。作为一个简单的例子,我编写了一个 struct
宏,它定义了 make-thing
、thing?
、thing-field
等函数code> 访问器等等。
现在我想将多个 define
合并到一个宏中,但实际上只使用最后一个。目前我正在使用 eval
全局定义函数(?),但一定有更好的方法......有什么想法吗?
到目前为止的代码:
;(use-modules (ice-9 pretty-print))
(define-macro (struct name key table fields)
(for-each
(lambda (field)
(eval
`(define ,(string->symbol (string-append (symbol->string name) "-" (symbol->string field)))
(lambda (x)
(if (,(string->symbol (string-append (symbol->string name) "?")) x)
(cadr (assq (quote ,field) (cdr x)))
#f)))
(interaction-environment)))
fields)
(eval
`(define ,(string->symbol (string-append (symbol->string name) "?"))
(lambda (x)
(and
(list? x)
(eq? (car x) (quote ,name))
,@(map (lambda (field) `(assq (quote ,field) (cdr x))) fields)
#t)))
(interaction-environment))
(eval
`(define ,(string->symbol (string-append "make-" (symbol->string name)))
(lambda ,fields
(list (quote ,name)
,@(map (lambda (field) `(list (quote ,field) ,field)) fields))))
(interaction-environment))
(eval
`(define ,(string->symbol (string-append "save-" (symbol->string name)))
(lambda (x)
(if (,(string->symbol (string-append (symbol->string name) "?")) x)
(call-with-output-file ; TODO: In PLT mit zusaetzlichem Parameter #:exists 'replace
(string-append "data/" ,(symbol->string table) "/"
(,(string->symbol (string-append (symbol->string name) "-" (symbol->string key))) x))
(lambda (out) (write x out)))
#f)))
(interaction-environment))
`(define ,(string->symbol (string-append "get-" (symbol->string name)))
(lambda (id)
(let ((ret (call-with-input-file (string-append "data/" ,(symbol->string table) "/" id) read)))
(if (,(string->symbol (string-append (symbol->string name) "?")) ret)
ret
#f))))
; TODO: (define (list-customers . search-words) ...)
)
(struct customer id customers (id name name_invoice address_invoice zip_invoice city_invoice state_invoice))
;(pretty-print (macroexpand '(struct customer id customers (id name name_invoice address_invoice zip_invoice city_invoice state_invoice))))
;(newline)
(define c (make-customer "C-1001" "Doe, John" "John Doe" "Some-Street" "Some-Zip" "Some-City" "Germany"))
(write c)
(newline)
(write (customer-id c))
(newline)
(write (customer-name c))
(newline)
(save-customer c)
(write (get-customer "C-1001"))
(newline)
I'm currently learning how to write CL style macros (define-macro) in Scheme. As a simple example, I wrote a struct
macro that defines functions like make-thing
, thing?
, thing-field
accessors and so on.
Now I'd like to combine multiple define
s in a single macro, but only the last one is actually used. Currently I'm using eval
to define the functions globally (?), but there must be some better way... any ideas?
The code so far:
;(use-modules (ice-9 pretty-print))
(define-macro (struct name key table fields)
(for-each
(lambda (field)
(eval
`(define ,(string->symbol (string-append (symbol->string name) "-" (symbol->string field)))
(lambda (x)
(if (,(string->symbol (string-append (symbol->string name) "?")) x)
(cadr (assq (quote ,field) (cdr x)))
#f)))
(interaction-environment)))
fields)
(eval
`(define ,(string->symbol (string-append (symbol->string name) "?"))
(lambda (x)
(and
(list? x)
(eq? (car x) (quote ,name))
,@(map (lambda (field) `(assq (quote ,field) (cdr x))) fields)
#t)))
(interaction-environment))
(eval
`(define ,(string->symbol (string-append "make-" (symbol->string name)))
(lambda ,fields
(list (quote ,name)
,@(map (lambda (field) `(list (quote ,field) ,field)) fields))))
(interaction-environment))
(eval
`(define ,(string->symbol (string-append "save-" (symbol->string name)))
(lambda (x)
(if (,(string->symbol (string-append (symbol->string name) "?")) x)
(call-with-output-file ; TODO: In PLT mit zusaetzlichem Parameter #:exists 'replace
(string-append "data/" ,(symbol->string table) "/"
(,(string->symbol (string-append (symbol->string name) "-" (symbol->string key))) x))
(lambda (out) (write x out)))
#f)))
(interaction-environment))
`(define ,(string->symbol (string-append "get-" (symbol->string name)))
(lambda (id)
(let ((ret (call-with-input-file (string-append "data/" ,(symbol->string table) "/" id) read)))
(if (,(string->symbol (string-append (symbol->string name) "?")) ret)
ret
#f))))
; TODO: (define (list-customers . search-words) ...)
)
(struct customer id customers (id name name_invoice address_invoice zip_invoice city_invoice state_invoice))
;(pretty-print (macroexpand '(struct customer id customers (id name name_invoice address_invoice zip_invoice city_invoice state_invoice))))
;(newline)
(define c (make-customer "C-1001" "Doe, John" "John Doe" "Some-Street" "Some-Zip" "Some-City" "Germany"))
(write c)
(newline)
(write (customer-id c))
(newline)
(write (customer-name c))
(newline)
(save-customer c)
(write (get-customer "C-1001"))
(newline)
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(1)
这里不需要
eval
;使用begin
将这些定义组合到一个列表中;即,要扩展的模板应采用以下形式:编辑:
按照OP的建议将
for-each
更改为map
。You don't need
eval
here; usebegin
instead to group those definitions together into a list; i.e., the template to be expanded should be of the form:Edit:
Change
for-each
tomap
as suggested by OP.