我有一个在2010年编写的宏,它用于使用Alists在Common Lips中管理结构(这里是包含功能https://jcubic.pl/struct.txt的整个文件)。
(define-macro (defstruct name . fields)
"Macro implementing structures in guile based on assoc list."
(let ((names (map (lambda (symbol) (gensym)) fields))
(struct (gensym))
(field-arg (gensym)))
`(if (not (every-unique ',fields))
(error 'defstruct "Fields must be unique")
(begin
(define (,(make-name name) ,@names)
(map cons ',fields (list ,@names)))
,@(map (lambda (field)
`(define (,(make-getter name field) ,struct)
(cdr (assq ',field ,struct)))) fields)
,@(map (lambda (field)
`(define (,(make-setter name field) ,struct ,field-arg)
(assq-set! ,struct ',field ,field-arg)
,field-arg)) fields)
(define (,(make-predicate name) ,struct)
(and (struct? ,struct)
(let ((result #t))
(for-each (lambda (x y)
(if (not (eq? x y)) (set! result #f)))
',fields
(map car ,struct))
result)))))))
一切正常。我最近用JavaScript更新了这个宏(它是基于scheme的),当我调用它时,它返回了false
,想知道这是否可以在guile中工作。但是事实证明,它根本不起作用。它显示此错误:
编译表达式时:错误:语法错误:未知位置: 表达式上下文中的定义,其中不允许定义, 格式(define(make-point#{g746}##{g747}#)(map cons(quote(x y))(列表#{g746}##{g747}#))
为什么我有此错误以及如何解决它,所以它再次在guile中工作?我很久以前不记得如何测试此代码,但是使用装入功能打开guile或将代码复制粘贴到解释器中都会产生相同的错误。
我正在GNU / Linux上使用guile 2.0.14。
PS:我更喜欢使用lisp宏IMO,它们优于怪异的方案卫生宏。
答案 0 :(得分:2)
现代guile方案似乎没有将if作为有效的选项开始新的定义上下文。这可能是错误的,或者与方案规范没有更好的一致性。但是以下示例代码显示了针对最新guile修复代码的技术(您可能需要创建define-values,因为它是guile的最新功能。在guile中使用lisps宏的PS是一种麻烦,它会让您进入麻烦的是,如果您打算进行大量的计划,那么宏就像是parens,如果您习惯了,就会感到自然。
这是代码,
(define-macro (defstruct name . fields)
"Macro implementing structures in guile based on assoc list."
(let* ((names (map (lambda (symbol) (gensym)) fields))
(struct (gensym))
(field-arg (gensym))
(sname (make-name name))
(predname (make-predicate name))
(getnames (map (lambda (f) (make-getter name f)) fields))
(setnames (map (lambda (f) (make-setter name f)) fields)))
`(define-values (,sname ,predname ,@getnames ,@setnames)
(if (not (every-unique ',fields))
(error 'defstruct "Fields must be unique")
(let ()
(define (,sname ,@names)
(map cons ',fields (list ,@names)))
,@(map (lambda (field)
`(define (,(make-getter name field) ,struct)
(cdr (assq ',field ,struct)))) fields)
,@(map (lambda (field)
`(define (,(make-setter name field) ,struct ,field-arg)
(assq-set! ,struct ',field ,field-arg)
,field-arg)) fields)
(define (,predname ,struct)
(and (struct? ,struct)
(let ((result #t))
(for-each (lambda (x y)
(if (not (eq? x y)) (set! result #f)))
',fields
(map car ,struct))
result)))
(values ,sname ,predname ,@getnames ,@setnames))))))
这是define-values
的一个版本(请查看#'
之后的代码以查看其功能)
(define-syntax define-values
(lambda (x)
(syntax-case x ()
((_ (f ...) code ...)
(with-syntax (((ff ...) (generate-temporaries #'(f ...))))
#'(begin
(define f #f)
...
(call-with-values (lambda () code ...)
(lambda (ff ...)
(set! f ff)
...))))))))