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

Question

I want to implement cond (using lisp macros in guile) with if, this my attempt:

(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))))))

but it don't work, when I call it with this code:

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

I got this error:

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

why I got this error and how to fix it? I prefer solution with lisp macros.

Answer 1

大多数 Scheme 程序员，包括我自己，都不喜欢使用define-macro，因为它完全不卫生。我不知道你为什么更喜欢使用它们。考虑到这一点（我不会define-macro自己编写任何宏），我仔细研究了 Femtolisp（一个类似 Scheme 的实现，它也不使用卫生宏）来实现cond：

(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) 宏系统，它允许您操作表单直接并仍然允许您通过（顾名思义）显式重命名任何应该被宏调用站点保护免于隐藏的标识符来保持卫生。这是赤壁计划的实施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营地中。