如何在lisp中使用if表单定义递归cond宏?

时间:2016-07-16 19:40:03

标签: macros scheme lisp common-lisp guile

我想用if实现cond(在guile中使用lisp宏),这是我的尝试:

(define-macro (cond . clauses)
  (if (pair? clauses)
      (let ((first (car clauses)) (rest (cdr clauses)))
         `(if ,(car first)
              (begin
                 ,@(cdr first))
              ,(if (equal? (caar rest) 'else)
                  ',(cadr rest)
                   `(cond ,rest))))))

但是当我用这段代码调用它时它不起作用:

(cond ((= 1 0) (display "hello"))
      ((= 1 1) (display "world"))
      (else
        (display "foo")))

我收到了这个错误:

ERROR: In procedure car: Wrong type argument in position 1 (expecting pair): ()

为什么我收到此错误以及如何解决此问题?我更喜欢使用lisp宏的解决方案。

2 个答案:

答案 0 :(得分:4)

大多数Scheme程序员,包括我自己,都不喜欢使用define-macro,因为它完全不卫生。我不知道你为什么喜欢使用它们。考虑到这一点(我不会自己编写任何define-macro个宏),我在its implementation of cond上围绕Femtolisp(类似Scheme的实现,也不使用卫生宏):

(define-macro (cond . clauses)
  (define (cond-clauses->if lst)
    (if (atom? lst)
        #f
        (let ((clause (car lst)))
          (if (or (eq? (car clause) 'else)
                  (eq? (car clause) #t))
              (if (null? (cdr clause))
                  (car clause)
                  (cons 'begin (cdr clause)))
              (if (null? (cdr clause))
                  ; test by itself
                  (list 'or
                        (car clause)
                        (cond-clauses->if (cdr lst)))
                  ; test => expression
                  (if (eq? (cadr clause) '=>)
                      (if (1arg-lambda? (caddr clause))
                          ; test => (lambda (x) ...)
                          (let ((var (caadr (caddr clause))))
                            `(let ((,var ,(car clause)))
                               (if ,var ,(cons 'begin (cddr (caddr clause)))
                                   ,(cond-clauses->if (cdr lst)))))
                          ; test => proc
                          (let ((b (gensym)))
                            `(let ((,b ,(car clause)))
                               (if ,b
                                   (,(caddr clause) ,b)
                                   ,(cond-clauses->if (cdr lst))))))
                      (list 'if
                            (car clause)
                            (cons 'begin (cdr clause))
                            (cond-clauses->if (cdr lst)))))))))
  (cond-clauses->if clauses))

希望它适合你!

如果你喜欢的不是旧式的不卫生的宏,而只是一个允许你在raw中使用传入表单的宏系统,许多Scheme实现提供了一个显式重命名(ER)宏系统,它允许你直接操作表单,并且仍然允许您通过(顾名思义)显式重命名任何应该受到宏调用站点的阴影保护的标识符来保持卫生。这是Chibi Scheme's implementation of cond

(define-syntax cond
  (er-macro-transformer
   (lambda (expr rename compare)
     (if (null? (cdr expr))
         (if #f #f)
         ((lambda (cl)
            (if (compare (rename 'else) (car cl))
                (if (pair? (cddr expr))
                    (error "non-final else in cond" expr)
                    (cons (rename 'begin) (cdr cl)))
                (if (if (null? (cdr cl)) #t (compare (rename '=>) (cadr cl)))
                    (list (list (rename 'lambda) (list (rename 'tmp))
                                (list (rename 'if) (rename 'tmp)
                                      (if (null? (cdr cl))
                                          (rename 'tmp)
                                          (list (car (cddr cl)) (rename 'tmp)))
                                      (cons (rename 'cond) (cddr expr))))
                          (car cl))
                    (list (rename 'if)
                          (car cl)
                          (cons (rename 'begin) (cdr cl))
                          (cons (rename 'cond) (cddr expr))))))
          (cadr expr))))))

主要方案实施通常根据它们用于低级宏的内容分为两个阵营:syntax-case和显式重命名。球拍,Chez Scheme,Guile等使用syntax-case。 CHICKEN,MIT Scheme,Chibi Scheme等使用显式重命名。因此,您将无法在Guile中使用上面的显式重命名版本,因为它位于syntax-case阵营中。

答案 1 :(得分:2)

这是一个有效的Lisp版本:

(defmacro mycond (&rest clauses)
  (if (consp clauses)
      (destructuring-bind ((pred . forms) . rest-clauses) clauses
        `(if ,pred
             (progn ,@forms)
           ,(if (and (consp rest-clauses)
                     (eq (caar rest-clauses) 't))
                `(progn ,@(cdar rest-clauses))
              `(mycond ,@rest-clauses))))
    nil))

您可以看到修复了四个错误:

  • 逗号不在反引号中
  • 其余条款需要拼接
  • 默认T子句需要插入代码
  • 不要覆盖内置的COND

扩展示例:

CL-USER 67 > (walker:walk-form '(mycond ((= 1 0) (write "hello"))
                                        ((= 1 1) (write "world"))
                                        (t       (write "foo"))))

(IF (= 1 0)
    (PROGN (WRITE "hello"))
  (IF (= 1 1)
      (PROGN (WRITE "world"))
    (PROGN (WRITE "foo"))))

稍微简单的版本:

(defmacro mycond (&rest clauses)
  (if (consp clauses)
      (destructuring-bind ((pred . forms) . rest-clauses) clauses
        (if (eq pred t)
            `(progn ,@forms)
          `(if ,pred
               (progn ,@forms)
             (mycond ,@rest-clauses))))
    nil))