Graph Rewriting

graph.scm

(define (print-code fmt code)
  (print
   (regexp-replace-all #/#<closure\s(.+?)>/ (format fmt code) "\\1")))


(define (root xs) (car xs))
(define (forest xs) (cdr xs))
(define (tree? xs) (pair? xs))
(define (tree root . forest)
  (cons root forest))

(define (rewrite t)
  (print-code "~S" t)
  (if (tree? t)
      (apply (root t) (forest t))
      t))


(define (true x y)
  (rewrite x))

(define (false x y)
  (rewrite y))


(define (kons h t)
  (lambda (f)
    (rewrite (tree f h t))))

(define (kar xs)
  (rewrite (tree (rewrite xs) true)))


(define (kdr xs)
  (rewrite (tree (rewrite xs) false)))


(define (plus x y)
  (+ (rewrite x)
     (rewrite y)))


(define example
  `(,true (,plus 5 (,kar (,kdr (,kons 1 (,kons 2 '())))))
          :sad))

#|
(= true  x y x) -----------> (define (true  x y)  (rewrite x))
(= false x y y) -----------> (define (false x y)  (rewrite y))
(= cons  h t f (f h t)) ---> (define (cons h t f) (rewrite `(,f ,h ,t)))
(= car   xs (xs true))  ---> (define (car xs)     (rewrite `(,(rewrite xs) ,true)))
(= cdr   xs (xs false)) ---> (define (cdr xs)     (rewrite `(,(rewrite xs) ,false)))
|#

(print (rewrite example))