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

(defun get-line-comment (line)
  (unless (zerop (length line))
    (let ((index
            (loop :with got-it-p := nil
                  :for index :from 0
                  :for char := (char line index)
                  :when (char= char #\;)
                    :do (setf got-it-p t)
                  :until (or (and got-it-p (char/= char #\;))
                             (= (1+ index) (length line)))
                  :finally (return
                             (if (= (1+ index) (length line))
                                 nil
                                 index)))))
      (unless (null index)
        (subseq line index)))))

(defun parse-asm-label (string)
  (flet
      ((name-char-p (char)
         (or (alphanumericp char) (char= char #\_))))
    (cond
      ((zerop (length string))
       nil)
      ;; if it's an assembler macro, check that it's .proc
      ((and (char= (char string 0) #\.)
            (string-equal (subseq string 0 5) ".proc")
            (whitespacep (char string 5)))
       (let* ((start (position-if-not #'whitespacep string :start 5))
              (end (position-if-not #'name-char-p string :start start)))
         (subseq string start end)))
      ;; Regular colon label (ROUTINE_NAME:)
      ((loop :for char :across string
             :until (char= char #\:)
             :always (name-char-p char))
       (subseq string 0 (position #\: string))))))

(defun asm-declaration-p (string)
  (let ((comment (get-line-comment string))
        (label (parse-asm-label string)))
    (and (search "user-procedure" comment :test #'char-equal) label)))

(defun parse-asm-declaration (string)
  (assert (asm-declaration-p string))
  (let ((routine-name (parse-asm-label string))
        (declaration (get-line-comment string)))
    (with-input-from-string (input declaration)
      (list routine-name
            (let ((*read-eval* nil)
                  (eof '#.(gensym)))
              (loop :for obj := (read input nil eof)
                    :until (eql obj eof)
                    :collect obj))))))

(defun find-declarations-in-listing (filepath)
  (with-open-file (stream filepath)
    (loop :for line := (read-line stream)
          :until (and (not (zerop (length line)))
                      (digit-char-p (char line 0))))
    (loop :for line := (read-line stream nil :eof)
          :until (eql line :eof)
          :for address := (parse-integer line :start 0 :end 6 :radix 16)
          :for main-text := (subseq line 24)
          :when (asm-declaration-p main-text)
            :collect (destructuring-bind (name declaration)
                         (parse-asm-declaration main-text)
                       (list name address declaration)))))

(defparameter *program-listing-filepath* #P"../../wip-hugo/program.lst")
(defparameter *program-build-filepath* #P"../../wip-hugo/build.sh")

(defun check-for-asm-build-script ()
  (do ((path *program-build-filepath*))
      ((probe-file path) path)
    (restart-case
        (error "Couldn't find assembly build script ~S." path)
      (use-value (filepath)
        :report "Specify a different path to the build script."
        :interactive (lambda ()
                       (format t "Enter new pathname (evaled): ")
                       (eval (read)))
        (setf path filepath)))))

(defun build-assembly-program ()
  (let ((script-path (check-for-asm-build-script))
        (current-dir (uiop:getcwd)))
    (unwind-protect
         (progn
           (uiop:chdir (make-pathname :defaults script-path
                                      :name nil :type nil))
           (uiop:run-program (namestring
                              (make-pathname :defaults script-path
                                             :directory '(:relative ".")))))
      (uiop:chdir current-dir))))

(defun check-for-assembly-listing ()
  (do ((listing *program-listing-filepath*))
      ((probe-file listing) listing)
    (restart-case
        (error "Couldn't find assembly listing ~S." listing)
      (build-program ()
        :report "Build the assembly program to generate listing."
        (build-assembly-program)))))

(defun populate-asm-functions ()
  (let* ((listing (check-for-assembly-listing))
         (routine-info (find-declarations-in-listing listing)))
    (loop :for (name address declaration) :in routine-info
          ;; TODO: Use declaration info
          :do (add-asm-function name address))))