开发者

Multiple (define)s in a CL style macro

开发者 https://www.devze.com 2023-01-14 11:29 出处:网络
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

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 defines 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)


You don't need eval here; use begin instead to group those definitions together into a list; i.e., the template to be expanded should be of the form:

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

Edit:

Change for-each to map as suggested by OP.

0

精彩评论

暂无评论...
验证码 换一张
取 消