Выполнение кода подстановки на основе правил соответствия SICP
Я нашел код этого урока онлайн (http://groups.csail.mit.edu/mac/ftpdir/6.001-fall91/ps4/matcher-from-lecture.scm), и у меня чертовски много времени пытаясь отладить это. Код выглядит довольно сравнимо с тем, что написал Суссман:
;;; 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))
Я запускаю его в DrRacket с R5RS, и первой проблемой, с которой я столкнулся, был этот атом? был неопределенным идентификатором. Итак, я обнаружил, что могу добавить следующее:
(define (atom? x) ; atom? is not in a pair or null (empty)
(and (not (pair? x))
(not (null? x))))
Затем я попытался выяснить, как на самом деле запустить этого зверя, поэтому я снова посмотрел видео и увидел, что он использует следующее:
(dsimp '(dd (+ x y) x))
Как заявил Суссман, я должен вернуться (+ 1 0). Вместо этого, используя R5RS, мне кажется, что я нарушаю процедуру расширения словаря в строке:
((eq? (cadr v) dat) dictionary)
Конкретная ошибка, которую он возвращает: mcdr: ожидает аргумент типа mutable-pair; учитывая #f
При использовании neil / sicp я ломаю процедуру оценки в строке:
(apply (eval (lookup (car form) dictionary)
user-initial-environment)
Конкретная ошибка, которую он возвращает: несвязанный идентификатор в модуле: user-initial-environment
Итак, со всем этим, как я сказал, я был бы признателен за некоторую помощь или хороший толчок в правильном направлении. Спасибо!
3 ответа
Ваш код с 1991 года. Так как R5RS вышел в 1998 году, код должен быть написан для R4RS (или старше). Одно из различий между R4RS и более поздними схемами заключается в том, что пустой список был интерпретирован как ложный в R4RS и как истинный в R5RS.
Пример:
(if '() 1 2)
дает 1 в R5RS, но 2 в R4RS.
Таким образом, такие процедуры, как assq, могут возвращать '() вместо false. Вот почему вам нужно изменить определение exte-directory на:
(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. Просто замените mapcar на карту.
Ошибка, которую вы видели в DrRacket, была:
mcdr: expects argument of type <mutable-pair>; given '()
Это означает, что CDR получил пустой список. Поскольку в пустом списке нет cdr, это выдает сообщение об ошибке. Теперь DrRacket пишет mcdr вместо cdr, но пока игнорируйте это.
Лучший совет: просматривайте одну функцию за раз и проверяйте ее с помощью нескольких выражений в REPL. Это проще, чем понять все сразу.
Наконец, начните свою программу с:
(define user-initial-environment (scheme-report-environment 5))
Еще одно изменение от R4RS (или Схема MIT в 1991 году?).
Приложение:
Этот код http://pages.cs.brandeis.edu/~mairson/Courses/cs21b/sym-diff.scm почти работает. Префикс это в DrRacket с:
#lang r5rs
(define false #f)
(define user-initial-environment (scheme-report-environment 5))
(define mapcar map)
А в exten-directory измените (null? V) на (не v). По крайней мере, это работает для простых выражений.
Вы также можете использовать этот код. Он работает на ракетке.
Для запуска "eval" без ошибок необходимо добавить следующее
(define ns (make-base-namespace))
(apply (eval '+ ns) '(1 2 3))
Вот код, который работает для меня с мит-схемой (Выпуск 9.1.1).