;;; flan-mode.el --- Major mode for Flan  -*- lexical-binding: t; -*-

;; Derived from lisp-mode, which is most of the work: Flan is s-expressions, so
;; sexp motion, paren matching, `beginning-of-defun' and indentation all
;; already do the right thing.  What is left is what the language actually adds
;; — its own literals and its own set of forms that indent like a body.

;;; Code:

(require 'lisp-mode)
;; For `imenu-generic-expression', which is set below and which would
;; otherwise be made buffer-local before its own defvar had run.
(require 'imenu)

;; The keymap binds them; loading the client is what defines them, and a user
;; may well edit Flan without ever connecting to a running program.
(declare-function flan-eval-defun "flan-dev")
(declare-function flan-eval-buffer "flan-dev")
(declare-function flan-eval-last-sexp "flan-dev")
(declare-function flan-connect "flan-dev")
(declare-function flan-disconnect "flan-dev")
(declare-function flan-describe "flan-dev")
(declare-function flan-show-output "flan-dev")
(declare-function flan-repl "flan-repl")
(declare-function flan-break "flan-dev")
(declare-function flan-doc "flan-dev")
(declare-function flan-dev "flan-dev")
(declare-function flan-dev-quit "flan-dev")
(declare-function flan-dev-restart-program "flan-dev")

(defgroup flan nil
  "Editing and evaluating Flan."
  :group 'languages
  :prefix "flan-")

(defconst flan--definers
  '("defn" "defvar" "defconst" "defstruct" "defunion" "defenum" "defalias"
    "declare" "import" "package")
  "Forms that introduce a top-level name.")

(defconst flan--special
  '("let" "if" "do" "while" "until" "dotimes" "loop" "match" "set" "return"
    "defer" "some" "none" "try" "zeroed" "uninit" "slice" "at" "len" "addr"
    "bytes" "cast" "true" "false" "nil")
  "Forms with meaning to the checker.")

