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?
(Background: 15+ years developer in C, C++, C#, Perl, Python, you-name-it; first look into Haskell, Erlang and Scheme in 2009)
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)