Несколько (определить) в макросе в стиле CL - PullRequest
Новая
       38

Несколько (определить) в макросе в стиле CL

2 голосов
/ 31 августа 2010

В настоящее время я учусь писать макросы в стиле CL (define-macro) в Scheme. В качестве простого примера я написал макрос 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)

1 Ответ

2 голосов
/ 31 августа 2010

Вам не нужно eval здесь; вместо этого используйте begin, чтобы сгруппировать эти определения в список; то есть расширяемый шаблон должен иметь форму: 

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

Edit:

Измените for-each на map в соответствии с предложением OP.

...