Lisp 运行基于规则的SICP模式匹配替换代码

我在网上找到了本课的代码(http://groups.csail.mit.edu/mac/ftpdir/6.001-fall91/ps4/matcher-from-lecture.scm)，我花了很长时间试着调试它。代码看起来与Sussman所写的非常相似：

;;; Scheme code from the Pattern Matcher lecture

;; Pattern Matching and Simplification

(define (match pattern expression dictionary)
  (cond ((eq? dictionary 'failed) 'failed)
        ((atom? pattern)
         (if (atom? expression)
             (if (eq? pattern expression)
                 dictionary
                 'failed)
             'failed))
        ((arbitrary-constant? pattern)
         (if (constant? expression)
             (extend-dictionary pattern expression dictionary)
             'failed))
        ((arbitrary-variable? pattern)
         (if (variable? expression)
             (extend-dictionary pattern expression dictionary)
             'failed))
        ((arbitrary-expression? pattern)
         (extend-dictionary pattern expression dictionary))
        ((atom? expression) 'failed)
        (else
         (match (cdr pattern)
                (cdr expression)
                (match (car pattern)
                       (car expression)
                       dictionary)))))

(define (instantiate skeleton dictionary)
  (cond ((atom? skeleton) skeleton)
        ((skeleton-evaluation? skeleton)
         (evaluate (evaluation-expression skeleton)
                   dictionary))
        (else (cons (instantiate (car skeleton) dictionary)
                    (instantiate (cdr skeleton) dictionary)))))

(define (simplifier the-rules)
  (define (simplify-exp exp)
    (try-rules (if (compound? exp)
                   (simplify-parts exp)
                   exp)))
  (define (simplify-parts exp)
    (if (null? exp)
        '()
        (cons (simplify-exp   (car exp))
              (simplify-parts (cdr exp)))))
  (define (try-rules exp)
    (define (scan rules)
      (if (null? rules)
          exp
          (let ((dictionary (match (pattern (car rules))
                                   exp
                                   (make-empty-dictionary))))
            (if (eq? dictionary 'failed)
                (scan (cdr rules))
                (simplify-exp (instantiate (skeleton (car rules))
                                           dictionary))))))
    (scan the-rules))
  simplify-exp)

;; Dictionaries 

(define (make-empty-dictionary) '())

(define (extend-dictionary pat dat dictionary)
  (let ((vname (variable-name pat)))
    (let ((v (assq vname dictionary)))
      (cond ((null? v)
             (cons (list vname dat) dictionary))
            ((eq? (cadr v) dat) dictionary)
            (else 'failed)))))

(define (lookup var dictionary)
  (let ((v (assq var dictionary)))
    (if (null? v)
        var
        (cadr v))))

;; Expressions

(define (compound? exp) (pair?   exp))
(define (constant? exp) (number? exp))
(define (variable? exp) (atom?   exp))

;; Rules

(define (pattern  rule) (car  rule))
(define (skeleton rule) (cadr rule))

;; Patterns

(define (arbitrary-constant?    pattern)
  (if (pair? pattern) (eq? (car pattern) '?c) false))

(define (arbitrary-expression?  pattern)
  (if (pair? pattern) (eq? (car pattern) '? ) false))

(define (arbitrary-variable?    pattern)
  (if (pair? pattern) (eq? (car pattern) '?v) false))

(define (variable-name pattern) (cadr pattern))

;; Skeletons & Evaluations

(define (skeleton-evaluation?    skeleton)
  (if (pair? skeleton) (eq? (car skeleton) ':) false))

(define (evaluation-expression evaluation) (cadr evaluation))


;; Evaluate (dangerous magic)

(define (evaluate form dictionary)
  (if (atom? form)
      (lookup form dictionary)
      (apply (eval (lookup (car form) dictionary)
                   user-initial-environment)
             (mapcar (lambda (v) (lookup v dictionary))
                     (cdr form)))))

;;
;; A couple sample rule databases...
;;

;; Algebraic simplification

(define algebra-rules
  '(
    ( ((? op) (?c c1) (?c c2))                (: (op c1 c2))                )
    ( ((? op) (?  e ) (?c c ))                ((: op) (: c) (: e))          )
    ( (+ 0 (? e))                             (: e)                         )
    ( (* 1 (? e))                             (: e)                         )
    ( (* 0 (? e))                             0                             )
    ( (* (?c c1) (* (?c c2) (? e )))          (* (: (* c1 c2)) (: e))       )
    ( (* (?  e1) (* (?c c ) (? e2)))          (* (: c ) (* (: e1) (: e2)))  )
    ( (* (* (? e1) (? e2)) (? e3))            (* (: e1) (* (: e2) (: e3)))  )
    ( (+ (?c c1) (+ (?c c2) (? e )))          (+ (: (+ c1 c2)) (: e))       )
    ( (+ (?  e1) (+ (?c c ) (? e2)))          (+ (: c ) (+ (: e1) (: e2)))  )
    ( (+ (+ (? e1) (? e2)) (? e3))            (+ (: e1) (+ (: e2) (: e3)))  )
    ( (+ (* (?c c1) (? e)) (* (?c c2) (? e))) (* (: (+ c1 c2)) (: e))       )
    ( (* (? e1) (+ (? e2) (? e3)))            (+ (* (: e1) (: e2))
                                                 (* (: e1) (: e3)))         )
    ))

(define algsimp (simplifier algebra-rules))

;; Symbolic Differentiation

(define deriv-rules
  '(
    ( (dd (?c c) (? v))              0                                 )
    ( (dd (?v v) (? v))              1                                 )
    ( (dd (?v u) (? v))              0                                 )
    ( (dd (+ (? x1) (? x2)) (? v))   (+ (dd (: x1) (: v))
                                        (dd (: x2) (: v)))             )
    ( (dd (* (? x1) (? x2)) (? v))   (+ (* (: x1) (dd (: x2) (: v)))
                                        (* (dd (: x1) (: v)) (: x2)))  )
    ( (dd (** (? x) (?c n)) (? v))   (* (* (: n) (+ (: x) (: (- n 1))))
                                        (dd (: x) (: v)))              )
    ))

(define dsimp (simplifier deriv-rules))

(define scheme-rules
  '(( (square (?c n)) (: (* n n)) )
    ( (fact 0) 1 )
    ( (fact (?c n)) (* (: n) (fact (: (- n 1)))) )
    ( (fib 0) 0 )
    ( (fib 1) 1 )
    ( (fib (?c n)) (+ (fib (: (- n 1)))
                      (fib (: (- n 2)))) )
    ( ((? op) (?c e1) (?c e2)) (: (op e1 e2)) ) ))

(define scheme-evaluator (simplifier scheme-rules))

我用R5RS在DrRacket中运行它，我遇到的第一个问题是atom？是一个未定义的标识符。因此，我发现我可以添加以下内容：

    (define (atom? x) ; atom? is not in a pair or null (empty)
    (and (not (pair? x))
    (not (null? x))))

(dsimp '(dd (+ x y) x))

然后，我试图找出如何实际运行这只野兽，因此我再次观看了视频，并看到他使用以下命令：

    (define (atom? x) ; atom? is not in a pair or null (empty)
    (and (not (pair? x))
    (not (null? x))))

(dsimp '(dd (+ x y) x))

正如苏斯曼所说，我应该回去（+10）。相反，使用R5R时，我似乎在以下行中断了extend dictionary过程：

((eq? (cadr v) dat) dictionary) 

它返回的具体错误是：mcdr:expected参数类型为可变对；给定#f

当使用neil/sicp时，我在生产线上打断了评估程序：

(apply (eval (lookup (car form) dictionary)
                   user-initial-environment)

它返回的具体错误是：用户初始环境中的模块中的未绑定标识符

---

所以，说了这么多，我非常感谢你的帮助，或者是在正确的方向上的一个良好的推动。谢谢

您的代码来自1991年。自1998年R5RS问世以来，必须为R4RS（或更早版本）编写代码。 R4RS和更高版本方案之间的区别之一是，空列表在R4RS中被解释为false，在R5RS中被解释为true

例如：

  (if '() 1 2)

R5RS中给出1，但R4RS中给出2

因此，assq之类的过程可以返回“（）”而不是false。 这就是为什么需要将扩展目录的定义更改为：

(define (extend-dictionary pat dat dictionary)
  (let ((vname (variable-name pat)))
    (let ((v (assq vname dictionary)))
      (cond ((not v)
             (cons (list vname dat) dictionary))
            ((eq? (cadr v) dat) dictionary)
            (else 'failed)))))

在那个时候，地图也被称为地图车。只需将mapcar替换为map即可

您在DrRacket中看到的错误是：

mcdr: expects argument of type <mutable-pair>; given '()

R4RS（或1991年的麻省理工学院计划？）的另一个变化

附录：

这段代码几乎可以运行。 在DrRacket中为其添加前缀：

#lang r5rs
(define false #f)
(define user-initial-environment (scheme-report-environment 5))
(define mapcar map)

在扩展目录中，将（null？v）更改为（非v）。 这至少适用于简单表达式。

是我在mit scheme（9.1.1版）中使用的代码。

您也可以使用。它靠拍子跑

要在没有错误的情况下运行“eval”，需要添加以下内容

(define ns (make-base-namespace))
(apply (eval '+ ns) '(1 2 3))

---

谢谢你的回复！我使用的是neil/sicp，但我觉得提供两者不同的错误是有益的。我按照建议进行了调整，这导致了一些“错误”错误，我尝试将其改为#f，这导致了另一个可变的付费错误在一天结束的时候，我想我只是想学习代码，但我找不到有效的代码。您知道本视频课程中有哪些可用代码吗？根据您的建议，我肯定会继续尝试一次使用一个函数，但对于我目前的lisp专业知识来说，这是一个相当令人兴奋的代码。我添加了一个指向Brandeis使用的更新版本的链接。是的！我真的，真的很感激。非常感谢你。