2

我有我在 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 中为我的 LIPS更新了这个宏（它基于方案），当我调用它时，它正在返回false并且想知道这是否是它在 guile 中的工作方式。但事实证明它根本不起作用。它显示了这个错误：

编译表达式时：错误：语法错误：未知位置：在表达式上下文中定义，其中不允许定义，形式为 (define (make-point #{ g746}# #{ g747}#) (map cons (quote (x y) ) (列表 #{ g746}# #{ g747}#))

为什么我有这个错误以及如何修复它，所以它再次以诡计工作？我很久以前不记得我是如何测试这段代码的，但是使用加载函数打开 guile 或将代码复制粘贴到解释器中都会给出相同的错误。

我在 GNU/Linux 上使用 guile 2.0.14。

PS：我更喜欢使用 lisp 宏 IMO，它们优于奇怪的方案卫生宏。

4

1 回答 1

2

看起来现代的诡计方案没有将 if 中的开始视为启动新定义上下文的有效选项。这可能是方案规范的错误或更好的对齐方式。但是下面的示例代码显示了为更新的 guile 修复代码的技术（您可能需要创建定义值，因为它是 guile 的最新添加。PS 在 guile 中使用 lisps 宏是一个障碍，它会让你进入麻烦如果你计划很多，宏就像括号，如果你习惯了它会感觉很自然。

这是代码，

(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)
                     ...))))))))
于 2019-04-15T10:23:41.973 回答