;;; verilog-align.el --- Align SystemVerilog port declarations -*- lexical-binding: t; -*-

;;; Commentary:
;; Align SystemVerilog port declarations, instantiations, and signal declarations.

;;; Code:

(require 'cl-lib)
(require 'subr-x)

(defun verilog-align--line-port-p (pos)
  (save-excursion
    (goto-char pos)
    (let ((line (buffer-substring-no-properties
                 (line-beginning-position)
                 (line-end-position))))
      (string-match-p "^\\s-*\\(input\\|output\\|inout\\)\\b" line))))

(defun verilog-align--line-inst-port-p (pos)
  (save-excursion
    (goto-char pos)
    (let ((line (buffer-substring-no-properties
                 (line-beginning-position)
                 (line-end-position))))
      (string-match-p
       "^\\s-*\\.\\(\\\\[^[:space:]]+\\|[A-Za-z_][A-Za-z0-9_$]*\\)\\b"
       line))))

(defun verilog-align--line-decl-p (pos)
  (save-excursion
    (goto-char pos)
    (let ((line (buffer-substring-no-properties
                 (line-beginning-position)
                 (line-end-position))))
      (and (string-match-p
            "^\\s-*\\(logic\\|wire\\|reg\\)\\b"
            line)
           (verilog-align--parse-decl-line line)))))

(defun verilog-align--split-comment (line)
  (let ((pos (string-match "//" line)))
    (if pos
        (cons (substring line 0 pos) (substring line pos))
      (cons line nil))))

(defun verilog-align--parse-line (line)
  (let* ((split (verilog-align--split-comment line))
         (code (string-trim-right (car split)))
         (comment (cdr split)))
    (when (string-match
           "^\\(\\s-*\\)\\(input\\|output\\|inout\\)\\b\\s-*\\(.*\\)$"
           code)
      (let* ((indent (match-string 1 code))
             (dir (match-string 2 code))
             (rest (string-trim (match-string 3 code)))
             (name nil)
             (comma nil)
             (type "")
             (range "")
             (before ""))
        (if (string-match
            "\\(\\\\[^[:space:]]+\\|[A-Za-z_][A-Za-z0-9_$]*\\)\\(\\s-*,\\)?\\s-*$"
             rest)
            (progn
              (setq name (match-string 1 rest))
              (setq comma (when (match-string 2 rest) ","))
              (setq before
                    (string-trim-right (substring rest 0 (match-beginning 1)))))
          (setq name rest)
          (setq comma nil)
          (setq before ""))
        (setq before (string-trim-right before))
        (if (and (not (string-empty-p before))
                 (string-match "\\(\\[[^][]+\\]\\)\\s-*$" before))
            (progn
              (setq range (match-string 1 before))
              (setq type
                    (string-trim-right (substring before 0 (match-beginning 1)))))
          (setq type (string-trim before))
          (setq range ""))
        (list :indent indent
              :dir dir
              :type type
              :range range
              :name name
              :comma comma
              :comment comment)))))

(defun verilog-align--bounds ()
  (save-excursion
    (and (verilog-align--line-port-p (line-beginning-position))
         (let ((start (line-beginning-position))
               (end nil))
           (while (and (not (bobp))
                       (save-excursion
                         (forward-line -1)
                         (verilog-align--line-port-p
                          (line-beginning-position))))
             (forward-line -1)
             (setq start (line-beginning-position)))
           (goto-char start)
           (while (and (not (eobp))
                       (verilog-align--line-port-p
                        (line-beginning-position)))
             (forward-line 1))
            (setq end (line-beginning-position))
            (cons start end)))))

(defun verilog-align--inst-bounds ()
  (save-excursion
    (and (verilog-align--line-inst-port-p (line-beginning-position))
         (let ((start (line-beginning-position))
               (end nil))
           (while (and (not (bobp))
                       (save-excursion
                         (forward-line -1)
                         (verilog-align--line-inst-port-p
                          (line-beginning-position))))
             (forward-line -1)
             (setq start (line-beginning-position)))
           (goto-char start)
           (while (and (not (eobp))
                       (verilog-align--line-inst-port-p
                        (line-beginning-position)))
             (forward-line 1))
            (setq end (line-beginning-position))
            (cons start end)))))

(defun verilog-align--decl-bounds ()
  (save-excursion
    (and (verilog-align--line-decl-p (line-beginning-position))
         (let ((start (line-beginning-position))
               (end nil))
           (while (and (not (bobp))
                       (save-excursion
                         (forward-line -1)
                         (verilog-align--line-decl-p
                          (line-beginning-position))))
             (forward-line -1)
             (setq start (line-beginning-position)))
           (goto-char start)
           (while (and (not (eobp))
                       (verilog-align--line-decl-p
                        (line-beginning-position)))
             (forward-line 1))
           (setq end (line-beginning-position))
           (cons start end)))))

(defun verilog-align--collect (start end)
  (let (entries)
    (save-excursion
      (goto-char start)
      (while (< (point) end)
        (let* ((line (buffer-substring-no-properties
                      (line-beginning-position)
                      (line-end-position)))
               (entry (verilog-align--parse-line line)))
          (when entry
            (push entry entries)))
        (forward-line 1)))
    (nreverse entries)))

(defun verilog-align--find-paren-end (text start)
  (let ((depth 0)
        (idx start)
        (len (length text))
        (end nil))
    (while (and (< idx len) (not end))
      (let ((ch (aref text idx)))
        (cond
         ((eq ch ?\() (setq depth (1+ depth)))
         ((eq ch ?\))
          (setq depth (1- depth))
          (when (eq depth 0)
            (setq end (1+ idx))))))
      (setq idx (1+ idx)))
    end))

(defun verilog-align--parse-inst-line (line)
  (let* ((split (verilog-align--split-comment line))
         (code (string-trim-right (car split)))
         (comment (cdr split)))
    (when (string-match
           "^\\(\\s-*\\)\\.\\(\\\\[^[:space:]]+\\|[A-Za-z_][A-Za-z0-9_$]*\\)\\(.*\\)$"
           code)
      (let* ((indent (match-string 1 code))
             (name (match-string 2 code))
             (rest (match-string 3 code))
             (rest (if rest (string-trim-right rest) ""))
             (pos (string-match "\\S-" rest))
             (has-conn nil)
             (conn "")
             (comma nil))
        (if (and pos (< pos (length rest)) (eq (aref rest pos) ?\())
            (let* ((end (verilog-align--find-paren-end rest pos)))
              (if end
                  (progn
                    (setq has-conn t)
                    (setq conn (string-trim (substring rest (1+ pos) (1- end))))
                    (let ((after (string-trim (substring rest end))))
                      (when (and (> (length after) 0)
                                 (eq (aref after 0) ?,))
                        (setq comma ","))))
                (let ((after (string-trim rest)))
                  (when (and (> (length after) 0)
                             (string-match-p "," after))
                    (setq comma ",")))))
          (let ((after (string-trim rest)))
            (when (and (> (length after) 0)
                       (string-match-p "," after))
              (setq comma ","))))
        (list :indent indent
              :name name
              :has-conn has-conn
              :conn conn
              :comma comma
              :comment comment)))))

(defun verilog-align--parse-decl-line (line)
  (let* ((split (verilog-align--split-comment line))
         (code (string-trim-right (car split)))
         (comment (cdr split)))
    (when (string-match
           "^\\(\\s-*\\)\\(logic\\|wire\\|reg\\)\\b\\s-*\\(.*\\)$"
           code)
      (let* ((indent (match-string 1 code))
             (kind (match-string 2 code))
             (rest (string-trim (match-string 3 code)))
             (name nil)
             (tail nil)
             (type-rest "")
             (range "")
             (before ""))
        (when (string-match
               "\\(\\\\[^[:space:]]+\\|[A-Za-z_][A-Za-z0-9_$]*\\)\\s-*\\(?:\\(=[^;]*\\)\\)?;\\s-*$"
               rest)
          (setq name (match-string 1 rest))
          (setq tail (when (match-string 2 rest)
                       (string-trim (match-string 2 rest))))
          (setq before
                (string-trim-right (substring rest 0 (match-beginning 1))))
          (setq before (string-trim before))
          (unless (string-match-p "," before)
            (if (and (not (string-empty-p before))
                     (string-match "\\(\\[[^][]+\\]\\)\\s-*$" before))
                (progn
                  (setq range (match-string 1 before))
                  (setq type-rest
                        (string-trim-right
                         (substring before 0 (match-beginning 1)))))
              (setq type-rest before)
              (setq range ""))
            (let ((type (if (string-empty-p type-rest)
                            kind
                          (concat kind " " type-rest))))
              (list :indent indent
                    :type type
                    :range range
                    :name name
                    :tail tail
                    :comment comment))))))))

(defun verilog-align--inst-collect (start end)
  (let (entries)
    (save-excursion
      (goto-char start)
      (while (< (point) end)
        (let* ((line (buffer-substring-no-properties
                      (line-beginning-position)
                      (line-end-position)))
               (entry (verilog-align--parse-inst-line line)))
          (when entry
            (push entry entries)))
        (forward-line 1)))
    (nreverse entries)))

(defun verilog-align--decl-collect (start end)
  (let (entries)
    (save-excursion
      (goto-char start)
      (while (< (point) end)
        (let* ((line (buffer-substring-no-properties
                      (line-beginning-position)
                      (line-end-position)))
               (entry (verilog-align--parse-decl-line line)))
          (when entry
            (push entry entries)))
        (forward-line 1)))
    (nreverse entries)))

(defun verilog-align--max-lengths (entries)
  (let ((max-dir 0)
        (max-type 0)
        (max-range 0)
        (max-name 0)
        (has-comment nil))
    (dolist (entry entries)
      (setq max-dir (max max-dir (length (plist-get entry :dir))))
      (setq max-type (max max-type (length (plist-get entry :type))))
      (setq max-range (max max-range (length (plist-get entry :range))))
      (let ((name (concat (plist-get entry :name)
                          (or (plist-get entry :comma) ""))))
        (setq max-name (max max-name (length name))))
      (when (plist-get entry :comment)
        (setq has-comment t)))
    (list max-dir max-type max-range max-name has-comment)))

(defun verilog-align--pad (max-len len)
  (make-string (+ 1 (- max-len len)) ?\s))

(defun verilog-align--format-lines (entries)
  (let* ((base-indent (plist-get (car entries) :indent))
         (maxes (verilog-align--max-lengths entries))
         (max-dir (nth 0 maxes))
         (max-type (nth 1 maxes))
         (max-range (nth 2 maxes))
         (max-name (nth 3 maxes))
         (has-comment (nth 4 maxes))
         (has-type (> max-type 0))
         (has-range (> max-range 0)))
    (mapcar
     (lambda (entry)
       (let* ((dir (plist-get entry :dir))
              (type (plist-get entry :type))
              (range (plist-get entry :range))
              (name (concat (plist-get entry :name)
                            (or (plist-get entry :comma) "")))
              (comment (plist-get entry :comment))
              (dir-pad (verilog-align--pad max-dir (length dir)))
              (type-pad (when has-type
                          (verilog-align--pad max-type (length type))))
              (range-pad (when has-range
                           (verilog-align--pad max-range (length range))))
              (name-pad (when (and has-comment comment)
                          (verilog-align--pad max-name (length name)))))
         (concat base-indent
                 dir
                 dir-pad
                 (when has-type type)
                 (when has-type type-pad)
                 (when has-range range)
                 (when has-range range-pad)
                 name
                 (when (and has-comment comment) name-pad)
                  (or comment ""))))
     entries)))

(defun verilog-align--inst-format-lines (entries)
  (let* ((base-indent (plist-get (car entries) :indent))
         (max-name 0)
         (has-comment nil)
         left-parts
         (max-left 0))
    (dolist (entry entries)
      (let ((name-len (+ 1 (length (plist-get entry :name)))))
        (setq max-name (max max-name name-len)))
      (when (plist-get entry :comment)
        (setq has-comment t)))
    (dolist (entry entries)
      (let* ((name (plist-get entry :name))
             (name-field (concat "." name))
             (has-conn (plist-get entry :has-conn))
             (conn (plist-get entry :conn))
             (comma (plist-get entry :comma))
             (pad (when has-conn
                    (verilog-align--pad max-name (length name-field))))
             (left (concat base-indent
                           name-field
                           (when has-conn pad)
                           (when has-conn "(")
                           (when has-conn conn)
                           (when has-conn ")")
                           (when comma ","))))
        (push left left-parts)
        (setq max-left (max max-left (length left)))))
    (setq left-parts (nreverse left-parts))
    (cl-mapcar
     (lambda (entry left)
       (let ((comment (plist-get entry :comment)))
         (if (and has-comment comment)
             (concat left
                     (verilog-align--pad max-left (length left))
                     comment)
           left)))
     entries left-parts)))

(defun verilog-align--decl-format-lines (entries)
  (let* ((base-indent (plist-get (car entries) :indent))
         (max-type 0)
         (max-range 0)
         (has-comment nil)
         left-parts
         (max-left 0))
    (dolist (entry entries)
      (setq max-type (max max-type (length (plist-get entry :type))))
      (setq max-range (max max-range (length (plist-get entry :range))))
      (when (plist-get entry :comment)
        (setq has-comment t)))
    (let ((has-range (> max-range 0)))
      (dolist (entry entries)
        (let* ((type (plist-get entry :type))
               (range (plist-get entry :range))
               (name (plist-get entry :name))
               (tail (plist-get entry :tail))
               (type-pad (verilog-align--pad max-type (length type)))
               (range-pad (when has-range
                            (verilog-align--pad max-range (length range))))
               (left (concat base-indent
                             type
                             type-pad
                             (when has-range range)
                             (when has-range range-pad)
                             name
                             (when tail (concat " " tail))
                             ";")))
          (push left left-parts)
          (setq max-left (max max-left (length left)))))
      (setq left-parts (nreverse left-parts))
      (cl-mapcar
       (lambda (entry left)
         (let ((comment (plist-get entry :comment)))
           (if (and has-comment comment)
               (concat left
                      (verilog-align--pad max-left (length left))
                       comment)
             left)))
       entries left-parts))))

(defun verilog-align--apply (start lines)
  (save-excursion
    (goto-char start)
    (dolist (line lines)
      (delete-region (line-beginning-position) (line-end-position))
      (insert line)
      (forward-line 1))))

;;;###autoload
(defun verilog-align-ports ()
  "Align SystemVerilog port declarations around point."
  (interactive)
  (let ((bounds (verilog-align--bounds)))
    (and bounds
         (let* ((start (car bounds))
                 (end (cdr bounds))
                 (entries (verilog-align--collect start end)))
            (and entries
                 (let ((lines (verilog-align--format-lines entries)))
                   (verilog-align--apply start lines)
                   t))))))

;;;###autoload
(defun verilog-align-instantiation ()
  "Align SystemVerilog named port connections around point."
  (interactive)
  (let ((bounds (verilog-align--inst-bounds)))
    (and bounds
         (let* ((start (car bounds))
                (end (cdr bounds))
                (entries (verilog-align--inst-collect start end)))
           (and entries
                (let ((lines (verilog-align--inst-format-lines entries)))
                  (verilog-align--apply start lines)
                  t))))))

;;;###autoload
(defun verilog-align-declarations ()
  "Align SystemVerilog signal declarations around point."
  (interactive)
  (let ((bounds (verilog-align--decl-bounds)))
    (and bounds
         (let* ((start (car bounds))
                (end (cdr bounds))
                (entries (verilog-align--decl-collect start end)))
           (and entries
                (let ((lines (verilog-align--decl-format-lines entries)))
                  (verilog-align--apply start lines)
                  t))))))

(provide 'verilog-align)

;;; verilog-align.el ends here