#lang racket

(require "uniquify.scm")

(provide remove-complex-opera*)

(define (remove-complex-opera* p)
  (let ([uniq-res (uniquify p)])
       (match (cadr uniq-res)
         [`(program ,data ,exp) 
          (begin
            (define initial-tmpcount (hash-ref (car uniq-res) `tmp 0))
            (define-values (new-exp bla) (rco-exp exp initial-tmpcount))
            `(program ,data ,new-exp))])))

(define (let-binding var val exp)
  `(let ([,var ,val]) ,exp))

(define (wrap-associations assoc-list exp)
  (if (empty? assoc-list)
    exp
    (let ([binding (car assoc-list)])
      (let-binding (car binding) (cadr binding)
                   (wrap-associations (cdr assoc-list) exp)))))
  
(define (rco-exp exp tmpcount)
  (match exp
    [(? fixnum?) (values exp tmpcount)]
    [(? symbol?) (values exp tmpcount)]
    [`(read) (values exp tmpcount)]
    [`(- ,e) 
     (begin
      (define-values (new-exp assoc-list new-tmpcount) (rco-arg e tmpcount))
      (values (wrap-associations assoc-list `(- ,new-exp)) new-tmpcount))]
    [`(,op ,e1 ,e2)
     #:when (or (eq? op `+) (eq? op `-))
     (begin
      (define-values (new-exp1 assoc-list1 new-tmpcount1) (rco-arg e1 tmpcount))
      (define-values (new-exp2 assoc-list2 new-tmpcount) (rco-arg e2 new-tmpcount1))
      (values (wrap-associations (append assoc-list1 assoc-list2)
                                 `(,op ,new-exp1 ,new-exp2)) new-tmpcount))]
    [`(let ([,var ,e]) ,body)
      (define-values (new-exp assoc-list exp-tmpcount) (rco-arg e tmpcount))
      (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount))
      (values (wrap-associations assoc-list
                                 `(let ([,var ,new-exp]) ,new-body)) new-tmpcount)]))

(define (get-unique-symbol tmpcount)
  (string->symbol (format "tmp.~a" tmpcount)))

(define (let-unique-exp tmpcount value)
  (let-binding (get-unique-symbol tmpcount)
               exp
               (get-unique-symbol tmpcount)))

(define (rco-arg exp tmpcount)
  (match exp
   [(? fixnum?) (values exp '() tmpcount)]
   [(? symbol?) (values exp '() tmpcount)]
   [`(read) (values exp '() tmpcount)]
   [`(- ,e)
    (begin
     (define-values (new-exp exp-tmpcount) (rco-exp e tmpcount))
     (define new-tmpcount (+ exp-tmpcount 1))
     (define tmpname (get-unique-symbol new-tmpcount))
     (values tmpname
             `((,tmpname (- ,new-exp)))
             new-tmpcount))]
   [`(,op ,e1 ,e2)
    #:when (or (eq? op `+) (eq? op `-))
    (begin
     (define-values (new-exp1 exp1-tmpcount) (rco-exp e1 tmpcount))
     (define-values (new-exp2 exp2-tmpcount) (rco-exp e2 exp1-tmpcount))
     (define new-tmpcount (+ exp2-tmpcount 1))
     (define tmpname (get-unique-symbol new-tmpcount))
     (values tmpname
             `((,tmpname (,op ,new-exp1 ,new-exp2)))
             new-tmpcount))]
   [`(let ([,var ,rexp]) ,body)
    (begin
     (define-values (new-exp exp-tmpcount) (rco-exp rexp tmpcount))
     (define-values (new-body body-tmpcount) (rco-exp body exp-tmpcount))
     (define new-tmpcount (+ body-tmpcount 1))
     (define tmpname (get-unique-symbol new-tmpcount))
     (values tmpname
             `((,tmpname (let ([,var ,new-exp]) ,new-body)))
             new-tmpcount))]))
     

;(require racket/trace)
;(trace rco-exp)
;(trace rco-arg)