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

;; Author: Joseph Ferano <joseph@ferano.io>
;; Version: 0.1.0
;; Package-Requires: ((emacs "29.1"))
;; Keywords: languages, lisp, tools

;; The headers above are what make this directory installable.  M-x
;; package-install-file on it reads them, and a file with no Version: is not a
;; package as far as package.el is concerned -- until now the client was
;; reachable only by adding it to load-path by hand, which is a thing to
;; explain to every person who wants to try it.
;;
;; 29.1 is the floor because it is the oldest Emacs any of this has been run
;; against, not because some function here is known to need it.  dape, which
;; flan-dape drives, asks for 29.1 as well and is a soft dependency: it is
;; reached through declare-function, so the rest of the client loads and works
;; without it and it is deliberately not listed above.  The compiler this talks
;; to is not an Emacs package and cannot be listed here either -- emacs/MANUAL.md
;; says what has to be on PATH.

;; 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 at all.
(autoload 'flan-eval-defun "flan" nil t)
(autoload 'flan-eval-buffer "flan" nil t)
(autoload 'flan-eval-last-sexp "flan" nil t)
(autoload 'flan-connect "flan" nil t)
(autoload 'flan-disconnect "flan" nil t)
(autoload 'flan-describe "flan" nil t)
(autoload 'flan-repl "flan-repl" nil t)
(autoload 'flan-repl-clear "flan-repl" nil t)
(autoload 'flan-repl-clear-output "flan-repl" nil t)
(autoload 'flan-break "flan" 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" nil t)
(autoload 'flan "flan" nil t)
(autoload 'flan-quit "flan" nil t)
(autoload 'flan-restart-program "flan" nil t)
;; And the cheap counterpart, which needs an autoload for the reason above and
;; more than most: it is the command someone reaches for the moment a window
;; closes, which can be the first thing they ever ask the client to do.
(autoload 'flan-rerun "flan" nil t)
;; Bound below, like the rest, and it was the one missing an autoload.
(autoload 'flan-disassemble "flan" nil t)
;; The other question about the same function, and the reason it is a second
;; command rather than a fifth argument to the first: `flan-disassemble' asks
;; the running program, and this compiles the file.
(autoload 'flan-lowering "flan-lower" 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" nil t)
(autoload 'flan-macroexpand-all "flan" nil t)

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

;; Both lists are read off `Parse.decl' and `Parse.form' (lib/parse.ml), which
;; are where the two questions are actually decided: a head `decl' has an arm
;; for introduces a name, and a head `form' has an arm for is never a call.
;; Kept whole rather than topped up one name at a time — the list that is
;; patched only when somebody notices a gap is the list that is always a
;; release behind the parser.
(defconst flan--definers
  '("defn" "defmacro" "defvar" "defconst" "defstruct" "defdata" "defunion"
    "defenum" "defalias"
    ;; The object and dispatch heads (lib/parse.ml:1277-1334).
    "defclass" "defgeneric" "defmulti" "defmethod"
    "declare" "declare-c" "import" "package")
  "Forms that introduce a top-level name.")

(defconst flan--special
  '("quote" "let" "if" "when" "cond" "and" "or" "do" "while" "until" "dotimes"
    "loop" "recur" "break" "continue" "match" "set" "return" "fn" "array"
    "defer" "some" "none" "try" "signal" "error"
    "handler-bind" "handler-case" "restart-case" "invoke-restart"
    "zeroed" "uninit" "slice" "at" "len" "addr"
    "bytes" "cast" "true" "false" "nil" "print" "println")
  "Forms with meaning to the checker.

The heads `Parse.form' dispatches on, plus the literals and the handful of
builtins that are never anything else.  Two groups of real heads are
deliberately left out: `quasiquote', `unquote' and `unquote-splicing', which
nobody writes as words — the reader makes them out of \\=`, ~ and ~@, and the
sigils are not symbols for a keyword rule to reach — and `find-restart',
`compute-restarts', `errdefer' and `await', which the parser recognises only
in order to refuse them.  Drawing those four as keywords would advertise four
forms that cannot be used.")

(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 package half of a qualified name — the `rl/' of `rl/draw-text'.
    ;; Drawn as a type the way clojure-mode draws a namespace, so the eye can
    ;; split the package from the name without reading either.  The leading
    ;; letter keeps `:foo/bar' keywords and a bare `/' out of it.
    ("\\_<\\([a-zA-Z][a-zA-Z0-9!?*+=<>._-]*/\\)" 1 font-lock-type-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\\|data\\|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'.")

;;; The discard reader macro

;; `#_' reads the form after it and throws it away (lib/reader.ml:16-24,
;; 202-262), which is how a form is commented out without counting its closing
;; parens.  The table above knows nothing about it — it comes from
;; `lisp-mode-syntax-table', and Common Lisp has no such construct — so a
;; discarded form used to render as ordinary code, which is the one thing it
;; must not look like.
;;
;; The fix is `clojure-mode's, which has the same reader macro and the same
;; problem: a `syntax-propertize-function' that gives the span the comment
;; syntax class.  Font lock then draws it as a comment with no rule of its own,
;; and every other thing that reads syntax classes — `forward-comment',
;; `comment-only-p', a package that skips comments — agrees for free.
;;
;; Generic comment fences (the `!' class) rather than a line comment, because a
;; discarded form is a region and may be one line or twenty.  The `#' is the
;; opening fence and the last character of the form is the closing one, so
;; everything in between is inside a comment and is no longer read as
;; structure.  That is the reader's own answer, and it leaves the *enclosing*
;; list's parens alone: only the discarded form's own last delimiter changes
;; class, so `(a #_(b c) d)' still balances.

(defun flan--discard-end (pos)
  "Where the discard whose form starts at POS ends, or nil.

The reader's rule rather than a count: a discard reads *a form*, and reading
one skips leading discards of its own, so `#_#_ a b' throws away both a and b
with nothing ever counting to two (lib/reader.ml:202-262).  Written as the
loop that recursion amounts to — every `#_' seen owes one more form — since
the walk over the buffer is the same either way.

Nil when a form is unfinished, which is every buffer halfway through being
typed: nothing is propertized then, rather than `#_(' greying out the rest of
the file while the parenthesis is still open."
  (let ((owed 1)
        ;; The scan must not consult the properties it is being run to
        ;; compute: with `parse-sexp-lookup-properties' on, `forward-sexp'
        ;; would ask for the syntax of positions this pass has not reached.
        ;; The table alone is enough — the nesting is counted here, and
        ;; strings and escapes are the table's own business.
        (parse-sexp-lookup-properties nil))
    (ignore-errors
      (save-excursion
        (goto-char pos)
        (while (> owed 0)
          (forward-comment (buffer-size))
          (if (looking-at-p "#_")
              (progn (forward-char 2) (setq owed (1+ owed)))
            (forward-sexp)
            (setq owed (1- owed))))
        ;; `forward-sexp' at the end of the buffer stays put rather than
        ;; signalling, so a trailing `#_' with nothing after it would otherwise
        ;; come back as a span covering only itself — a two-character comment
        ;; drawn over the reader's one real discard error.  It is unfinished
        ;; like any other, and answers nil like any other.
        (and (> (point) pos) (point))))))

(defun flan--syntax-propertize (start end)
  "Mark every `#_' discard between START and END as a comment.
For `syntax-propertize-function'."
  (goto-char start)
  (while (search-forward "#_" end t)
    ;; Both ends of the match are read off point before anything else runs, and
    ;; the `syntax-ppss' below is wrapped: it moves point and clobbers the
    ;; match data, so asking it first and reading the match afterwards is how
    ;; this would come to scan from the `#' instead of from the form — and how
    ;; a `#_' it declined would be found again, forever, at the same place.
    (let* ((beg (- (point) 2))
           (from (point))
           ;; `#_' written inside a string, or inside a `;' comment, is text
           ;; and not a reader macro.  One inside a span an earlier discard
           ;; already covers is not reached at all: that discard's own scan
           ;; consumed it, and point jumps past the whole span below.
           (quoted (save-excursion (nth 8 (syntax-ppss beg))))
           (fin (and (not quoted) (flan--discard-end from))))
      (when fin
        (put-text-property beg (1+ beg)
                           'syntax-table (string-to-syntax "!"))
        (put-text-property (1- fin) fin
                           'syntax-table (string-to-syntax "!"))
        ;; So that a change *inside* a discarded form re-propertizes from the
        ;; `#_' rather than from the line it was typed on; the other half is
        ;; `syntax-propertize-multiline' in the mode body.
        (put-text-property beg fin 'syntax-multiline t))
      ;; Past the span when there was one, and past the `#_' when there was
      ;; not.  Either way forward, which is the whole of why this terminates.
      (goto-char (or fin from)))))

(defvar flan-mode-map
  (let ((map (make-sparse-keymap)))
    ;; Autoloaded from flan.el, so the client loads on first use.
    (define-key map (kbd "C-c C-c") #'flan-eval-defun)
    ;; The same command on the binding SLIME and CIDER put it on.  Emacs binds
    ;; C-M-x to eval-defun only in `emacs-lisp-mode-map', so a mode derived
    ;; from `lisp-mode' inherits nothing and the key is undefined — which
    ;; reads as the client being broken rather than as the key being free.
    (define-key map (kbd "C-M-x") #'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)
    ;; The REPL's two clears, reachable from the file being edited: results
    ;; land in *flan-repl* whichever buffer the send came from, so the keys
    ;; that take them down belong here too.  CIDER's pair: C-c C-o for the
    ;; last send's output, C-c M-o for the whole transcript.
    (define-key map (kbd "C-c C-o") #'flan-repl-clear-output)
    (define-key map (kbd "C-c M-o") #'flan-repl-clear)
    (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)
    ;; Every lowering of the name at point -- the IR, `llc' at -O0 and at -O2,
    ;; and the hand-written x86 backend -- in one buffer of folding sections.
    ;; Beside C-c C-a and not under it: that one answers for the program that
    ;; is running, this one for the file on disk, and no prefix argument can
    ;; make one of those into the other.
    (define-key map (kbd "C-c C-l") #'flan-lowering)
    ;; 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-restart-program)
    ;; And beside it the cheap one, which is the same question — "run this
    ;; program" — asked of a process that is already there: `main' again, with
    ;; the globals as the finished run left them.  The pairing is `C-c C-b'
    ;; and `C-c C-M-b' above: the modifier is what distinguishes two commands
    ;; about one subject, and the heavier of the pair keeps the bare key
    ;; because it is the one that works from any state.
    (define-key map (kbd "C-c C-M-x") #'flan-rerun)
    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)
  ;; `#_' — see the section above the syntax table.
  (setq-local syntax-propertize-function #'flan--syntax-propertize)
  ;; A discarded form spans as many lines as it likes, so the region handed to
  ;; the propertizer has to be widened back to the `#_' that owns it.
  (add-hook 'syntax-propertize-extend-region-functions
            #'syntax-propertize-multiline nil t)
  ;; 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' is the other way round — the body first and the clause
    ;; vector after it — but the entry is the same number, because what it
    ;; says is that one argument is special and the rest indent as a body,
    ;; and that is true of both orders.
    ("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', `defdata', `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