## Sunday, 21 December 2008

### Common Subexpression Elimination

`;; My example of when mutation is a useful tool that simplifies things.(define (identity i) i)(define (concat xs) (apply append xs))(define (concat-map f x) (concat (map f x)))(define (sort by xs)  (define (insert by x xs)    (if (null? xs)        (list x)        (if (< (by x) (by (car xs)))            (cons x xs)            (cons (car xs) (insert by x (cdr xs))))))  (if (null? xs) '()      (insert by (car xs) (sort by (cdr xs)))));; <variadic-tree> ::= <leaf> | (<variadic-tree> ...);; <leaf> is any non-list datum(define (leaf? datum) (not (list? datum)))(define (variadic-tree leaf nodes)  (lambda (tree)    (if (leaf? tree)        (leaf tree)        (apply nodes (map (variadic-tree leaf nodes) tree)))))(define copy-tree (variadic-tree identity list))(define exp-1  (copy-tree   '(+ (* (- x-1 x-2) (- x-1 x-2))       (* (- y-1 y-2) (- y-1 y-2))       (* (- z-1 z-2) (- z-1 z-2)))))(define (splat tree)  (if (leaf? tree)      '()      (cons tree (concat-map splat tree))))(define (subexpressions tree) (sort length (cdr (splat tree))))(define (eliminate exp sub sym)  (cond ((null? exp) exp)        ((leaf? exp) exp)        ((cond ((equal? sub (car exp)) (set-car! exp sym))               (else (eliminate (car exp) sub sym)))         (eliminate (cdr exp) sub sym)         exp)))(define gensym  (let ((n 0))    (lambda ()      (set! n (+ n 1))      (string->symbol (string-append "g" (number->string n))))))(define (eliminate-subexpressions env exp subs)  (cond ((null? subs) `(let ,(reverse env) ,exp))        (else         (let* ((g (gensym))                (sub (car subs))                (exp-2 (eliminate exp sub g)))           (eliminate-subexpressions (cons (list g sub) env) exp-2 (subexpressions exp-2))))));; (eliminate-subexpressions '() exp-1 (subexpressions exp-1));; =>;; (let ((g1 (- z-1 z-2));;       (g2 (* g1 g1));;       (g3 (- y-1 y-2));;       (g4 (* g3 g3));;       (g5 (- x-1 x-2));;       (g6 (* g5 g5)));;   (+ g6 g4 g2))`