Joseph Ferano
26c53e0a19
The mechanical half, ahead of the parser change that needs it. tools/unit-return.py
fills the empty slot with () and rewrites Unit as () wherever a type is spelled --
(Fn [i32] Unit), (Map i32 Unit), a return type written out.
Deciding whether a defn already had a return type is the whole difficulty, and
the script does it the way parse.ml did: is_type_form is transcribed rather than
improved, because being identical to the parser it replaces is what makes the
sweep meaning-preserving. It is re-runnable, so the lanes that branched before
this can have the same pass at merge:
python3 tools/unit-return.py .
python3 tools/unit-return.py --in-strings test/test_flan.ml test/test_acceptance.ml \
test/test_session.ml emacs/test-flan-dev.el emacs/test-flan-mode.el
python3 tools/unit-return.py --raw-ml lib/prelude.ml
python3 tools/unit-return.py --in-html web/index.html
-v logs every defn it saw and what it decided, which is how a sweep of 440 sites
gets reviewed at all. Embedded modes pool a file's type declarations across all
its fragments, because a snippet split across concatenation -- decls ^ "(defn f
[s [u8]] Cursor ...)" -- cannot see the names the other half declared; pooled
names count only in bare-symbol position, for the same reason the prelude's do.
A fragment that cuts off mid-form is skipped rather than guessed at. Five sites
in test_flan.ml still needed a hand, and they are in this commit.
Two things ride along because the sweep needs them: parse.ml reads a lone () as
the return type of a function with no body, which was not a shape the old
optional slot could produce; and the map refusals name () rather than Unit, since
that is now the spelling a caller wrote.
247 lines
9.8 KiB
EmacsLisp
247 lines
9.8 KiB
EmacsLisp
;;; test-flan-mode.el --- Indentation, from written-out shapes -*- lexical-binding: t; -*-
|
|
|
|
;; Loaded by test-flan-cider.el, which runs under `dune test'. It is not a
|
|
;; file of its own in test/dune deliberately: `emacs/*.el' is already a
|
|
;; dependency of that stanza, so a new `.el' here needs no build change.
|
|
;;
|
|
;; Every case is a piece of Flan written the way the corpus writes it, with
|
|
;; every line's indentation thrown away and put back. That is the whole test:
|
|
;; if what comes out is what went in, the indenter agrees with the code that
|
|
;; already exists. A case that is *not* in the corpus is written from
|
|
;; `clojure-mode''s behaviour and says so.
|
|
;;
|
|
;; The cases come from the bug report and from reading the tree for the shapes
|
|
;; that share it: a `let' binding vector, `defn' parameters with and without a
|
|
;; return type, `handler-bind' and `restart-case' clause parameters, and struct
|
|
;; literals in both the `:x' and the `.x' spelling — the two must agree,
|
|
;; because a lane is converting the corpus from one to the other and the
|
|
;; indenter is not allowed to notice.
|
|
|
|
;;; Code:
|
|
|
|
(require 'flan-mode)
|
|
|
|
;; The harness, which is test-flan-cider.el's: it counts and it reports, and
|
|
;; this file is loaded from there.
|
|
(declare-function test-flan--check "test-flan-cider" (name ok))
|
|
|
|
(defun test-flan-mode--reindent (text)
|
|
"Strip TEXT's indentation and let `flan-mode' put it back."
|
|
;; Quiet: `indent-region' reports progress, and in batch that lands in the
|
|
;; middle of the line a failure is being printed on.
|
|
(let ((inhibit-message t))
|
|
(with-temp-buffer
|
|
(insert text)
|
|
(flan-mode)
|
|
(goto-char (point-min))
|
|
;; Leading whitespace off every line but the first: the first line's column
|
|
;; is the buffer's, not the indenter's, and a form is indented relative to
|
|
;; where it starts. `eobp' rather than `forward-line''s return value,
|
|
;; which is 0 for a move to the end of a buffer that has no final newline
|
|
;; and would take the whole last line with it.
|
|
(forward-line 1)
|
|
(while (not (eobp))
|
|
(skip-chars-forward " \t")
|
|
(delete-region (line-beginning-position) (point))
|
|
(forward-line 1))
|
|
(indent-region (point-min) (point-max))
|
|
(buffer-substring-no-properties (point-min) (point-max)))))
|
|
|
|
(defun test-flan-mode--check (name text)
|
|
"Check that TEXT is what `flan-mode' indents it to."
|
|
(let ((got (test-flan-mode--reindent text)))
|
|
(test-flan--check name (equal got text))
|
|
(unless (equal got text)
|
|
;; Line by line, and quoted: the difference is always a count of leading
|
|
;; spaces, which is exactly what two blocks of text printed as-is make
|
|
;; hardest to see.
|
|
(let ((want (split-string text "\n")) (had (split-string got "\n")))
|
|
(while (or want had)
|
|
(unless (equal (car want) (car had))
|
|
(message " want %S\n got %S" (car want) (car had)))
|
|
(setq want (cdr want) had (cdr had)))))))
|
|
|
|
(message "\n-- indentation")
|
|
|
|
;; The bug, as reported: sand.flan's `settle'. The second and later bindings
|
|
;; went one column too far, because the enclosing open is `[' and the symbol
|
|
;; after it is the first binding's *name*, so the old check fell through to
|
|
;; `lisp-indent-function', which treated the vector as a call and aligned under
|
|
;; the first argument — `(+ gravity …)' — instead of under `vel'.
|
|
(test-flan-mode--check
|
|
"a let's bindings align name under name"
|
|
"(defn settle [row i32 col i32] ()
|
|
(let [vel (+ gravity (at velocity row col))
|
|
y (min (- rows 1) (+ row (i32 vel)))]
|
|
(while (> y row)
|
|
(set y (- y 1)))))")
|
|
|
|
;; The same shape one level in, which is where the report was actually hit: a
|
|
;; binding whose value is a struct literal, so the vector's alignment has to
|
|
;; survive a `{' in the middle of it.
|
|
(test-flan-mode--check
|
|
"and still does with a struct literal in a value"
|
|
"(let [tip (rl/Vector2 {.x 15.0 .y 12.0})
|
|
vel (+ gravity 1.0)]
|
|
(draw tip vel))")
|
|
|
|
;; The two spellings must be indented identically. Nothing in the indenter
|
|
;; looks at the key — a brace aligns under its first element whatever that
|
|
;; element is — and this is the test that keeps it that way while the corpus
|
|
;; moves from `:x' to `.x'.
|
|
(test-flan-mode--check
|
|
"a struct literal aligns under its first field"
|
|
"(rl/Rectangle {.x 0.0 .y 0.0
|
|
.width (f32 screen-width)
|
|
.height (f32 screen-height)})")
|
|
|
|
;; The colon spelling is gone from the language — the parser refuses it — but a
|
|
;; map literal will be written this way, and the indenter must not have learned
|
|
;; the difference: it aligns under the first element of a brace and never looks
|
|
;; at what that element is spelled like.
|
|
(test-flan-mode--check
|
|
"and a brace of keyword keys aligns exactly the same way"
|
|
"(counts {:north 0 :south 1
|
|
:east 2
|
|
:west 3})")
|
|
|
|
;; `defn' carries a return type between the parameters and the body, and it is
|
|
;; optional. Both spellings indent the body by two, which is why the spec is
|
|
;; `:defn' and not a count: a count would have to know whether the type is
|
|
;; there.
|
|
(test-flan-mode--check
|
|
"a defn with a return type indents its body by two"
|
|
"(defn look [n i64 label string] i64
|
|
(print label)
|
|
n)")
|
|
|
|
(test-flan-mode--check
|
|
"and a defn without one indents it the same"
|
|
"(defn show-trim [s string] ()
|
|
(print s)
|
|
(println \"\"))")
|
|
|
|
;; A parameter list that wraps is the binding-vector rule again: it is a
|
|
;; vector, so it aligns under its first element and not under its second.
|
|
(test-flan-mode--check
|
|
"a wrapped parameter list aligns under the first parameter"
|
|
"(defn move-grain [row i32 col i32
|
|
to-row i32 to-col i32
|
|
vel f32] ()
|
|
(set moved true))")
|
|
|
|
;; `handler-bind' clauses: the vector is the special argument, and each clause
|
|
;; inside it is `(Name [params] body…)' — `defn' with the name left off. The
|
|
;; body indents by two from the clause's own paren, which is the rule the head
|
|
;; cannot be looked up for: `StorageExhausted' is a name the program invented.
|
|
(test-flan-mode--check
|
|
"a handler-bind clause indents its body under its own paren"
|
|
"(handler-bind
|
|
[(StorageExhausted [c]
|
|
(set failures (+ failures 1))
|
|
(invoke-restart 'retry))]
|
|
(load-all))")
|
|
|
|
(test-flan-mode--check
|
|
"and two clauses in one vector line up with each other"
|
|
"(handler-bind [(AssetMissing [c] (set seen (+ seen 10)))
|
|
(Corrupt [c] (set other (+ other 1)))]
|
|
(load-all))")
|
|
|
|
;; `restart-case' is 1 rather than 0: with 0 a protected form written on the
|
|
;; head's line would drag every clause out to align under it.
|
|
(test-flan-mode--check
|
|
"restart-case clauses indent by two under a protected form on the head's line"
|
|
"(defn fetch [n i32] i32
|
|
(restart-case (middle n)
|
|
(use-placeholder [] -1)
|
|
(retry [] 7)))")
|
|
|
|
(test-flan-mode--check
|
|
"and by two when the protected form is on its own line"
|
|
"(restart-case
|
|
(do (agent/poll)
|
|
(game-update))
|
|
(continue [] (do)))")
|
|
|
|
;; `declare-c' writes its parameters, return type and C symbol down the page in
|
|
;; one column.
|
|
(test-flan-mode--check
|
|
"declare-c puts everything after the name in one column"
|
|
"(declare-c mouse-button-pressed?
|
|
[button MouseButton] bool
|
|
\"IsMouseButtonPressed\")")
|
|
|
|
;; An ordinary call, in the two cases every Lisp separates.
|
|
(test-flan-mode--check
|
|
"a call with an argument on the head's line aligns under that argument"
|
|
"(rl/draw-text \"hello\"
|
|
10 20 30)")
|
|
|
|
(test-flan-mode--check
|
|
"a call whose head is alone on its line indents its arguments by a body"
|
|
"(rl/draw-rectangle-lines-ex
|
|
(rl/Rectangle {.x 0.0 .y 0.0})
|
|
(f32 2.0) (rl/get-color 0x303030FF))")
|
|
|
|
;; A `do' is all body, so its second form aligns under its first.
|
|
(test-flan-mode--check
|
|
"a do aligns its forms with the first one"
|
|
"(do (agent/poll)
|
|
(game-update))")
|
|
|
|
;; Field access is an ordinary call whose head begins with a dot. `.' is a
|
|
;; symbol constituent, so nothing special is needed — but if it ever stopped
|
|
;; being one, `(.x v)' would start indenting as data and this is what would
|
|
;; say so.
|
|
(test-flan-mode--check
|
|
"field access indents as the call it is"
|
|
"(set total
|
|
(+ (.bytes c)
|
|
(.align c)))")
|
|
|
|
;; `#_' discards the form after it, so the reader sees pairs either way and the
|
|
;; alignment must not shift. See `lib/reader.ml'.
|
|
(test-flan-mode--check
|
|
"a discarded binding does not disturb the pairs around it"
|
|
"(let [#_a #_1 b 2
|
|
c 3]
|
|
(print c))")
|
|
|
|
|
|
;;; Font lock
|
|
|
|
;; The colon-to-dot change left every field label in the corpus unfontified:
|
|
;; the keyword rule used to cover them, and the colon belongs to keywords now.
|
|
|
|
(defun test-flan-mode--face-at (text needle)
|
|
"The face on the first character of NEEDLE in TEXT, under `flan-mode'."
|
|
(with-temp-buffer
|
|
(insert text)
|
|
(flan-mode)
|
|
(font-lock-ensure)
|
|
(goto-char (point-min))
|
|
(search-forward needle)
|
|
(get-text-property (- (point) (length needle)) 'face)))
|
|
|
|
(message "\n-- font lock")
|
|
|
|
(dolist (case '(("(rl/Vector2 {.x 1.0 .y 2.0})" ".x" "a struct literal's field label")
|
|
("(rl/Vector2 {.x 1.0 .y 2.0})" ".y" "and the second one")
|
|
("(set total (.bytes c))" ".bytes" "a field accessor")
|
|
;; The keyword rule is still there: an enum member is one.
|
|
("(rl/mouse-button-down? :left)" ":left" "an enum member")))
|
|
(test-flan--check (format "%s is a constant" (nth 2 case))
|
|
(eq (test-flan-mode--face-at (nth 0 case) (nth 1 case))
|
|
'font-lock-constant-face)))
|
|
|
|
;; A dot inside a number is not a label, and neither is the dot in a name that
|
|
;; has one in the middle.
|
|
;; A dot in the middle of a name is not a label: `\_<' anchors the rule to the
|
|
;; start of a symbol, and `a.b' is one symbol starting at `a'.
|
|
(test-flan--check "a dot inside a name does not start a label"
|
|
(null (test-flan-mode--face-at "(f alpha.beta)" ".beta")))
|
|
|
|
(provide 'test-flan-mode)
|
|
;;; test-flan-mode.el ends here
|