a.scm

(import (scheme base)(scheme write)(scheme cxr)(srfi 1))

(define sample-input
  '((x = a * b)
    (y = x + c)
    (d = a * b)
    (e = d - c)
    (e = d + c)))


(define (get-id dag sym);DAG内の識別子のノードIDを取得する
  (cond 
    ((assv sym dag) => cadr)
    (else
      (let loop ((node dag))
        (cond 
          ((null? node) #f)
          ((memv sym (caddar node)) (cadar node))
          (else (loop (cdr node))))))))


(define (update-dag! dag expression id);DAGに式を追加する
  (cond ((get-id dag (car expression)) ;左辺の識別子が登録済みの場合、DAG上から外す
        =>(lambda (id)
            (let ((node (find (lambda (x) (= (cadr x) id)) dag)))
              (set-car! (cddr node) (delete (car expression) (caddr node)))))))
  
  (let ((node-label;頂点そのもののラベル
           `(,(cadddr expression) 
            ,(get-id dag (caddr expression)) 
            ,(get-id dag (cadddr (cdr expression))))))
    (cond 
      ((assoc node-label dag);すでに登録済みの場合
         => (lambda (node) 
              (set-car! (cddr node) (cons (car expression) (caddr node)));labelリストに式の左辺の識別子を追加する
              (values dag id)))
      (else 
        (values 
          (cons `(,node-label ,id (,(car expression)))
                dag)
          (+ id 1))))))


(define (create-dag input);DAGを生成する
  (let ((used-vars ;右辺にきて、左辺にはない識別子の集合
          (lset-difference 
            eqv? 
            (fold (lambda (x y) (lset-adjoin eqv? y x)) 
                  '() 
                  (append (map caddr input)(map (lambda (x) (cadddr (cdr x)))  input)))
            (fold (lambda (x y) (lset-adjoin eqv? y x)) '() (map car input)))))
    (let* ((dag ;DAGの初期値を計算する
             (let loop ((var used-vars)(id 0))
               (if (null? var)
                 '()
                 (cons `(,(car var) ,id ()) (loop (cdr var) (+ id 1 ))))))
           (id (length dag)));次に発行されるid
      ;inputからDAGを生成する
      (let loop ((i input)(id id))
        (if (null? i) 
          dag
          (let-values (((new-dag new-id) (update-dag! dag (car i) id )))
             (set! dag new-dag)
             (loop (cdr i) new-id)))))))



(let ((dag (create-dag sample-input)))
  (let ((ret '())(unnecessary-node '())(used-label '())(stack '()))
    ;idから代入すべきデータを得る。
    (define (get-val id)
      (cond 
        ((assv id  used)
           => cdr)
        ((find (lambda (x) (= (cadr x) id)) unnecessary-node)
           =>(lambda (node)
               (set! stack (cons node stack))
               #f))
        (else
          (set! stack (cons (find (lambda (x) (= (cadr x) id)) dag) stack)))))


    (let loop ((node dag))
      (cond 
        ((null? node) '())
        ((pair? (car node)) 
         (if (null? (caddr (car node)))
           (begin (set! unnecessary-node (cons (car node) unnecessary-node)) (loop (cdr node)))
           (let ((v1 (get-val (cadr (car node))))
                 (v2 (get-val (cadddr (car node)))))

             '())))
        (else (loop (cdr node)))
      ))))