如何在 lisp 中用 if 形式定义递归 cond 宏?

How to define recursive cond macro with if form in lisp?

我想用 if 实现 cond(在诡计中使用 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 宏的解决方案。

大多数 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))

希望对你有用!


如果你喜欢的不是老式的不卫生的宏,而只是一个允许你以原始方式处理传入表单的宏系统,许多 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))))))

主要的 Scheme 实现根据它们用于低级宏的内容通常分为两个阵营:syntax-case 和显式重命名。 Racket、Chez Scheme、Guile等使用syntax-case。 CHICKEN、MIT Scheme、Chibi Scheme等使用显式重命名。所以你将无法在 Guile 中使用上面的显式重命名版本,因为它在 syntax-case 阵营中。

这是一个可用的 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))