#lang racket

(require "uniquify.scm")

(provide remove-complex-opera*)

; remove complex sub-expression
; the resulting code is either
; - (read)
; - a number literal
; - a symbol
; the three above are called in the following "simple terms"
; - (- x) where x is a simple term
; - (+ x y) where x and y are simple terms
; - (let ([var y]) z) where y and z are expressions
(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)
     (begin
      (define-values (exp-tmp exp-tmpcount) (rco-exp e tmpcount))
      (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount))
      (values `(let ([,var ,exp-tmp]) ,new-body)
              exp-tmpcount))]))

(define (get-unique-symbol tmpcount)
  (string->symbol (format "tmp.~a" 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 assoc-list exp-tmpcount) (rco-arg e tmpcount))
     (define new-tmpcount (+ exp-tmpcount 1))
     (define tmpname (get-unique-symbol new-tmpcount))
     (set! assoc-list (append assoc-list (list `(,tmpname (- ,new-exp)))))
     (values tmpname
             assoc-list
             new-tmpcount))]
   [`(,op ,e1 ,e2)
    #:when (or (eq? op `+) (eq? op `-))
    (begin
     (define-values (new-exp1 assoc-1 exp1-tmpcount) (rco-arg e1 tmpcount))
     (define-values (new-exp2 assoc-2 exp2-tmpcount) (rco-arg e2 exp1-tmpcount))
     (define assoc-list (append assoc-1 assoc-2))
     (define new-tmpcount (+ exp2-tmpcount 1))
     (define tmpname (get-unique-symbol new-tmpcount))
     (set! assoc-list (append assoc-list (list `(,tmpname (,op ,new-exp1 ,new-exp2)))))
     (values tmpname
             assoc-list
             new-tmpcount))]
   [`(let ([,var ,rexp]) ,body)
    (begin
     (define-values (new-exp exp-tmpcount) (rco-exp rexp tmpcount))
     (define-values (new-body new-tmpcount) (rco-exp body exp-tmpcount))
     (values `(let ([,var ,new-exp]) ,new-body)
             `()
             new-tmpcount))]))