(in-package #:user-side-compiler)

(defun optim-reuse-temporary-slots (start-iblock allocations)
  (let ((free '()))
    (do-iblocks (iblock start-iblock)
      (do-instructions (inst iblock)
        (let ((ending (find inst allocations
                            :key (alexandria:compose #'last-use
                                                     #'data)))
              (beginning (find (output inst) allocations :key #'data)))
          (cond ((and ending
                      (eql (strategy ending) :temporary-variable)
                      (not (null (varvec-index ending))))
                 (pushnew (varvec-index ending) free))
                ((and beginning
                      (eql (strategy beginning) :temporary-variable)
                      (not (null (varvec-index beginning)))
                      (not (null free)))
                 (setf (varvec-index beginning) (pop free)))))))))

(defun optim-prepare-direct-instructions (iblock)
  (do-instructions (inst iblock)
    (when (typep inst 'ir-operation)
      (assert (= (length (inputs inst)) 2))
      (destructuring-bind (accumulator operand)
          (inputs inst)
        (when (typep (definition accumulator) '(or ir-fetchvar ir-getconst))
          (move-instruction-above (definition accumulator) inst))
        (when (typep (definition operand) '(or ir-fetchvar ir-getconst))
          (when (typep (definition operand) 'ir-fetchvar)
            (setf (inputs inst)
                  (substitute (input (definition operand)) operand
                              (inputs inst))))
          (delete-instruction (definition operand)))))))

(defparameter *operation-routines*
  '((ir-mult . "mult")
    (ir-div . "div")))

(defun pre-assembly-software-operations (start-iblock)
  (do-iblocks (ib start-iblock)
    (do-instructions (inst ib)
      (when (member (type-of inst) *operation-routines* :key #'car)
        (let ((inputs (inputs inst))
              (output (output inst))
              (implementation (get-asm-function
                               (cdr (assoc (type-of inst)
                                           *operation-routines*)))))
          (setf (inputs inst) '()
                (output inst) nil)
          (let ((new (make-instance 'ir-call
                                    :callee implementation
                                    :inputs inputs :output output)))
            (insert-instruction-above new inst)
            (delete-instruction inst)
            ;; To ensure that the code walking continues correctly
            (setf inst new)))))))

(defun pre-assembly (iblock)
  (pre-assembly-software-operations iblock)
  (optim-prepare-direct-instructions iblock)
  (let ((allocs (allocate-values iblock)))
    (optim-reuse-temporary-slots iblock allocs)
    allocs))