branch: elpa/haskell-tng-mode
commit 138aca09406a85363e9d5e12f4d8f0eab8f4c464
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
typelevel lists are harder than I thought...
---
haskell-tng-lexer.el | 17 +++++++++++++++++
haskell-tng-rx.el | 29 ++++++++++++++++++-----------
haskell-tng-smie.el | 11 ++++++-----
haskell-tng-syntax.el | 8 --------
test/haskell-tng-lexer-test.el | 8 ++++++--
test/src/grammar.hs.sexps | 2 +-
test/src/layout.hs.lexer | 2 +-
test/src/layout.hs.sexps | 16 ++++++++--------
test/src/medley.hs.lexer | 10 +++++-----
9 files changed, 62 insertions(+), 41 deletions(-)
diff --git a/haskell-tng-lexer.el b/haskell-tng-lexer.el
index e5bf3b2..3fea0e4 100644
--- a/haskell-tng-lexer.el
+++ b/haskell-tng-lexer.el
@@ -93,6 +93,14 @@ the lexer."
;; interesting from a grammar point of view so we ignore them.
(haskell-tng-lexer:last-match nil "")
(haskell-tng-lexer:forward-token))
+ ((looking-at (rx "'["))
+ ;; DataKinds
+ (null (goto-char (+ (point) 1))))
+ ((looking-at haskell-tng:regexp:kindsym)
+ ;; caveat: doesn't include typelevel lists, see fast-syntax
+ (haskell-tng-lexer:last-match nil "KINDSYM"))
+ ((looking-at haskell-tng:regexp:kindid)
+ (haskell-tng-lexer:last-match nil "KINDID"))
((looking-at haskell-tng:regexp:consym)
(haskell-tng-lexer:last-match nil "CONSYM"))
((looking-at haskell-tng:regexp:conid)
@@ -144,6 +152,15 @@ the lexer."
((looking-back haskell-tng:regexp:qual lbp 't)
(haskell-tng-lexer:last-match 'reverse "")
(haskell-tng-lexer:backward-token))
+ ((and (looking-at (rx "["))
+ (looking-back (rx "'") (- (point) 1)))
+ ;; non-trivial inversion
+ (goto-char (- (point) 1))
+ (haskell-tng-lexer:backward-token))
+ ((looking-back haskell-tng:regexp:kindsym lbp 't)
+ (haskell-tng-lexer:last-match 'reverse "KINDSYM"))
+ ((looking-back haskell-tng:regexp:kindid lbp 't)
+ (haskell-tng-lexer:last-match 'reverse "KINDID"))
((looking-back haskell-tng:regexp:consym lbp 't)
(haskell-tng-lexer:last-match 'reverse "CONSYM"))
((looking-back haskell-tng:regexp:conid lbp 't)
diff --git a/haskell-tng-rx.el b/haskell-tng-rx.el
index eb0a9c3..a9bac83 100644
--- a/haskell-tng-rx.el
+++ b/haskell-tng-rx.el
@@ -12,14 +12,13 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Here are `rx' patterns that are reused as a very simple form of BNF grammar.
-;; Word/symbol boundaries to help backwards regexp searches to be greedy
-(defconst haskell-tng:rx:consym '(: (or "'" ":") ;; Datakinds
- (+ (syntax symbol))))
-(defconst haskell-tng:rx:conid '(: word-start upper (* word)))
-(defconst haskell-tng:rx:varid '(: word-start (any lower ?_) (* (any word))))
+(defconst haskell-tng:rx:consym '(: ":" (* (syntax symbol))))
+(defconst haskell-tng:rx:conid '(: upper (* word)))
+(defconst haskell-tng:rx:varid '(: (any lower ?_) (* (any word))))
(defconst haskell-tng:rx:symid '(: (+ (syntax symbol))))
-(defconst haskell-tng:rx:qual `(: symbol-start
- (+ (: ,haskell-tng:rx:conid (char ?.)))))
+(defconst haskell-tng:rx:qual `(+ (: ,haskell-tng:rx:conid (char ?.))))
+(defconst haskell-tng:rx:kindsym `(: "'" ,haskell-tng:rx:consym)) ;; DataKinds
+(defconst haskell-tng:rx:kindid `(: "'" ,haskell-tng:rx:conid)) ;; DataKinds
(defconst haskell-tng:rx:reserved
'(|
@@ -30,7 +29,8 @@
"then" "type" "where" "_")
word-end)
(: symbol-start
- (| ".." ":" "::" "=" "|" "<-" "->" "@" "~" "=>")
+ ;; not including : as it works as a regular consym
+ (| ".." "::" "=" "|" "<-" "->" "@" "~" "=>")
symbol-end)
(: symbol-start (char ?\\)))
"reservedid / reservedop")
@@ -51,16 +51,23 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compiled regexps
+;;
+;; Word/symbol boundaries to help backwards regexp searches to be greedy and
+;; are not in the BNF form as it breaks composability.
(defconst haskell-tng:regexp:reserved
(rx-to-string haskell-tng:rx:reserved))
(defconst haskell-tng:regexp:qual
- (rx-to-string haskell-tng:rx:qual))
+ (rx-to-string `(: symbol-start ,haskell-tng:rx:qual)))
+(defconst haskell-tng:regexp:kindsym
+ (rx-to-string `(: word-start ,haskell-tng:rx:kindsym)))
+(defconst haskell-tng:regexp:kindid
+ (rx-to-string `(: word-start ,haskell-tng:rx:kindid)))
(defconst haskell-tng:regexp:consym
(rx-to-string haskell-tng:rx:consym))
(defconst haskell-tng:regexp:conid
- (rx-to-string haskell-tng:rx:conid))
+ (rx-to-string `(: word-start ,haskell-tng:rx:conid)))
(defconst haskell-tng:regexp:varid
- (rx-to-string haskell-tng:rx:varid))
+ (rx-to-string `(: word-start ,haskell-tng:rx:varid)))
(defconst haskell-tng:regexp:symid
(rx-to-string haskell-tng:rx:symid))
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 816767e..5bb86c5 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -48,7 +48,7 @@
;; commas only allowed in brackets
(list
("(" list ")")
- ("[" list "]")
+ ("[" list "]") ;; includes DataKinds
(list "," list))
;; operators all have the same precedence
@@ -57,24 +57,25 @@
;; WLDOs
(wldo
- ("where" block)
+ (block "where" block)
("let" block "in")
("do" block)
("case" id "of" block))
(block
("{" block "}")
(block ";" block)
+ (id "=" id)
(id "<-" id)
(id "->" id)
- (id "=" id))
+ )
(logic
("if" id "then" id "else" id))
)
;; operator precedences
- '((assoc ";")
- (assoc ","))
+ '((assoc ";" ",")
+ )
)))
diff --git a/haskell-tng-syntax.el b/haskell-tng-syntax.el
index 1d32423..4946f76 100644
--- a/haskell-tng-syntax.el
+++ b/haskell-tng-syntax.el
@@ -74,7 +74,6 @@
(defun haskell-tng:syntax-propertize (start end)
"For some context-sensitive syntax entries."
(haskell-tng:syntax:char-delims start end)
- (haskell-tng:syntax:typelevel-lists start end)
(haskell-tng:syntax:escapes start end))
(defun haskell-tng:syntax:char-delims (start end)
@@ -87,13 +86,6 @@
(put-text-property open (1+ open) 'syntax-table '(7 . ?\'))
(put-text-property close (1+ close) 'syntax-table '(7 . ?\')))))
-(defun haskell-tng:syntax:typelevel-lists (start end)
- "Apostrophes should be symbols when used in typelevel lists."
- (goto-char start)
- (while (re-search-forward (rx space (char ?') (any ?\[ ?:)) end t)
- (put-text-property (- (point) 1) (point)
- 'syntax-table '(3 . ?'))))
-
(defun haskell-tng:syntax:escapes (start end)
"Backslash inside String is an escape character."
(goto-char start)
diff --git a/test/haskell-tng-lexer-test.el b/test/haskell-tng-lexer-test.el
index fba496a..fcc48e0 100644
--- a/test/haskell-tng-lexer-test.el
+++ b/test/haskell-tng-lexer-test.el
@@ -103,7 +103,9 @@
(syntax string-delimiter))))
(forward-sexp 1)
"§")
- (t (error "Bumped into unknown token")))))
+ (t (error "Unknown token: '%s' with '%S'"
+ (string (char-after))
+ (syntax-after (point)))))))
;; same as above, but for `smie-indent-backward-token'
(defun haskell-tng-lexer-test:indent-backward-token ()
@@ -122,7 +124,9 @@
(- (point) 1))
(backward-sexp 1)
"§")
- (t (error "Bumped into unknown token")))))
+ (t (error "Unknown token: '%s' with '%S'"
+ (string (char-before))
+ (syntax-before (point)))))))
(defun haskell-tng-lexer-test:tokens (&optional reverse)
"Lex the current buffer using SMIE and return the list of lines,
diff --git a/test/src/grammar.hs.sexps b/test/src/grammar.hs.sexps
index 155fe72..1f02b76 100644
--- a/test/src/grammar.hs.sexps
+++ b/test/src/grammar.hs.sexps
@@ -1,5 +1,5 @@
-- | Tests for grammar rules i.e. sexps, not indentation
-(module) (Foo.(Bar)) (where
+((module) (Foo.(Bar)) (where)
((calc) (::) (Int) -> (Int)
((calc) (a) = (if (a) < ((10)
diff --git a/test/src/layout.hs.lexer b/test/src/layout.hs.lexer
index 1920ad6..ce06291 100644
--- a/test/src/layout.hs.lexer
+++ b/test/src/layout.hs.lexer
@@ -9,7 +9,7 @@ module CONID « CONID , VARID , VARID , VARID , VARID » where
; VARID :: CONID VARID -> CONID
; VARID VARID = VARID « VARID VARID » where
{ VARID CONID = « »
-; VARID « CONID VARID VARID » = VARID SYMID VARID where { VARID = VARID VARID
+; VARID « CONID VARID VARID » = VARID CONSYM VARID where { VARID = VARID VARID
} } ; VARID :: CONID VARID -> « VARID , CONID VARID »
; VARID « CONID VARID VARID »
diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps
index 95d7726..2fcfe45 100644
--- a/test/src/layout.hs.sexps
+++ b/test/src/layout.hs.sexps
@@ -1,20 +1,20 @@
-- Figure 2.1 from the Haskell2010 report
-(module) (AStack)( (Stack), (push), (pop), (top), (size) ) (where
-((data) (Stack) (a) = (Empty)
+((module) (AStack)( (Stack), (push), (pop), (top), (size) ) (where)
+(((data) (Stack) (a) = (Empty)
(|) (MkStack) (a) ((Stack) (a))
((push) (::) (a) -> (Stack) (a) -> (Stack) (a))
((push) (x) (s) = (MkStack) (x) (s))
((size) (::) (Stack) (a) -> (Int))
-((size) (s) = (length) ((stkToLst) (s)) (where
- ((stkToLst) (Empty) = ([])
- ((stkToLst) ((MkStack) (x) (s)) = (x):(xs) (where ((xs) =
(stkToLst) (s)
+((size) (s) = (length) ((stkToLst) (s))) (where)
+ (((stkToLst) (Empty) = ([])
+ ((stkToLst) ((MkStack) (x) (s)) = (x)(:)(xs)) (where) ((xs) =
(stkToLst) (s)
-))))(pop) (::) (Stack) (a) -> ((a), (Stack) (a))
+)))(pop) (::) (Stack) (a) -> ((a), (Stack) (a))
((pop) ((MkStack) (x) (s))
- = ((x), ((case (s) (of) (r -> (i) (r) (where (i (x) = x))))))) -- pop Empty
is an error
+ = ((x), ((case (s) (of) ((r -> (i) (r) (where) (i (x) = x))))))) -- pop
Empty is an error
((top) (::) (Stack) (a) -> (a))
-((top) ((MkStack) (x) (s)) = (x)))) -- top Empty is an
error
+((top) ((MkStack) (x) (s)) = (x))) -- top Empty is an error
))
\ No newline at end of file
diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer
index 21bd33d..2ebf636 100644
--- a/test/src/medley.hs.lexer
+++ b/test/src/medley.hs.lexer
@@ -43,10 +43,10 @@ VARID , VARID , VARID »
; class CONID VARID VARID where
{ VARID :: CONID VARID -> VARID
-} ; instance CONID VARID « VARID CONSYM VARID » where
+} ; instance CONID VARID « VARID KINDSYM VARID » where
{ VARID « CONID VARID _ » = VARID
-} ; instance CONID VARID VARID => CONID VARID « VARID CONSYM VARID » where
+} ; instance CONID VARID VARID => CONID VARID « VARID KINDSYM VARID » where
{ VARID « CONID _ VARID » = VARID VARID
} ; data CONID = CONID
@@ -118,11 +118,11 @@ VARID § » »
CONSYM CONID § CONID
CONSYM CONID CONID CONID
CONSYM CONID
-CONSYM CONID CONSYM CONID » « CONID CONID »
-CONSYM § CONSYM CONID CONSYM CONID » CONID
+CONSYM CONID « CONID » « CONID CONID »
+CONSYM § CONSYM CONID « CONID » CONID
CONSYM CONID CONID CONID
CONSYM CONID
-CONSYM CONID CONSYM CONID » « CONID CONID »
+CONSYM CONID « CONID » « CONID CONID »
; deriving instance CONID CONID
; deriving VARID instance CONID CONID
