sicp pattern matching - compound?

Question

I am watching the video lectures of SICP. Currently I am on 4A Pattern Matching and Rule Based Substitution.

So far, I found the Matcher and the Instantiator is easy. But I can't get my head into The simplifier.

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

I saw another question here on this topic which defined compound? in terms of pair?. But, Then what simplify-exp feeding to try-rules?

Answer 1

Figured it out. The rules are going to apply in every node as promised. You can vote to delete the question. But, I would add some explanation on how I made it working.

I changed some code. The original code seems written with some other semantic in mind. I added some commentary where I made some decision on my own.

#lang racket
;matcher
(define (match pat exp dict)
  (cond ((eq? dict 'failed) 'failed)
        ;matched
        ((and (null? pat) (null? exp)) dict)
        ;so far matched, but no more
        ((or (null? pat) (null? exp)) 'failed)
        ((atom? pat)
         (if (atom? exp)
             (if (eq? pat exp)
                 dict
                 'failed)
             'failed))
        ((pat-const? pat)
         (if (constant? exp)
             (extend-dict pat exp dict)
             'failed))
        ((pat-variable? pat)
         (if (variable? exp)
             (extend-dict pat exp dict)
             'failed))
        ((pat-exp? pat)
             (extend-dict pat exp dict))
        ((atom? exp) 'failed)
        (else
         (match (cdr pat)
                (cdr exp)
                (match (car pat) (car exp) dict)))))
(define (pat-const? pat)
  (eq? (car pat) '?c))
(define (pat-variable? pat)
  (eq? (car pat) '?v))
(define (pat-exp? pat)
  (eq? (car pat) '?))
(define constant? number?)
(define variable? symbol?)
;instantiator
(define (instantiate skeleton dict)
  (define (loop s)
    (cond ((atom? s) s)
          ;we cant run past the nil line
          ((null? s) '())
          ((skeleton-evaluation? s) (evaluate s dict))
          (else
           (cons (loop (car s)) (loop (cdr s))))))
  (loop skeleton))

(define (skeleton-evaluation? s)
  (eq? (car s) ':))
;made it simpler, no environment constant, sorry
(define (evaluate s dict)
  (let ((data (lookup (cadr s) dict)))
    (if (null? data)
        (display "error in rules. mismatch")
        (cadr data))))
;simplifier
(define (simplifier rules)
  (define (simplify-exp exp)
    (try-rules (if (list? exp)
                   (map simplify-exp exp)
                   exp)))
  (define (try-rules exp)
    (define (scan rule)
      (if (null? rule)
          exp
          (let ((dict (match (pattern (car rule)) exp (empty-dict))))
              (if (eq? dict 'failed)
                  (scan (cdr rule))
                  (simplify-exp (instantiate (skeleton (car rule)) dict))))))
    (scan rules))
  simplify-exp)

(define pattern car)
(define skeleton cadr)

;dictionary
(define (empty-dict)
  '())
(define (extend-dict pat exp dict)
  (let ((v (lookup (cadr pat) dict)))
    (if (null? v)
        (cons (list (cadr pat) exp) dict)
        (if (eq? (cadr v) exp)
            dict
            'failed))))
(define (lookup s dict)
  (cond ((null? dict) '())
        ((eq? (caar dict) s) (car dict))
        (else (lookup s (cdr dict)))))


;extend racket
(define (atom? a)
  (and (not (null? a)) (not (pair? a))))

And? you know what? It works :)