;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.excosy)

;;;;;;
;;; Assembler

(def (function e) assemble-excosy (machine binary-ast &key stream)
  (if (null stream)
      (with-output-to-string (stream)
        (assemble-excosy machine binary-ast :stream stream))
      (bind ((walked-ast (walk-form binary-ast)))
        (format stream "define i32 @main() {~%")
        (assemble-ast walked-ast stream)
        (format stream "}"))))

(def generic assemble-ast (ast stream)
  (:method ((ast implicit-progn-mixin) stream)
    (prog1-bind result nil
      (dolist (child-ast (body-of ast))
        (setf result (assemble-ast child-ast stream)))))

  (:method ((ast constant-form) stream)
    (when (value-of ast)
      (format nil "~A" (value-of ast))))

  (:method ((ast free-application-form) stream)
    (bind ((arguments (arguments-of ast)))
      (flet ((assemble-argument (n)
               (assemble-ast (elt arguments n) stream))
             (assemble-arguments-from (n)
               (iter (for argument :in (nthcdr n arguments))
                     (collect (assemble-ast argument stream)))))
        (ecase (operator-of ast)
          (llvm/type
           (string+ (case (value-of (second arguments))
                      (:void (format nil "void"))
                      (:signed-integer (format nil "i~A" (assemble-argument 2)))
                      (:unsigned-integer (format nil "u~A" (assemble-argument 2))))
                    (bind ((dereference-count (elt arguments 3)))
                      (when (and dereference-count
                                 (value-of dereference-count))
                        (make-string (value-of dereference-count) :initial-element #\*)))))
          (llvm/register
           (format nil "%~A" (assemble-argument 1)))
          (llvm/label
           (format stream "~A:~%" (string-downcase (assemble-argument 1))))
          (llvm/label-reference
           (format nil "%~A" (string-downcase (assemble-argument 1))))
          (llvm/alloca
           (format stream "        ~A = alloca ~A~%" (assemble-argument 1) (assemble-argument 2)))
          (llvm/load
           (format stream "        ~A = load ~A ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3)))
          (llvm/store
           (format stream "        store ~A ~A, ~A ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/icmp
           (format stream "        icmp ~%"))
          (llvm/ret
           (format stream "        ret ~A ~A~%" (assemble-argument 1) (assemble-argument 2)))
          (llvm/conditional-br
           (format stream "        br i1 ~A, label ~A, label ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3)))
          (llvm/unconditional-br
           (format stream "        br label ~A~%" (assemble-argument 1)))
          (llvm/switch
           (format stream "        switch i32 ~A, label ~A [ i32 ~A, label ~A i32 ~A, label ~A ]~%"
                   (assemble-argument 1) (assemble-argument 2) (assemble-argument 3)
                   (assemble-argument 4) (assemble-argument 5) (assemble-argument 6)))
          (llvm/phi
           (format stream "        ~A = phi ~A [ ~A, ~A ], [ ~A, ~A ], [ ~A, ~A ]~%"
                   (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)
                   (assemble-argument 5) (assemble-argument 6) (assemble-argument 7) (assemble-argument 8)))
          (llvm/add
           (format stream "        ~A = add ~A ~A, ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/sub
           (format stream "        ~A = sub ~A ~A, ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/declare
           (format stream "declare ~A @~A(~{~A~^, ~})~%" (assemble-argument 1) (assemble-argument 2) (assemble-arguments-from 3)))
          (llvm/call
           (aif (assemble-argument 1)
                (format stream "        ~A = call ~A @~A(~{~A ~A~^, ~})~%" it (assemble-argument 2) (assemble-argument 3) (assemble-arguments-from 4))
                (format stream "        call ~A @~A(~{~A ~A~^, ~})~%"  (assemble-argument 2) (assemble-argument 3) (assemble-arguments-from 4))))
          (llvm/getelementptr
           (format stream "        ~A = getelementptr ~A ~A, ~A ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4) (assemble-argument 5)))
          (llvm/malloc
           (format stream "        ~A = malloc ~A, ~A ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/free
           (format stream "        free ~A ~A~%" (assemble-argument 1) (assemble-argument 2)))
          (llvm/trunc
           (format stream "        ~A = trunc ~A ~A to ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/zext
           (format stream "        ~A = zext ~A ~A to ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/sext
           (format stream "        ~A = sext ~A ~A to ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/ptrtoint
           (format stream "        ~A = ptrtoint ~A ~A to ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4)))
          (llvm/inttoptr
           (format stream "        ~A = inttoptr ~A ~A to ~A~%" (assemble-argument 1) (assemble-argument 2) (assemble-argument 3) (assemble-argument 4))))))))