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)
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.
精彩评论