forked from haskell/haskell-mode
-
Notifications
You must be signed in to change notification settings - Fork 0
/
haskell-lexeme.el
514 lines (441 loc) · 18.8 KB
/
haskell-lexeme.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
;;; 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 "$")
(regexp ,haskell-lexeme-modid-opt-prefix)
(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