Files
IPS_W-assignments/W2/fasto/tools/emacs/fasto-mode.el
NikolajDanger ba22cff91f stehau
2022-05-15 12:54:29 +02:00

363 lines
11 KiB
EmacsLisp

;;; fasto-mode.el --- major mode for editing Fasto source files
;; Copyright (C) DIKU 2014-2017, University of Copenhagen
;; Based on futhark-mode.el <https://github.com/HIPERFIT/futhark>
;;; Commentary:
;; This mode provides syntax highlighting and automatic indentation for
;; Fasto source files.
;;
;; This mode provides the following features for Fasto source files:
;;
;; + syntax highlighting
;; + automatic indentation
;;
;; To load fasto-mode automatically on Emacs startup, make sure this
;; file is in your load path and then require the mode, e.g. something
;; like this:
;;
;; (add-to-list 'load-path "path/to/fasto/tools/emacs")
;; (require 'fasto-mode)
;;
;; This will also tell your Emacs that ".fo" files are to be handled by
;; fasto-mode.
;;
;; Define your local keybindings in `fasto-mode-map', and add startup
;; functions to `fasto-mode-hook'.
;;
;; Report bugs to Niels.
;;; Basics
(require 'cl) ; `some'
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.fo\\'" . fasto-mode))
(defvar fasto-mode-hook nil
"Hook for fasto-mode. Is run whenever the mode is entered.")
(defvar fasto-mode-map
(make-keymap)
"Keymap for fasto-mode.")
(defconst fasto-keywords
'("if" "then" "else" "let" "in" "fun" "fn" "op")
"All Fasto keywords.")
(defconst fasto-builtin-functions
'("iota" "replicate" "map" "reduce" "scan" "read" "write" "not")
"All Fasto builtin SOACs, functions and non-symbolic operators.")
(defconst fasto-builtin-operators
'("+" "-" "==" "<" "~" "&&" "||")
"All Fasto builtin symbolic operators.")
(defconst fasto-builtin-types
'("int" "bool" "char")
"All Fasto builtin primitive types.")
(defconst fasto-booleans
'("true" "false")
"All Fasto booleans.")
(defconst fasto-type
(concat "\\[*" "\\<" (regexp-opt fasto-builtin-types 'nil) "\\>" "\\]*")
"A regex describing a Fasto type.")
(defconst fasto-var
(concat "\\(?:" "[_'[:alnum:]]+" "\\)")
"A regex describing a Fasto variable.")
;;; Highlighting
(let (
(ws "[[:space:]\n]*")
(ws1 "[[:space:]\n]+")
)
(defvar fasto-font-lock
`(
;; Function declarations.
(,(concat "fun" ws1 fasto-type ws1 "\\(" fasto-var "\\)")
. '(1 font-lock-function-name-face))
;; Function parameters.
(,(concat "\\(?:" "(" "\\|" "," "\\)" ws
fasto-type ws1 "\\(" fasto-var "\\)")
. '(1 font-lock-variable-name-face))
;; Let declarations.
(,(concat "let" ws1
"\\(" fasto-var "\\)")
. '(1 font-lock-variable-name-face))
;; Keywords.
(,(regexp-opt fasto-keywords 'words)
. font-lock-keyword-face)
;; Types.
(,fasto-type
. font-lock-type-face)
;; Builtins.
;;; Functions.
(,(regexp-opt fasto-builtin-functions 'words)
. font-lock-builtin-face)
;;; Operators.
(,(regexp-opt fasto-builtin-operators)
. font-lock-builtin-face)
;; Constants.
;;; Booleans.
(,(regexp-opt fasto-booleans 'words)
. font-lock-constant-face)
)
"Highlighting expressions for Fasto.")
)
(defvar fasto-mode-syntax-table
(let ((st (make-syntax-table)))
;; Define the // line comment syntax.
(modify-syntax-entry ?/ ". 123" st)
(modify-syntax-entry ?\n ">" st)
;; Make apostrophe and underscore be part of variable names.
;; Technically, they should probably be part of the symbol class,
;; but it works out better for some of the regexpes if they are part
;; of the word class.
(modify-syntax-entry ?' "w" st)
(modify-syntax-entry ?_ "w" st)
(modify-syntax-entry ?\\ "_" st)
st)
"Syntax table used in `fasto-mode'.")
;;; Indentation
(defvar fasto-indent-level 2
"The basic indent level for fasto-mode.")
(defun fasto-indent-line ()
"Indent current line as Fasto code."
(let ((savep (> (current-column) (current-indentation)))
(indent (or (fasto-calculate-indentation)
(current-indentation))))
(if savep ; The cursor is beyond leading whitespace.
(save-excursion (indent-line-to indent))
(indent-line-to indent))))
(defun fasto-calculate-indentation ()
"Calculate the indentation for the current line.
In general, prefer as little indentation as possible."
(let ((parse-sexp-lookup-properties t)
(parse-sexp-ignore-comments t))
(save-excursion
(fasto-beginning-of-line-text)
;; The following code is fickle and deceptive. Don't change it
;; unless you kind of know what you're doing!
(or
;; Align comment to next non-comment line.
(and (looking-at comment-start)
(forward-comment (count-lines (point-min) (point)))
(current-column))
;; Align global function definitions to column 0.
(and (fasto-looking-at-word "fun")
0)
;; Align closing parentheses and commas to the matching opening
;; parenthesis.
(save-excursion
(and (looking-at (regexp-opt '(")" "]" ",")))
(ignore-errors
(backward-up-list 1)
(current-column))))
;; Align "in" or "let" to the closest previous "let".
(save-excursion
(and (or (fasto-looking-at-word "in")
(fasto-looking-at-word "let"))
(let ((m
(save-excursion
(fasto-keyword-backward "let"))
))
(and (not (eq nil m))
(goto-char m)
(current-column)))))
;; Otherwise, if the previous code line ends with "in" align to
;; the matching "let" column.
(save-excursion
(and (fasto-backward-part)
(looking-at "\\<in[[:space:]]*$")
(let ((m
(save-excursion
(fasto-keyword-backward "let"))
))
(and (not (eq nil m))
(goto-char m)
(current-column)))))
;; If the previous code line ends with "=", align to the matching "fun"
;; or "let" column plus one indent level.
(save-excursion
(and (fasto-backward-part)
(looking-at "=[[:space:]]*$")
(let ((m
(fasto-max
(save-excursion
(fasto-keyword-backward "fun"))
(save-excursion
(fasto-keyword-backward "let")))
))
(and (not (eq nil m))
(goto-char m)
(+ (current-column) fasto-indent-level)))))
;; Align "then" to nearest "else if" or "if".
(save-excursion
(and (fasto-looking-at-word "then")
(fasto-keyword-backward "if")
(or
(let ((curline (line-number-at-pos)))
(save-excursion
(and (fasto-backward-part)
(= (line-number-at-pos) curline)
(fasto-looking-at-word "else")
(current-column))))
(current-column))))
;; Align "else" to nearest "then" or "else if" or "if".
(save-excursion
(and (fasto-looking-at-word "else")
(let ((m
(fasto-max
(save-excursion
(and
(fasto-keyword-backward "then")
(fasto-is-beginning-of-line-text)
(point)))
(save-excursion
(let ((pos0 (fasto-keyword-backward "if")))
(or
(let ((curline (line-number-at-pos)))
(and (fasto-backward-part)
(= (line-number-at-pos) curline)
(fasto-looking-at-word "else")
(point)))
pos0))))))
(and (not (eq nil m))
(goto-char m)
(current-column)))))
;; Align general content inside parentheses to the first general
;; non-space content.
(save-excursion
(when (ignore-errors (backward-up-list 1) t)
(forward-char 1)
(fasto-goto-first-text)
(and
(not (fasto-is-looking-at-keyword))
(current-column))))
;; Otherwise, keep the user-specified indentation level.
))))
(defun fasto-max (a b)
"Like `max', but more accepting."
(or (and (eq nil a) b)
(and (eq nil b) a)
(and (not (eq nil a))
(not (eq nil b))
(max a b))))
(defun fasto-beginning-of-line-text ()
"Move to the beginning of the non-whitespace text on this line."
(beginning-of-line)
(fasto-goto-first-text))
(defun fasto-goto-first-text ()
"Skip over whitespace."
(while (looking-at "[[:space:]\n]")
(forward-char)))
(defun fasto-is-beginning-of-line-text ()
"Check if point is at the first word on a line."
(=
(point)
(save-excursion
(fasto-beginning-of-line-text)
(point))))
(defun fasto-is-looking-at-keyword ()
"Check if we are currently looking at a keyword."
(some 'fasto-looking-at-word fasto-keywords))
(defun fasto-backward-part ()
"Try to jump back one sexp.
The net effect seems to be that it works ok."
(and (not (bobp))
(ignore-errors (backward-sexp 1) t)))
(defun fasto-looking-at-word (word)
"Do the same as `looking-at', but also check for blanks around WORD."
(looking-at (concat "\\<" word "\\>")))
(defun fasto-keyword-backward (word)
"Go to a keyword WORD before the current position.
Set mark and return t if found; return nil otherwise."
(let (;; Only look in the current paren-delimited code if present.
(startp (point))
(topp (or (save-excursion (ignore-errors
(backward-up-list 1)
(point)))
(max
(or (save-excursion (fasto-keyword-backward-raw "fun"))
0)
(or (save-excursion (fasto-keyword-backward-raw "entry"))
0))))
(result nil))
(while (and (not result)
(fasto-backward-part)
(>= (point) topp))
(if (fasto-looking-at-word word)
(setq result (point))))
(or result
(progn
(goto-char startp)
nil))))
(defun fasto-keyword-backward-raw (word)
"Go to a keyword WORD before the current position.
Ignore any program structure."
(let ((pstart (point)))
(while (and (fasto-backward-part)
(not (fasto-looking-at-word word))))
(and (fasto-looking-at-word word)
(point))))
;;; Actual mode declaration
(define-derived-mode fasto-mode fundamental-mode "Fasto"
"Major mode for editing Fasto source files."
:syntax-table fasto-mode-syntax-table
(set (make-local-variable 'font-lock-defaults) '(fasto-font-lock))
(set (make-local-variable 'indent-line-function) 'fasto-indent-line)
(set (make-local-variable 'indent-region-function) nil)
(set (make-local-variable 'comment-start) "//")
(set (make-local-variable 'comment-padding) " "))
(provide 'fasto-mode)
;;; fasto-mode.el ends here