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

;; Derived from `prog-mode', borrowing `lisp-mode''s machinery for the parts
;; that are simply s-expressions: sexp motion, paren matching and
;; `beginning-of-defun' already do the right thing.
;;
;; Indentation is the part that does not, and it is ported from
;; `clojure-mode''s source rather than from `lisp-mode''s.  That is a
;; deliberate change of reference and it is worth being exact about what it
;; means: `clojure-mode' is neither an ancestor nor a dependency here — this
;; mode ships in the Flan repository and requires nothing outside stock Emacs —
;; it is the file whose rules were read and written out again below.
;;
;; The reason is that Emacs Lisp has none of the shapes Flan is written in.  It
;; has no vectors-as-bindings, no maps, no bracket variety, so
;; `lisp-indent-function' treats `[a 1 b 2]' as a function call and aligns
;; continuation lines under `1' — the first *argument* — instead of under `a',
;; the first *binding*.  That was the reported bug in `sand.flan''s `settle',
;; and it was never one missing rule: every rule has to be added by hand when
;; the base language does not have the shape.  Clojure's rules already cover
;; brackets-mean-binding, pairs-align, maps and `#_'.
;;
;; Where Flan diverges from Clojure it diverges on purpose, and each divergence
;; is written down at the place that handles it:
;;
;;   - `defn' carries a **return type between the parameter vector and the
;;     body**, and it is optional — `(defn show [x f32] …)' has none.  Both are
;;     handled by not caring: the spec is `:defn', so everything after the head
;;     indents two, which is right for the name, the parameters, a return type
;;     that is there and a body whether or not one preceded it.
;;   - field access is `(.x v)', an ordinary call whose head happens to begin
;;     with a dot.  `.' is a symbol constituent in the syntax table below, so
;;     nothing special is needed for it to read as a head.
;;   - a field label is a dot: `{.x 1.0}' is a struct literal, and the colon
;;     now belongs to keywords, which a `Map' will use as keys.  The indenter
;;     is correct for both *because* it never looks at the key: a brace aligns
;;     under its first element whatever that element is spelled like.

;;; Code:

