[nongnu] elpa/haskell-tng-mode 6c520bc 093/385: fixes for type level lists

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 6c520bc30d4fd0f65844308da05488d0c5ed9189
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    fixes for type level lists
---
 haskell-tng-lexer.el           | 19 +++++++++++--------
 haskell-tng-rx.el              | 38 ++++++++++++++++++++++++++++----------
 haskell-tng-smie.el            |  2 ++
 test/haskell-tng-lexer-test.el |  9 +++------
 test/src/layout.hs.faceup      |  2 +-
 test/src/layout.hs.lexer       |  4 ++--
 test/src/layout.hs.sexps       |  2 +-
 test/src/medley.hs.faceup      |  6 +++---
 test/src/medley.hs.lexer       |  6 +++---
 9 files changed, 54 insertions(+), 34 deletions(-)

diff --git a/haskell-tng-lexer.el b/haskell-tng-lexer.el
index 5d106ea..c0c252c 100644
--- a/haskell-tng-lexer.el
+++ b/haskell-tng-lexer.el
@@ -90,15 +90,16 @@ the lexer."
 
            ((eobp) nil)
 
+           ;; reserved keywords take precedence
+           ((looking-at haskell-tng:regexp:reserved-hack)
+            (haskell-tng-lexer:last-match))
+
            ;; syntax tables (supported by `smie-indent-forward-token')
            ((looking-at haskell-tng-lexer:fast-syntax) nil)
 
-           ;; If this ordering is changed, things will break, since many 
regexps
-           ;; match more than they should.
-
            ;; known identifiers
-           ((looking-at haskell-tng:regexp:reserved)
-            (haskell-tng-lexer:last-match))
+           ;;
+           ;; Ordering is important because regexps are greedy.
            ((looking-at haskell-tng:regexp:qual)
             ;; Matches qualifiers separately from identifiers because the
             ;; backwards lexer is not greedy enough. Qualifiers are not
@@ -157,10 +158,12 @@ the lexer."
             (let ((lbp (min (point) (line-beginning-position))))
              (cond
               ((bobp) nil)
-              ((looking-back haskell-tng-lexer:fast-syntax (- (point) 1)) nil)
-              ;; known identifiers
-              ((looking-back haskell-tng:regexp:reserved (- (point) 8))
+              ((looking-back haskell-tng:regexp:reserved-hack
+                             (max lbp (- (point) 8)) 't)
                (haskell-tng-lexer:last-match 'reverse))
+              ((looking-back haskell-tng-lexer:fast-syntax
+                             (max lbp (- (point) 1)))
+               nil)
               ((looking-back haskell-tng:regexp:qual lbp 't)
                (haskell-tng-lexer:last-match 'reverse "")
                (haskell-tng-lexer:backward-token))
diff --git a/haskell-tng-rx.el b/haskell-tng-rx.el
index a9bac83..ad7fcd0 100644
--- a/haskell-tng-rx.el
+++ b/haskell-tng-rx.el
@@ -12,7 +12,7 @@
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Here are `rx' patterns that are reused as a very simple form of BNF grammar.
-(defconst haskell-tng:rx:consym '(: ":" (* (syntax symbol))))
+(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))))
@@ -20,20 +20,36 @@
 (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
-  '(|
+(defun haskell-tng:rx:reserved (hack)
+  "reservedid / reservedop.
+
+This is a function, not a constant, because the lexer needs a
+hack that would break fontification.
+
+WORKAROUND https://debbugs.gnu.org/cgi/bugreport.cgi?bug=35119
+
+TL;DR: regexps don't see some non-capture boundaries outside the
+limit, so use POINT as a hint during lexing. If used in
+fontification, a carefully positioned point in e.g. <--> would
+give false positives." `(|
     (: word-start
        (| "case" "class" "data" "default" "deriving" "do" "else"
           "foreign" "if" "import" "in" "infix" "infixl"
           "infixr" "instance" "let" "module" "newtype" "of"
           "then" "type" "where" "_")
        word-end)
-    (: symbol-start
-       ;; not including : as it works as a regular consym
-       (| ".." "::" "=" "|" "<-" "->" "@" "~" "=>")
-       symbol-end)
-    (: symbol-start (char ?\\)))
-  "reservedid / reservedop")
+    (: "{..}") ;; RecordWildCards
+    (: word-start "':" symbol-end) ;; DataKinds (consider foo':bar)
+    (: ,(if hack
+            '(| symbol-start word-end point)
+          '(| symbol-start word-end))
+       (| ".." "::" ":" "=" "|" "<-" "->" "@" "~" "=>")
+       ,(if hack
+            '(| symbol-end word-start point)
+          '(| symbol-end word-start))
+    )
+    (| "[]" "()") ;; empty list / void
+    (: symbol-start (char ?\\))))
 
 (defconst haskell-tng:rx:toplevel
   ;; TODO multi-definitions, e.g. Servant's :<|>
@@ -55,7 +71,9 @@
 ;; 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))