(defvar flan-font-lock-keywords
  `((,(concat "(" (regexp-opt flan--definers t) "\\_>"
              "[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)?")
     (1 font-lock-keyword-face)
     (2 font-lock-function-name-face nil t))
    (,(concat "(" (regexp-opt flan--special t) "\\_>") 1 font-lock-keyword-face)
    ;; A keyword resolves against an enum at the call site, so it reads as a
    ;; constant rather than as a string.
    ("\\_<:\\(?:\\sw\\|\\s_\\)+" . font-lock-constant-face)
    ;; The machine types, which are ordinary symbols but never anything else.
    ("\\_<\\(?:[iu]\\(?:8\\|16\\|32\\|64\\)\\|f\\(?:32\\|64\\)\\|bool\\|string\\|Unit\\|Never\\|Ptr\\|Option\\)\\_>"
     . font-lock-type-face)
    ("\\_<\\(?:0x[0-9a-fA-F]+\\|-?[0-9]+\\(?:\\.[0-9]+\\)?\\)\\_>"
     . font-lock-constant-face))
  "Font lock for `flan-mode'.")

(defconst flan--name-re "\\(\\(?:\\sw\\|\\s_\\)+\\)"
  "A Flan name, as one group.
Written in terms of the syntax table rather than as a character class, so
that the characters a name may contain are stated in one place — the table
below — and not again here.")

;; Anchored at the start of a line, which is where a top-level form is: a
;; `defn' nested inside a `let' is not a definition of anything, and a match
;; that ignored the column would offer one.
(defvar flan-imenu-generic-expression
  `(("Functions" ,(concat "^(defn\\s-+" flan--name-re) 1)
    ("Types" ,(concat "^(def\\(?:struct\\|union\\|enum\\|alias\\)\\s-+"
                      flan--name-re)
     1)
    ("Variables" ,(concat "^(def\\(?:var\\|const\\)\\s-+" flan--name-re) 1)
    ;; A forward declaration is not a definition, and a file with both would
    ;; otherwise show the same name twice with nothing to tell them apart.
    ("Declared" ,(concat "^(declare\\s-+" flan--name-re) 1))
  "Imenu index for `flan-mode', by what each form introduces.")

(defun flan-current-defun-name ()
  "The name of the top-level definition point is in, or nil.
For `which-func-functions': a long file scrolled into the middle of a
function is the case this exists for, and it is the case where the header
line is off screen."
  (save-excursion
    (ignore-errors
      (beginning-of-defun)
      (and (looking-at (concat "(" (regexp-opt flan--definers t) "\\_>\\s-+"
                               flan--name-re))
           (match-string-no-properties 2)))))

(defvar flan-mode-syntax-table
  (let ((table (make-syntax-table lisp-mode-syntax-table)))
    ;; Flan's own punctuation in names: a name may contain - ? > / and .
    (modify-syntax-entry ?? "_" table)
    (modify-syntax-entry ?! "_" table)
    (modify-syntax-entry ?/ "_" table)
    (modify-syntax-entry ?. "_" table)
    (modify-syntax-entry ?- "_" table)
    ;; [ ] and { } are brackets, not symbol characters: every binding list and
    ;; every type is written with them.
    (modify-syntax-entry ?\[ "(]" table)
    (modify-syntax-entry ?\] ")[" table)
    (modify-syntax-entry ?{ "(}" table)
    (modify-syntax-entry ?} "){" table)
    table)
  "Syntax table for `flan-mode'.")

(defvar flan-mode-map
  (let ((map (make-sparse-keymap)))
    ;; Autoloaded from flan-dev.el, so the client loads on first use.
    (define-key map (kbd "C-c C-c") #'flan-eval-defun)
    (define-key map (kbd "C-c C-k") #'flan-eval-buffer)
    (define-key map (kbd "C-x C-e") #'flan-eval-last-sexp)
    (define-key map (kbd "C-c C-z") #'flan-connect)
    (define-key map (kbd "C-c C-q") #'flan-disconnect)
    (define-key map (kbd "C-c C-d") #'flan-describe)
    (define-key map (kbd "C-c C-o") #'flan-show-output)
    (define-key map (kbd "C-c C-r") #'flan-repl)
    (define-key map (kbd "C-c C-b") #'flan-break)
    ;; Help on the name at point.  C-c C-d is taken by `flan-describe', which
    ;; is about the session rather than about a name, and renaming a key that
    ;; is already documented costs more than it is worth.  Not C-c C-h either:
    ;; C-h after a prefix is how anyone finds out what is under C-c, and a
    ;; binding there takes that away.
    (define-key map (kbd "C-c C-v") #'flan-doc)
    ;; The way out when a reload is refused: rebuild, relaunch, reconnect.
    (define-key map (kbd "C-c C-x") #'flan-dev-restart-program)
    map)
  "Keymap for `flan-mode'.")

;;;###autoload
(define-derived-mode flan-mode prog-mode "Flan"
  "Major mode for editing Flan.

\\{flan-mode-map}"
  :syntax-table flan-mode-syntax-table
  (setq-local comment-start ";")
  (setq-local comment-start-skip ";+ *")
  (setq-local comment-add 1)
  (setq-local font-lock-defaults '(flan-font-lock-keywords))
  (setq-local indent-line-function #'lisp-indent-line)
  (setq-local lisp-indent-function #'flan-indent-function)
  (setq-local outline-regexp ";;;;+[ \t]*")
  (setq-local imenu-generic-expression flan-imenu-generic-expression)
  ;; Buffer-locally, because this answers for Flan and nothing else.
  (add-hook 'which-func-functions #'flan-current-defun-name nil t))

(defun flan-indent-function (indent-point state)
  "Indent like Lisp, with Flan's body forms as special forms.
INDENT-POINT and STATE are as for `lisp-indent-function'."
  (let ((open (elt state 1)))
    (or (and open
             (save-excursion
               (goto-char (1+ open))
               (let ((head (and (looking-at "\\(\\sw\\|\\s_\\)+")
                                (match-string 0))))
                 (when (member head '("defn" "let" "if" "while" "until"
                                      "dotimes" "match" "do" "loop" "defer"))
                   (+ (current-column) 1)))))
        (lisp-indent-function indent-point state))))

;;;###autoload
(add-to-list 'auto-mode-alist '("\\.flan\\'" . flan-mode))

(provide 'flan-mode)
;;; flan-mode.el ends here