我目前正在学习如何在Scheme中编写CL样式宏(define-macro)。举个简单的例子,我写了一个struct
宏来定义make-thing
,thing?
,thing-field
访问器等函数。
现在我想在一个宏中组合多个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)
答案 0 :(得分:2)
这里你不需要eval
;使用begin
代替将这些定义组合成一个列表;即,要扩展的模板应采用以下形式:
`(begin
,@(map ...)
(define ...)
(define ...)
...)
按照OP的建议将for-each
更改为map
。