+  (rx-to-string (haskell-tng:rx:reserved nil)))
+(defconst haskell-tng:regexp:reserved-hack
+  (rx-to-string (haskell-tng:rx:reserved t)))
 (defconst haskell-tng:regexp:qual
   (rx-to-string `(: symbol-start ,haskell-tng:rx:qual)))
 (defconst haskell-tng:regexp:kindsym
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index ebbef4f..42fb3ad 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -55,6 +55,8 @@
 
       ;; operators all have the same precedence
       (infixexp
+       (id ":" infixexp) ;; keyword infix
+       (id "':" infixexp) ;; DataKinds
        (id "SYMID" infixexp))
 
       ;; WLDOs
diff --git a/test/haskell-tng-lexer-test.el b/test/haskell-tng-lexer-test.el
index 1e8044b..a7724a6 100644
--- a/test/haskell-tng-lexer-test.el
+++ b/test/haskell-tng-lexer-test.el
@@ -54,8 +54,7 @@
     ;; repeating those tests, but for the backward lexer
     (goto-char 317)
     (should (equal (haskell-tng-lexer-test:indent-backward-token) ";"))
-    (should (equal (haskell-tng-lexer-test:indent-backward-token) "»"))
-    (should (equal (haskell-tng-lexer-test:indent-backward-token) "«"))
+    (should (equal (haskell-tng-lexer-test:indent-backward-token) "[]"))
 
     (goto-char 317)
     (should (equal (haskell-tng-lexer-test:indent-backward-token) ";"))
@@ -63,8 +62,7 @@
       (goto-char (point-max))
       (insert " "))
     (should (equal (haskell-tng-lexer-test:indent-backward-token) ";"))
-    (should (equal (haskell-tng-lexer-test:indent-backward-token) "»"))
-    (should (equal (haskell-tng-lexer-test:indent-backward-token) "«"))
+    (should (equal (haskell-tng-lexer-test:indent-backward-token) "[]"))
 
     (goto-char 317)
     (should (equal (haskell-tng-lexer-test:indent-backward-token) ";"))
@@ -72,8 +70,7 @@
     (should (equal (haskell-tng-lexer-test:indent-backward-token) "«"))
     (goto-char 317)
     (should (equal (haskell-tng-lexer-test:indent-backward-token) ";"))
-    (should (equal (haskell-tng-lexer-test:indent-backward-token) "»"))
-    (should (equal (haskell-tng-lexer-test:indent-backward-token) "«"))
+    (should (equal (haskell-tng-lexer-test:indent-backward-token) "[]"))
 
     ;; jumping between forward and backward at point should reset state
     (goto-char 317)
diff --git a/test/src/layout.hs.faceup b/test/src/layout.hs.faceup
index 083a704..1f56b22 100644
--- a/test/src/layout.hs.faceup
+++ b/test/src/layout.hs.faceup
@@ -9,7 +9,7 @@
 «:haskell-tng:toplevel:size» «:haskell-tng:keyword:::»«:haskell-tng:type: 
Stack a »«:haskell-tng:keyword:->»«:haskell-tng:type: Int
 »«:haskell-tng:toplevel:size» s «:haskell-tng:keyword:=» length 
«:haskell-tng:keyword:(»stkToLst s«:haskell-tng:keyword:)»  
«:haskell-tng:keyword:where»
            stkToLst  «:haskell-tng:constructor:Empty»         
«:haskell-tng:keyword:=» «:haskell-tng:keyword:[]»
-           stkToLst «:haskell-tng:keyword:(»«:haskell-tng:constructor:MkStack» 
x s«:haskell-tng:keyword:)»  «:haskell-tng:keyword:=» x:xs 
«:haskell-tng:keyword:where» xs «:haskell-tng:keyword:=» stkToLst s
+           stkToLst «:haskell-tng:keyword:(»«:haskell-tng:constructor:MkStack» 
x s«:haskell-tng:keyword:)»  «:haskell-tng:keyword:=» 
x«:haskell-tng:keyword::»xs «:haskell-tng:keyword:where» xs 
«:haskell-tng:keyword:=» stkToLst s
 
 «:haskell-tng:toplevel:pop» «:haskell-tng:keyword:::»«:haskell-tng:type: Stack 
a »«:haskell-tng:keyword:->»«:haskell-tng:type: 
»«:haskell-tng:keyword:(»«:haskell-tng:type:a»«:haskell-tng:keyword:,»«:haskell-tng:type:
 Stack a»«:haskell-tng:keyword:)»«:haskell-tng:type:
 »«:haskell-tng:toplevel:pop» 
«:haskell-tng:keyword:(»«:haskell-tng:constructor:MkStack» x 
s«:haskell-tng:keyword:)»
diff --git a/test/src/layout.hs.lexer b/test/src/layout.hs.lexer
index ce06291..4128c01 100644
--- a/test/src/layout.hs.lexer
+++ b/test/src/layout.hs.lexer
@@ -8,8 +8,8 @@ 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 CONSYM VARID where { VARID = VARID VARID
+{ VARID CONID = []
+; VARID « CONID VARID VARID » = VARID : 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 2fcfe45..d5a45a1 100644
--- a/test/src/layout.hs.sexps
+++ b/test/src/layout.hs.sexps
@@ -9,7 +9,7 @@
 ((size) (::) (Stack) (a) -> (Int))
 ((size) (s) = (length) ((stkToLst) (s)))  (where)
            (((stkToLst)  (Empty)         = ([])
-           ((stkToLst) ((MkStack) (x) (s))  = (x)(:)(xs)) (where) ((xs) = 
(stkToLst) (s)
+           ((stkToLst) ((MkStack) (x) (s))  = (x):(xs)) (where) ((xs) = 
(stkToLst) (s)
 
 )))(pop) (::) (Stack) (a) -> ((a), (Stack) (a))
 ((pop) ((MkStack) (x) (s))
diff --git a/test/src/medley.hs.faceup b/test/src/medley.hs.faceup
index 26359eb..818934a 100644
--- a/test/src/medley.hs.faceup
+++ b/test/src/medley.hs.faceup
@@ -43,10 +43,10 @@
 «:haskell-tng:keyword:class»«:haskell-tng:type: Get a s 
»«:haskell-tng:keyword:where»
   get «:haskell-tng:keyword:::»«:haskell-tng:type: Set s 
»«:haskell-tng:keyword:->»«:haskell-tng:type: a
 »
-«:haskell-tng:keyword:instance»«:haskell-tng:type: »«x:{-# OVERLAPS 
#-}»«:haskell-tng:type: Get a »«:haskell-tng:keyword:(»«:haskell-tng:type:a ': 
s»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
+«:haskell-tng:keyword:instance»«:haskell-tng:type: »«x:{-# OVERLAPS 
#-}»«:haskell-tng:type: Get a »«:haskell-tng:keyword:(»«:haskell-tng:type:a 
»«:haskell-tng:keyword:':»«:haskell-tng:type: 
s»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
   get «:haskell-tng:keyword:(»«:haskell-tng:constructor:Ext» a 
«:haskell-tng:keyword:_)» «:haskell-tng:keyword:=» a
 
-«:haskell-tng:keyword:instance»«:haskell-tng:type: »«x:{-# OVERLAPPABLE 
#-}»«:haskell-tng:type: Get a s »«:haskell-tng:keyword:=>»«:haskell-tng:type: 
Get a »«:haskell-tng:keyword:(»«:haskell-tng:type:b ': 
s»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
+«:haskell-tng:keyword:instance»«:haskell-tng:type: »«x:{-# OVERLAPPABLE 
#-}»«:haskell-tng:type: Get a s »«:haskell-tng:keyword:=>»«:haskell-tng:type: 
Get a »«:haskell-tng:keyword:(»«:haskell-tng:type:b 
»«:haskell-tng:keyword:':»«:haskell-tng:type: 
s»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
   get «:haskell-tng:keyword:(»«:haskell-tng:constructor:Ext» 
«:haskell-tng:keyword:_» xs«:haskell-tng:keyword:)» «:haskell-tng:keyword:=» 
get xs
 
 «:haskell-tng:keyword:data»«:haskell-tng:type: Options 
»«:haskell-tng:keyword:=» «:haskell-tng:constructor:Options»
@@ -58,7 +58,7 @@
 
 «:haskell-tng:keyword:class»«:haskell-tng:type:  
»«:haskell-tng:keyword:(»«:haskell-tng:type:Eq 
a»«:haskell-tng:keyword:)»«:haskell-tng:type: 
»«:haskell-tng:keyword:=>»«:haskell-tng:type: Ord a  
»«:haskell-tng:keyword:where»
   «:haskell-tng:keyword:(»<«:haskell-tng:keyword:),» 
«:haskell-tng:keyword:(»<=«:haskell-tng:keyword:),» 
«:haskell-tng:keyword:(»>=«:haskell-tng:keyword:),» 
«:haskell-tng:keyword:(»>«:haskell-tng:keyword:)»  
«:haskell-tng:keyword:::»«:haskell-tng:type: a 
»«:haskell-tng:keyword:->»«:haskell-tng:type: a 
»«:haskell-tng:keyword:->»«:haskell-tng:type: Bool
-»  max @Foo«:haskell-tng:keyword:,» min        
«:haskell-tng:keyword:::»«:haskell-tng:type: a 
»«:haskell-tng:keyword:->»«:haskell-tng:type: a 
»«:haskell-tng:keyword:->»«:haskell-tng:type: a
+»  max «:haskell-tng:keyword:@»Foo«:haskell-tng:keyword:,» min        
«:haskell-tng:keyword:::»«:haskell-tng:type: a 
»«:haskell-tng:keyword:->»«:haskell-tng:type: a 
»«:haskell-tng:keyword:->»«:haskell-tng:type: a
 »
 «:haskell-tng:keyword:instance»«:haskell-tng:type: 
»«:haskell-tng:keyword:(»«:haskell-tng:type:Eq 
a»«:haskell-tng:keyword:)»«:haskell-tng:type: 
»«:haskell-tng:keyword:=>»«:haskell-tng:type: Eq 
»«:haskell-tng:keyword:(»«:haskell-tng:type:Tree 
a»«:haskell-tng:keyword:)»«:haskell-tng:type: »«:haskell-tng:keyword:where»
   «:haskell-tng:constructor:Leaf» a         == «:haskell-tng:constructor:Leaf» 
b          «:haskell-tng:keyword:=»  a == b
diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer
index 2ebf636..e13d30d 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 KINDSYM VARID » where
+} ; instance CONID VARID « VARID ': VARID » where
 { VARID « CONID VARID _ » = VARID
 
-} ; instance CONID VARID VARID => CONID VARID « VARID KINDSYM VARID » where
+} ; instance CONID VARID VARID => CONID VARID « VARID ': VARID » where
 { VARID « CONID _ VARID » = VARID VARID
 
 } ; data CONID = CONID
@@ -58,7 +58,7 @@ VARID , VARID , VARID »
 
 ; class « CONID VARID » => CONID VARID where
 { « SYMID » , « SYMID » , « SYMID » , « SYMID » :: VARID -> VARID -> CONID
-; VARID SYMID CONID , VARID :: VARID -> VARID -> VARID
+; VARID @ CONID , VARID :: VARID -> VARID -> VARID
 
 } ; instance « CONID VARID » => CONID « CONID VARID » where
 { CONID VARID SYMID CONID VARID = VARID SYMID VARID