(require 'lisp-mode)
;; `thing-at-point', which the indenter reads the enclosing form's head with.
(require 'thingatpt)

;; Bound by `calculate-lisp-indent' around the call to `lisp-indent-function',
;; and declared in `lisp-mode' without a `defvar', so say so here rather than
;; let the byte-compiler call it a free variable.
(defvar calculate-lisp-indent-last-sexp)
;; 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, but do not load the client merely to edit a file.
;; These must be real autoloads, not just `declare-function`s: otherwise a
;; user who has loaded only flan-mode cannot invoke M-x flan-dev at all.
(autoload 'flan-eval-defun "flan-dev" nil t)
(autoload 'flan-eval-buffer "flan-dev" nil t)
(autoload 'flan-eval-last-sexp "flan-dev" nil t)
(autoload 'flan-connect "flan-dev" nil t)
(autoload 'flan-disconnect "flan-dev" nil t)
(autoload 'flan-describe "flan-dev" nil t)
(autoload 'flan-show-output "flan-dev" nil t)
(autoload 'flan-repl "flan-repl" nil t)
(autoload 'flan-break "flan-dev" nil t)
;; The two CIDER-shaped buffers. They reach the daemon through an indirection
;; of their own so that fixtures can drive them, so autoloading is all the
;; wiring they need.
(autoload 'flan-inspect "flan-inspect" nil t)
(autoload 'flan-cnr-show "flan-cnr" nil t)
(autoload 'flan-doc "flan-dev" nil t)
(autoload 'flan-dev "flan-dev" nil t)
(autoload 'flan-dev-quit "flan-dev" nil t)
(autoload 'flan-dev-restart-program "flan-dev" nil t)
;; Bound below, like the rest, and it was the one missing an autoload.
(autoload 'flan-disassemble "flan-dev" nil t)
;; C-c C-m and the half of it that is findable by name rather than by a
;; modifier.  Real autoloads for the reason stated above: a `declare-function'
;; would leave M-x with nothing to load.
(autoload 'flan-macroexpand "flan-dev" nil t)
(autoload 'flan-macroexpand-all "flan-dev" nil t)

(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" "print" "println")
  "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)
    ;; A field.  The label in a struct literal — `{.x 1.0}' — and the accessor
    ;; `(.x v)' are the same name and are drawn the same way.  Without this
    ;; rule every field label in the corpus is unfontified, which is what the
    ;; colon-to-dot change left behind: the keyword rule above used to cover
    ;; them and no longer does, because the colon belongs to keywords now.
    ("\\_<\\.\\(?:\\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)
    ;; C-c C-b opens the buffer rather than the minibuffer prompt: it shows the
    ;; same restarts plus the condition and the stack, and — the reason it
    ;; replaces rather than joins — it is the one that refuses a *shadowed*
    ;; restart instead of silently invoking a different frame's. flan-break is
    ;; still there under C-c C-M-b for the one-key path.
    (define-key map (kbd "C-c C-b") #'flan-cnr-show)
    (define-key map (kbd "C-c C-M-b") #'flan-break)
    (define-key map (kbd "C-c C-i") #'flan-inspect)
    ;; 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 code the running program is calling for a name, as amd64 or as the
    ;; IR it was built from.  C-u for the IR rather than a second key: it is
    ;; the same question asked of the same body.
    (define-key map (kbd "C-c C-a") #'flan-disassemble)
    ;; What the macro call before point expands to.  CIDER's key, and `C-u' for
    ;; the fixpoint rather than a second one — the same question asked of the
    ;; same form, which is the rule `C-c C-a' above already follows.  One step
    ;; is the bare key because it is the one that can name the macro that ran:
    ;; a full expansion is stamped with the outermost name only.
    (define-key map (kbd "C-c C-m") #'flan-macroexpand)
    ;; 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)
  ;; Spaces.  The whole corpus is written with them, and alignment that is
  ;; correct here is alignment under a specific *column* — a tab makes that
  ;; depend on a setting the file cannot carry.
  (setq-local indent-tabs-mode nil)
  (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))

;;; Indentation

;; Ported from `clojure-mode', as the header says.  Three pieces, and the
;; middle one is where the reported bug lived.

(defconst flan-indent-specs
  ;; A number N: the first N arguments are *special* and the rest are a body.
  ;; `:defn': everything after the head is a body.  These are the same two
  ;; values `clojure-mode' uses, and they mean the same thing here.
  '(;; Binding forms.  The vector is the one special argument; the body
    ;; follows it.  This is the entry that makes `let' correct, but note that
    ;; it is *not* what fixed the reported bug — alignment inside the vector is
    ;; `flan--data-form-p' below, and it would be right even with no entry
    ;; here.
    ("let" . 1)
    ("loop" . 1)
    ("dotimes" . 1)
    ;; The clause vector, then the protected body.  Same shape as `let'.
    ("handler-bind" . 1)
    ("handler-case" . 1)
    ;; Test first, body after.
    ("if" . 1)
    ("when" . 1)
    ("unless" . 1)
    ("while" . 1)
    ("until" . 1)
    ("match" . 1)
    ("with-allocator" . 1)
    ;; The protected form, then the clauses.  It has to be 1 rather than 0:
    ;; with 0 the clauses are ordinary arguments, and a protected form written
    ;; on the head's line — `(restart-case (middle n)' — would drag every
    ;; clause out to align under it.
    ("restart-case" . 1)
    ;; All body.
    ("do" . 0)
    ("cond" . 0)
    ("defer" . 0)
    ("try" . 0)
    ;; `defn' is `:defn' rather than a count because the return type between
    ;; the parameters and the body is optional; a count would have to know
    ;; whether one is there, and `:defn' does not care.
    ("defn" . :defn)
    ;; `(declare-c NAME [params] RET "CSymbol")'.  The name is the one special
    ;; argument; everything after it is written down the page in one column.
    ("declare" . 1)
    ("declare-c" . 1))
  "How each form indents, by name.
Anything not named here that begins with `def' is treated as `:defn' by
`flan-indent-function'; anything else indents as a function call.")

(defun flan--indent-spec (name)
  "The indent spec for the form called NAME, or nil."
  (and name (cdr (assoc name flan-indent-specs))))

(defun flan--non-logical-sexp-p ()
  "Non-nil if what follows point is read but produces no form.
Today that is only `#_', the discard reader macro — see `lib/reader.ml'.  A
discarded form is skipped rather than counted, so `(let [#_a b 1] …)' still
aligns as the pairs it will be once the reader is done with it."
  (looking-at-p "#_"))

(defun flan--forward-sexp (&optional n)
  "Move forward over N sexps, skipping discarded ones."
  (setq n (or n 1))
  (let ((forward-sexp-function nil))
    (while (> n 0)
      (while (flan--non-logical-sexp-p) (forward-sexp 1))
      (forward-sexp 1)
      (setq n (1- n)))))

(defun flan--backward-sexp (&optional n)
  "Move backward over N sexps, skipping discarded ones."
  (setq n (or n 1))
  (let ((forward-sexp-function nil))
    (while (> n 0)
      (backward-sexp 1)
      (while (and (not (bobp))
                  (ignore-errors
                    (save-excursion (backward-sexp 1)
                                    (flan--non-logical-sexp-p))))
        (backward-sexp 1))
      (setq n (1- n)))))

(defun flan--data-form-p ()
  "Non-nil if the form at point is data rather than a call.
Point is on the opening delimiter.

**This is the fix.**  A `[' or a `{' is not a function call, so nothing in it
is an argument and there is no first argument to align under.  Aligning under
the first *element* instead is what makes a binding vector line its names up
name-under-name, and by the same rule it lines up `defn' parameter lists,
`restart-case' clause parameters, `handler-bind' clause vectors, and a brace
whatever its keys are spelled like — `{.x 1}' and `{:north 0}' — with no case
for any of them, because the rule is about the bracket and never about what is
written inside it.

A head that is not a symbol is the third case: `((f x) y)' has nothing to look
a spec up under."
  (or (memq (char-after) '(?\[ ?\{))
      (not (looking-at ".\\(?:\\sw\\|\\s_\\)"))))

(defun flan--normal-indent (last-sexp)
  "Align with the argument above, as an ordinary call does.
Point is just after the open paren of the enclosing form; LAST-SEXP is where
the sexp before the one being indented starts."
  (goto-char last-sexp)
  (forward-sexp 1)
  (flan--backward-sexp 1)
  (let ((last-sexp-start nil))
    (if (ignore-errors
          ;; Back up until we reach a sexp that starts its own line: that is
          ;; the one every Lisp aligns under.
          (while (string-match "[^[:blank:]]"
                               (buffer-substring (line-beginning-position)
                                                 (point)))
            (setq last-sexp-start (prog1 (point) (forward-sexp -1))))
          t)
        (current-column)
      ;; Nothing above but the head itself, so there are two cases and Flan
      ;; answers them differently from Clojure's default.
      (if (and last-sexp-start (< last-sexp-start (line-end-position)))
          ;; An argument shares the head's line.  Align under it — this is the
          ;; alignment every Lisp agrees on.
          (progn (goto-char last-sexp-start) (current-column))
        ;; The head is alone on its line.  Clojure's default would align the
        ;; arguments under the *head*; the Flan corpus indents them by a body
        ;; instead, which is `clojure-indent-style''s `align-arguments' and is
        ;; what every hand-written call in the tree does:
        ;;
        ;;     (rl/draw-rectangle-lines-ex
        ;;       (rl/Rectangle {.x 0.0 .y 0.0})
        ;;       (f32 2.0) (rl/get-color 0x303030FF))
        (+ (current-column) lisp-body-indent -1)))))

(defun flan--clause-form-p ()
  "Non-nil if the form at point is a clause: `(name [params] body…)'.
Point is just after the open paren, on the head.

This is `defn' with the name left off, and it is how `handler-bind',
`handler-case' and `restart-case' all write their clauses.  Their heads are
condition classes and restart names — things a program invents — so no table
here could ever list them; the shape is what can be recognised."
  (save-excursion
    (ignore-errors
      (flan--forward-sexp 1)            ; over the head
      (skip-chars-forward " \t\n\r,")
      (eq (char-after) ?\[))))

(defun flan--count-indent (method indent-point last-sexp head-column)
  "Indent inside a form whose first METHOD arguments are special.
INDENT-POINT, LAST-SEXP and HEAD-COLUMN are as in `flan-indent-function';
point is just after the open paren."
  (let ((pos -1))
    (condition-case nil
        (while (and (<= (point) indent-point) (not (eobp)))
          (flan--forward-sexp 1)
          (setq pos (1+ pos)))
      ;; Past the last sexp in the form: count as if one more were here, which
      ;; is what indenting an empty line at the end of a form means.
      (scan-error (setq pos (1+ pos))))
    (cond
     ;; The first argument that is body rather than special.
     ((= pos (1+ method)) (+ lisp-body-indent head-column))
     ;; Further body arguments line up with the one above.
     ((> pos (1+ method)) (flan--normal-indent last-sexp))
     ;; Still in the special arguments.  Clojure indents these to twice the
     ;; body indent so they cannot be mistaken for body; Flan uses one, because
     ;; the corpus is written that way throughout —
     ;;
     ;;     (handler-bind
     ;;       [(StorageExhausted [c] …)]
     ;;       (load-all))
     ;;
     ;; — and there is nothing to confuse: the special arguments come first, so
     ;; a reader never has to tell them apart by column.
     (t (+ lisp-body-indent head-column)))))

(defun flan-indent-function (indent-point state)
  "Indent a line inside a Flan form.
INDENT-POINT and STATE are as for `lisp-indent-function'; the spec for the
enclosing form comes from `flan-indent-specs'.  Returns nil to leave the
decision to `calculate-lisp-indent'."
  (goto-char (elt state 1))
  (if (flan--data-form-p)
      ;; A vector, a map, or a head that is not a symbol: align under the
      ;; first element.
      (1+ (current-column))
    (forward-char 1)
    (let* ((name (thing-at-point 'symbol))
           (method (flan--indent-spec name))
           (last-sexp calculate-lisp-indent-last-sexp)
           (head-column (1- (current-column))))
      (cond
       ((integerp method)
        (flan--count-indent method indent-point last-sexp head-column))
       ((eq method :defn) (+ lisp-body-indent head-column))
       ;; No spec.  Anything else spelled `def…' is a definition and indents
       ;; like one, which covers `defstruct', `defunion', `defenum', `defvar',
       ;; `defconst' and `defalias' without naming them.
       ((and name (string-match-p "\\`def" name))
        (+ lisp-body-indent head-column))
       ;; A clause: `(name [params] body…)'.  `handler-bind', `handler-case'
       ;; and `restart-case' all write their clauses this way, and the head is
       ;; a condition class or a restart name — something the program invented,
       ;; so it can never be in a table here.  What can be recognised is the
       ;; *shape*, which is `defn' with the name left off: a parameter vector
       ;; where the first argument goes, and a body after it.
       ;;
       ;; `clojure-mode' reaches the same clauses by backtracking out to the
       ;; enclosing form and reading a nested spec off it.  That machinery buys
       ;; generality this language has no other use for — these three forms are
       ;; the whole of it — and the shape is unambiguous on its own.
       ((flan--clause-form-p) (flan--count-indent 1 indent-point last-sexp
                                                  head-column))
       (t (flan--normal-indent last-sexp))))))

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

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