CL样式宏中的多个(定义)s

时间:2010-08-31 07:07:09

标签: macros scheme lisp common-lisp

我目前正在学习如何在Scheme中编写CL样式宏(define-macro)。举个简单的例子,我写了一个struct宏来定义make-thingthing?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)

1 个答案:

答案 0 :(得分:2)

这里你不需要eval;使用begin代替将这些定义组合成一个列表;即,要扩展的模板应采用以下形式:

`(begin 
   ,@(map ...)
   (define ...)
   (define ...)
   ...)

编辑:

按照OP的建议将for-each更改为map