diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-lexeme.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-lexeme.el | 513 |
1 files changed, 0 insertions, 513 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-lexeme.el b/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-lexeme.el deleted file mode 100644 index 877774e7756b..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/haskell-mode-20180913.348/haskell-lexeme.el +++ /dev/null @@ -1,513 +0,0 @@ -;;; haskell-lexeme.el --- haskell lexical tokens -*- coding: utf-8; lexical-binding: t -*- - -;; Copyright (C) 2015 Gracjan Polak - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(require 'rx) - -(unless (category-docstring ?P) - (define-category ?P "Haskell symbol constituent characters") - (map-char-table - #'(lambda (key val) - (if (or - (and (consp key) (> (car key) 128)) - (and (numberp key) (> key 128))) - (if (member val '(Pc Pd Po Sm Sc Sk So)) - (modify-category-entry key ?P)))) - unicode-category-table) - - (dolist (key (string-to-list "!#$%&*+./<=>?@^|~\\-:")) - (modify-category-entry key ?P))) - -(defconst haskell-lexeme-modid - "[[:upper:]][[:alnum:]'_]*" - "Regexp matching a valid Haskell module identifier. - -Note that GHC accepts Unicode category UppercaseLetter as a first -character. Following letters are from Unicode categories -UppercaseLetter, LowercaseLetter, OtherLetter, TitlecaseLetter, -ModifierLetter, DecimalNumber, OtherNumber, backslash or -underscore.") - -(defconst haskell-lexeme-id - "[[:alpha:]_][[:alnum:]'_]*" - "Regexp matching a valid Haskell identifier. - -GHC accepts a string starting with any alphabetic character or -underscore followed by any alphanumeric character or underscore -or apostrophe.") - -(defconst haskell-lexeme-sym - "\\cP+" - "Regexp matching a valid Haskell variable or constructor symbol. - -GHC accepts a string of chars from the set -[:!#$%&*+./<=>?@^|~\\-] or Unicode category Symbol for chars with -codes larger than 128 only.") - -(defconst haskell-lexeme-idsym-first-char - "\\(?:[[:alpha:]_]\\|\\cP\\)" - "Regexp matching first character of a qualified or unqualified -identifier or symbol. - -Useful for `re-search-forward'.") - -(defconst haskell-lexeme-modid-opt-prefix - (concat "\\(?:" haskell-lexeme-modid "\\.\\)*") - "Regexp matching a valid Haskell module prefix, potentially empty. - -Module path prefix is separated by dots and finishes with a -dot. For path component syntax see `haskell-lexeme-modid'.") - -(defconst haskell-lexeme-qid-or-qsym - (rx-to-string `(: (regexp ,haskell-lexeme-modid-opt-prefix) - (group (| (regexp ,haskell-lexeme-id) (regexp ,haskell-lexeme-sym) - )))) - "Regexp matching a valid qualified identifier or symbol. - -Note that (match-string 1) returns the unqualified part.") - -(defun haskell-lexeme-looking-at-qidsym () - "Non-nil when point is just in front of an optionally qualified -identifier or symbol. - -Using this function is more efficient than matching against the -regexp `haskell-lexeme-qid-or-qsym'. - -Returns: - 'qid - if matched a qualified id: 'Data.Map' or 'Map' - 'qsym - if matched a qualified id: 'Monad.>>=' or '>>=' - 'qprefix - if matched only modid prefix: 'Data.' - -After successful 'qid or 'qsym match (match-string 1) will return -the unqualified part (if any)." - (let ((begin (point)) - (match-data-old (match-data))) - (save-excursion - (while (looking-at (concat haskell-lexeme-modid "\\.")) - (goto-char (match-end 0))) - (cond - ((looking-at haskell-lexeme-id) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - - ;; check is MagicHash is present at the end of the token - (goto-char end) - (when (looking-at "#+") - (setq end (match-end 0))) - - (set-match-data - (list begin end - beg end))) - 'qid) - ((looking-at haskell-lexeme-sym) - (set-match-data - (list begin (match-end 0) - (match-beginning 0) (match-end 0))) - 'qsym) - ((equal begin (point)) - (set-match-data match-data-old) - nil) - (t - (set-match-data - (list begin (point) - nil nil)) - 'qprefix))))) - -(defun haskell-lexeme-looking-at-backtick () - "Non-nil when point is just in front of an identifier quoted with backticks. - -When match is successful, match-data will contain: - (match-text 1) - opening backtick - (match-text 2) - whole qualified identifier - (match-text 3) - unqualified part of identifier - (match-text 4) - closing backtick" - (let ((match-data-old (match-data)) - first-backtick-start - last-backtick-start - qid-start - id-start - id-end - result) - (save-excursion - (when (looking-at "`") - (setq first-backtick-start (match-beginning 0)) - (goto-char (match-end 0)) - (forward-comment (buffer-size)) - (when (haskell-lexeme-looking-at-qidsym) - (setq qid-start (match-beginning 0)) - (setq id-start (match-beginning 1)) - (setq id-end (match-end 1)) - (goto-char (match-end 0)) - (forward-comment (buffer-size)) - (when (looking-at "`") - (setq last-backtick-start (match-beginning 0)) - (set-match-data - (mapcar - (lambda (p) - (set-marker (make-marker) p)) - (list - first-backtick-start (1+ last-backtick-start) - first-backtick-start (1+ first-backtick-start) - qid-start id-end - id-start id-end - last-backtick-start (1+ last-backtick-start)))) - (setq result t))))) - (unless result - (set-match-data match-data-old)) - result)) - -(defconst haskell-lexeme-qid - (rx-to-string `(: (regexp "'*") - (regexp ,haskell-lexeme-modid-opt-prefix) - (group (regexp ,haskell-lexeme-id)))) - "Regexp matching a valid qualified identifier. - -Note that (match-string 1) returns the unqualified part.") - -(defconst haskell-lexeme-qsym - (rx-to-string `(: (regexp "'*") - (regexp ,haskell-lexeme-modid-opt-prefix) - (group (regexp ,haskell-lexeme-id)))) - "Regexp matching a valid qualified symbol. - -Note that (match-string 1) returns the unqualified part.") - -(defconst haskell-lexeme-number - (rx (| (: (regexp "[0-9]+\\.[0-9]+") (opt (regexp "[eE][-+]?[0-9]+"))) - (regexp "[0-9]+[eE][-+]?[0-9]+") - (regexp "0[xX][0-9a-fA-F]+") - (regexp "0[oO][0-7]+") - (regexp "[0-9]+"))) - "Regexp matching a floating point, decimal, octal or hexadecimal number. - -Note that negative sign char is not part of a number.") - -(defconst haskell-lexeme-char-literal-inside - (rx (| (not (any "\n'\\")) - (: "\\" - (| "a" "b" "f" "n" "r" "t" "v" "\\" "\"" "'" - "NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" - "BEL" "BS" "HT" "LF" "VT" "FF" "CR" "SO" "SI" "DLE" - "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" "CAN" - "EM" "SUB" "ESC" "FS" "GS" "RS" "US" "SP" "DEL" - (regexp "[0-9]+") - (: "x" (regexp "[0-9a-fA-F]+")) - (: "o" (regexp "[0-7]+")) - (: "^" (regexp "[]A-Z@^_\\[]")))))) - "Regexp matching an inside of a character literal. - -Note that `haskell-lexeme-char-literal-inside' matches strictly -only escape sequences defined in Haskell Report.") - -(defconst haskell-lexeme--char-literal-rx - (rx-to-string `(: (group "'") - (| (: (group (regexp "[[:alpha:]_([]")) (group "'")) ; exactly one char - (: (group (| (regexp "\\\\[^\n][^'\n]*") ; allow quote just after first backslash - (regexp "[^[:alpha:]_:(['\n][^'\n]*"))) - (| (group "'") "\n" (regexp "\\'")))))) - "Regexp matching a character literal lookalike. - -Note that `haskell-lexeme--char-literal-rx' matches more than -Haskell Report specifies because we want to support also code -under edit. - -Character literals end with a quote or a newline or end of -buffer. - -Regexp has subgroup expressions: - (match-text 1) matches the opening quote. - (match-text 2) matches the inside of the character literal. - (match-text 3) matches the closing quote or an empty string - at the end of line or the end buffer.") - -(defun haskell-lexeme-looking-at-char-literal () - "Non-nil when point is at a char literal lookalike. - -Note that this function matches more than Haskell Report -specifies because we want to support also code under edit. - -Char literals end with a quote or an unescaped newline or end -of buffer. - -After successful match: - (match-text 1) matches the opening quote. - (match-text 2) matches the inside of the char literla. - (match-text 3) matches the closing quote, or a closing - newline or is nil when at the end of the buffer." - (when (looking-at haskell-lexeme--char-literal-rx) - (set-match-data - (list (match-beginning 0) (match-end 0) - (match-beginning 1) (match-end 1) - (or (match-beginning 2) (match-beginning 4)) (or (match-end 2) (match-end 4)) - (or (match-beginning 3) (match-beginning 5)) (or (match-end 3) (match-end 5)))) - t)) - -(defconst haskell-lexeme-string-literal-inside-item - (rx (| (not (any "\n\"\\")) - (: "\\" - (| "a" "b" "f" "n" "r" "t" "v" "\\" "\"" "'" "&" - "NUL" "SOH" "STX" "ETX" "EOT" "ENQ" "ACK" - "BEL" "BS" "HT" "LF" "VT" "FF" "CR" "SO" "SI" "DLE" - "DC1" "DC2" "DC3" "DC4" "NAK" "SYN" "ETB" "CAN" - "EM" "SUB" "ESC" "FS" "GS" "RS" "US" "SP" "DEL" - (regexp "[0-9]+") - (: "x" (regexp "[0-9a-fA-F]+")) - (: "o" (regexp "[0-7]+")) - (: "^" (regexp "[]A-Z@^_\\[]")) - (regexp "[ \t\n\r\v\f]*\\\\"))))) - "Regexp matching an item that is a single character or a single -escape sequence inside of a string literal. - -Note that `haskell-lexeme-string-literal-inside-item' matches -strictly only escape sequences defined in Haskell Report.") - -(defconst haskell-lexeme-string-literal - (rx (: (group "\"") - (group (* (| (regexp "\\\\[ \t\n\r\v\f]*\\\\") - (regexp "\\\\[ \t\n\r\v\f]+") - (regexp "\\\\[^ \t\n\r\v\f]") - (* (regexp "[^\"\n\\]"))))) - (group (| "\"" (regexp "$") (regexp "\\\\?\\'") - )))) - "Regexp matching a string literal lookalike. - -Note that `haskell-lexeme-string-literal' matches more than -Haskell Report specifies because we want to support also code -under edit. - -String literals end with double quote or unescaped newline or end -of buffer. - -Regexp has subgroup expressions: - (match-text 1) matches the opening double quote. - (match-text 2) matches the inside of the string. - (match-text 3) matches the closing double quote or an empty string - at the end of line or the end buffer.") - -(defun haskell-lexeme-looking-at-string-literal () - "Non-nil when point is at a string literal lookalike. - -Note that this function matches more than Haskell Report -specifies because we want to support also code under edit. - -String literals end with double quote or unescaped newline or end -of buffer. - -After successful match: - (match-text 1) matches the opening doublequote. - (match-text 2) matches the inside of the string. - (match-text 3) matches the closing quote, or a closing - newline or is nil when at the end of the buffer." - (when (looking-at "\"") - (save-excursion - (let ((begin (point))) - (goto-char (match-end 0)) - (let (finish) - (while (and (not finish) - (re-search-forward "[\"\n\\]" nil 'goto-eob)) - (cond - ((equal (match-string 0) "\\") - (if (looking-at "[ \t\n\r\v\f]+\\\\?") - (goto-char (match-end 0)) - (goto-char (1+ (point))))) - - ((equal (match-string 0) "\"") - (set-match-data - (list begin (match-end 0) - begin (1+ begin) - (1+ begin) (match-beginning 0) - (match-beginning 0) (match-end 0))) - (setq finish t)) - - ((equal (match-string 0) "\n") - (set-match-data - (list begin (match-beginning 0) - begin (1+ begin) - (1+ begin) (match-beginning 0) - nil nil)) - (setq finish t)))) - (unless finish - ;; string closed by end of buffer - (set-match-data - (list begin (point) - begin (1+ begin) - (1+ begin) (point) - nil nil)))))) - ;; there was a match - t)) - -(defun haskell-lexeme-looking-at-quasi-quote-literal () - "Non-nil when point is just in front of Template Haskell -quaisquote literal. - -Quasi quotes start with '[xxx|' or '[$xxx|' sequence and end with - '|]'. The 'xxx' is a quoter name. There is no escaping mechanism -provided for the ending sequence. - -Regexp has subgroup expressions: - (match-text 1) matches the quoter name (without $ sign if present). - (match-text 2) matches the opening vertical bar. - (match-text 3) matches the inside of the quoted string. - (match-text 4) matches the closing vertical bar - or nil if at the end of the buffer. - -Note that this function excludes 'e', 't', 'd', 'p' as quoter -names according to Template Haskell specification." - (let ((match-data-old (match-data))) - (if (and - (looking-at (rx-to-string `(: "[" (optional "$") - (group (regexp ,haskell-lexeme-id)) - (group "|")))) - (equal (haskell-lexeme-classify-by-first-char (char-after (match-beginning 1))) - 'varid) - (not (member (match-string 1) '("e" "t" "d" "p")))) - (save-excursion - ;; note that quasi quote syntax does not have any escaping - ;; mechanism and if not closed it will span til lthe end of buffer - (goto-char (match-end 0)) - (let ((match-data (match-data)) - (match-data-2 (and (re-search-forward "|]" nil t) - (match-data)))) - (if match-data-2 - (set-match-data - (list - (nth 0 match-data) (nth 1 match-data-2) ;; whole match - (nth 2 match-data) (nth 3 match-data) ;; quoter name - (nth 4 match-data) (nth 5 match-data) ;; opening bar - (nth 5 match-data) (nth 0 match-data-2) ;; inner string - (nth 0 match-data-2) (1+ (nth 0 match-data-2)))) ;; closing bar - - (set-match-data - (list - (nth 0 match-data) (point-max) ;; whole match - (nth 2 match-data) (nth 3 match-data) ;; quoter name - (nth 4 match-data) (nth 5 match-data) ;; opening bar - (nth 5 match-data) (point-max) ;; inner string - nil nil)) ;; closing bar - )) - t) - ;; restore old match data if not matched - (set-match-data match-data-old) - nil))) - -(defun haskell-lexeme-classify-by-first-char (char) - "Classify token by CHAR. - -CHAR is a chararacter that is assumed to be the first character -of a token." - (let ((category (get-char-code-property (or char ?\ ) 'general-category))) - - (cond - ((or (member char '(?! ?# ?$ ?% ?& ?* ?+ ?. ?/ ?< ?= ?> ?? ?@ ?^ ?| ?~ ?\\ ?-)) - (and (> char 127) - (member category '(Pc Pd Po Sm Sc Sk So)))) - 'varsym) - ((equal char ?:) - 'consym) - ((equal char ?\') - 'char) - ((equal char ?\") - 'string) - ((member category '(Lu Lt)) - 'conid) - ((or (equal char ?_) - (member category '(Ll Lo))) - 'varid) - ((and (>= char ?0) (<= char ?9)) - 'number) - ((member char '(?\] ?\[ ?\( ?\) ?\{ ?\} ?\` ?\, ?\;)) - 'special)))) - -(defun haskell-lexeme-looking-at-token (&rest flags) - "Like `looking-at' but understands Haskell lexemes. - -Moves point forward over whitespace. Returns a symbol describing -type of Haskell token recognized. Use `match-string', -`match-beginning' and `match-end' with argument 0 to query match -result. - -Possible results are: -- 'special: for chars [](){}`,; -- 'comment: for single line comments -- 'nested-comment: for multiline comments -- 'qsymid: for qualified identifiers or symbols -- 'string: for strings literals -- 'char: for char literals -- 'number: for decimal, float, hexadecimal and octal number literals -- 'template-haskell-quote: for a string of apostrophes for template haskell -- 'template-haskell-quasi-quote: for a string of apostrophes for template haskell - -Note that for qualified symbols (match-string 1) returns the -unqualified identifier or symbol. Further qualification for -symbol or identifier can be done with: - - (haskell-lexeme-classify-by-first-char (char-after (match-beginning 1))) - -See `haskell-lexeme-classify-by-first-char' for details." - (while - ;; Due to how unterminated strings terminate at newline, some - ;; newlines have syntax set to generic string delimeter. We want - ;; those to be treated as whitespace anyway - (or - (> (skip-syntax-forward "-") 0) - (and (not (member 'newline flags)) - (> (skip-chars-forward "\n") 0)))) - (let - ((case-fold-search nil) - (point (point-marker))) - (or - (and - (equal (string-to-syntax "<") - (get-char-property (point) 'syntax-table)) - (progn - (set-match-data (list point (set-marker (make-marker) (line-end-position)))) - 'literate-comment)) - (and (looking-at "\n") - 'newline) - (and (looking-at "{-") - (save-excursion - (forward-comment 1) - (set-match-data (list point (point-marker))) - 'nested-comment)) - (and (haskell-lexeme-looking-at-char-literal) - 'char) - (and (haskell-lexeme-looking-at-string-literal) - 'string) - (and (looking-at "[][(){}`,;]") - (if (haskell-lexeme-looking-at-quasi-quote-literal) - 'template-haskell-quasi-quote - 'special)) - (and (haskell-lexeme-looking-at-qidsym) - (if (save-match-data - (string-match "\\`---*\\'" (match-string-no-properties 0))) - (progn - (set-match-data (list point (set-marker (make-marker) (line-end-position)))) - 'comment) - 'qsymid)) - (and (looking-at haskell-lexeme-number) - 'number) - (and (looking-at "'+") - 'template-haskell-quote) - (and (looking-at ".") - 'illegal)))) - -(provide 'haskell-lexeme) - -;;; haskell-lexeme.el ends here |