[nongnu] elpa/haskell-tng-mode 3ddafce 181/385: disambiguate -> during lexing

[ELPA Syncer]

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

    disambiguate -> during lexing
---
 haskell-tng-lexer.el                          | 19 ++++++++++++++++
 haskell-tng-smie.el                           | 19 ++++++++--------
 test/src/indentation-options.hs.append.indent | 32 +++++++++++++--------------
 test/src/indentation-options.hs.insert.indent | 18 +++++++--------
 test/src/indentation.hs.append.indent         | 32 +++++++++++++--------------
 test/src/indentation.hs.insert.indent         | 18 +++++++--------
 test/src/indentation.hs.lexer                 | 20 ++++++++---------
 test/src/layout.hs.lexer                      |  8 +++----
 test/src/medley.hs.lexer                      | 16 +++++++-------
 9 files changed, 100 insertions(+), 82 deletions(-)

diff --git a/haskell-tng-lexer.el b/haskell-tng-lexer.el
index b7da5f7..afb6912 100644
--- a/haskell-tng-lexer.el
+++ b/haskell-tng-lexer.el
@@ -6,6 +6,10 @@
 ;;; Commentary:
 ;;
 ;;  SMIE compatible lexer, (sadly) stateful in order to support virtual tokens.
+;;
+;;  Outputs `=>' instead of `->' when in type position and attempts to classify
+;;  most symbols into CONID / SYMID / VARID / etc classes.
+;;
 ;;  See `haskell-tng-layout.el' for more details.
 ;;
 ;;; Code:
@@ -99,6 +103,7 @@ the lexer."
             (pcase (haskell-tng-lexer:last-match)
               (":" "CONSYM")
               ("':" "KINDSYM") ;; DataKinds
+              ((and "->" (guard (haskell-tng-lexer:arrow-is-type))) "=>")
               (other other)))
 
            ;; syntax tables (supported by `smie-indent-forward-token')
@@ -170,6 +175,7 @@ the lexer."
                (pcase (haskell-tng-lexer:last-match 'reverse)
                  (":" "CONSYM")
                  ("':" "KINDSYM") ;; DataKinds
+                 ((and "->" (guard (haskell-tng-lexer:arrow-is-type))) "=>")
                  (other other)))
               ((looking-back haskell-tng-lexer:fast-syntax
                              (max lbp (- (point) 1)))
@@ -226,5 +232,18 @@ the lexer."
   (goto-char (if reverse (match-beginning 0) (match-end 0)))
   (or alt (match-string-no-properties 0)))
 
+(defun haskell-tng-lexer:arrow-is-type ()
+  "Assuming that we just parsed a `->' arrow, search backwards to
+find reserved tokens that can disambiguate the usecase as a type,
+returning non-nil for types."
+  (save-excursion
+    (when (re-search-backward
+           ;; TODO this list can probably be expanded to most (if not all) of
+           ;; the keywords. This is very conservative.
+           (rx (| (: symbol-start (char ?\\))
+                  (: symbol-start (| "::" "of" "=>") symbol-end)))
+           nil t)
+      (member (match-string 0) '("::" "=>")))))
+
 (provide 'haskell-tng-lexer)
 ;;; haskell-tng-lexer.el ends here
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index a340f72..bdc4885 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -89,10 +89,14 @@ foobar1 ::
       ;; commas only allowed in brackets
       (list
        ("(" list ")")
-       ("{" list "}")
        ("[" list "]") ;; includes DataKinds
        (list "," list))
 
+      (record
+       (id "::" type)
+       ("{" record "}")
+       (record "," record))
+
       ;; operators all have the same precedence
       (infixexp
        (id "KINDSYM" infixexp)
@@ -121,12 +125,12 @@ foobar1 ::
        (blk ";" blk)
        (id "=" id)
        (id "<-" id)
-       (id "->" id) ;; TODO lexer could disambiguate cases
+       (id "->" id)
        )
 
       (type
-       (type "=>" type)
-       (type "->" type))
+       ;; the lexer disambiguates -> in types as =>
+       (type "=>" type))
 
       (lambdas
        ("\\" id))
@@ -139,7 +143,6 @@ foobar1 ::
     '((assoc ";" ",")
       (assoc "|")
       (assoc "=>")
-      (assoc "->")
       )
 
     )))
@@ -298,11 +301,7 @@ information, to aid in the creation of new rules."
        ((and (or "[" "(" "{") (guard (smie-rule-hanging-p)))
         (smie-rule-parent))
        ((and "=>" (guard (not (smie-rule-sibling-p)))) 2)
-       ("," (if (smie-rule-parent-p "::")
-                ;; types plus record syntax confuse smie-rule-separator. This
-                ;; heuristic works in most cases, but is not robust.
-                (smie-rule-parent -2)
-              (smie-rule-separator method)))
+       ("," (smie-rule-separator method))
        ((guard (smie-rule-parent-p "SYMID" "CONSYM" "KINDSYM"))
         (smie-rule-parent))
        ))
diff --git a/test/src/indentation-options.hs.append.indent 
b/test/src/indentation-options.hs.append.indent
index 6a69025..552f7ad 100644
--- a/test/src/indentation-options.hs.append.indent
+++ b/test/src/indentation-options.hs.append.indent
@@ -5,9 +5,9 @@ v
 
 v
 typesig :: a -> b -> c
-v
+1         v
 
-v
+1         v
 types1 ::
 1    v
      Monad m
@@ -15,11 +15,11 @@ types1 ::
   => a
 1 v  2
   -> b
-v 1  2
+1 v  2
   -> c
-v 1  2
+1 v  2
 
-v 1  2
+1 v  2
 types2 ::
 1    v
    ( Monad m )
@@ -27,21 +27,21 @@ types2 ::
   => a
 1 v2
   -> b
-v 12
+1 v2
   -> c
-v 12
+1 v2
 
-v 12
+1 v2
 types3 :: (Monad m, MemberLogger m)
 1        v
   => a
 1 v
   -> b
-v 1
+1 v
   -> c
-v 1
+1 v
 
-v 1
+1 v
 types4 :: Monad m
 1        v
        => (?log :: HasLogger m)
@@ -49,16 +49,16 @@ types4 :: Monad m
        => a
 1      v
        -> b
-v      1
+1      v
        -> c
-v      1
+1      v
 
-v      1
+1      v
 types5 :: (Monad m, MonadReader Foo m) =>
 1        v
           (?log :: HasLogger m) =>
 1         v
           a -> b -> c
-v         1
+1         v
 
-v         1
\ No newline at end of file
+1         v
\ No newline at end of file
diff --git a/test/src/indentation-options.hs.insert.indent 
b/test/src/indentation-options.hs.insert.indent
index 5395984..e81ccd9 100644
--- a/test/src/indentation-options.hs.insert.indent
+++ b/test/src/indentation-options.hs.insert.indent
@@ -5,7 +5,7 @@ v
 
 v
 typesig :: a -> b -> c
-v
+1         v
 
 v
 types1 ::
@@ -15,9 +15,9 @@ types1 ::
   => a
 1 v  2
   -> b
-2 1  v
+1 v  2
   -> c
-v 1  2
+1 v  2
 
 v 1  2
 types2 ::
@@ -27,9 +27,9 @@ types2 ::
   => a
 1 v2
   -> b
-2 13 v
+1 v2
   -> c
-v 12
+1 v2
 
 v 12
 types3 :: (Monad m, MemberLogger m)
@@ -37,9 +37,9 @@ types3 :: (Monad m, MemberLogger m)
   => a
 1 v
   -> b
-2 1  v
+1 v
   -> c
-v 1
+1 v
 
 v 1
 types4 :: Monad m
@@ -49,9 +49,9 @@ types4 :: Monad m
        => a
 1      v
        -> b
-2      1  v
+1      v
        -> c
-v      1
+1      v
 
 v      1
 types5 :: (Monad m, MonadReader Foo m) =>
diff --git a/test/src/indentation.hs.append.indent 
b/test/src/indentation.hs.append.indent
index 777e1ee..48bdce9 100644
--- a/test/src/indentation.hs.append.indent
+++ b/test/src/indentation.hs.append.indent
@@ -247,9 +247,9 @@ v           1
 
 v           1
 typesig :: a -> b -> c
-v
+1         v
 
-v
+1         v
 types1 ::
 1    v
      Monad m
@@ -257,11 +257,11 @@ types1 ::
   => a
 1 v  2
   -> b
-v 1  2
+1 v  2
   -> c
-v 1  2
+1 v  2
 
-v 1  2
+1 v  2
 types2 ::
 1    v
    ( Monad m )
@@ -269,21 +269,21 @@ types2 ::
   => a
 1 v2
   -> b
-v 12
+1 v2
   -> c
-v 12
+1 v2
 
-v 12
+1 v2
 types3 :: (Monad m, MemberLogger m)
 1        v
   => a
 1 v
   -> b
-v 1
+1 v
   -> c
-v 1
+1 v
 
-v 1
+1 v
 types4 :: Monad m
 1        v
        => (?log :: HasLogger m)
@@ -291,16 +291,16 @@ types4 :: Monad m
        => a
 1      v
        -> b
-v      1
+1      v
        -> c
-v      1
+1      v
 
-v      1
+1      v
 types5 :: (Monad m, MonadReader Foo m) =>
 1        v
           (?log :: HasLogger m) =>
 1         v
           a -> b -> c
-v         1
+1         v
 
-v         1
\ No newline at end of file
+1         v
\ No newline at end of file
diff --git a/test/src/indentation.hs.insert.indent 
b/test/src/indentation.hs.insert.indent
index cc61e7d..2fee7d3 100644
--- a/test/src/indentation.hs.insert.indent
+++ b/test/src/indentation.hs.insert.indent
@@ -247,7 +247,7 @@ v           1
 
 v           1
 typesig :: a -> b -> c
-v
+1         v
 
 v
 types1 ::
@@ -257,9 +257,9 @@ types1 ::
   => a
 1 v  2
   -> b
-2 1  v
+1 v  2
   -> c
-v 1  2
+1 v  2
 
 v 1  2
 types2 ::
@@ -269,9 +269,9 @@ types2 ::
   => a
 1 v2
   -> b
-2 13 v
+1 v2
   -> c
-v 12
+1 v2
 
 v 12
 types3 :: (Monad m, MemberLogger m)
@@ -279,9 +279,9 @@ types3 :: (Monad m, MemberLogger m)
   => a
 1 v
   -> b
-2 1  v
+1 v
   -> c
-v 1
+1 v
 
 v 1
 types4 :: Monad m
@@ -291,9 +291,9 @@ types4 :: Monad m
        => a
 1      v
        -> b
-2      1  v
+1      v
        -> c
-v      1
+1      v
 
 v      1
 types5 :: (Monad m, MonadReader Foo m) =>
diff --git a/test/src/indentation.hs.lexer b/test/src/indentation.hs.lexer
index 85047a2..a584362 100644
--- a/test/src/indentation.hs.lexer
+++ b/test/src/indentation.hs.lexer
@@ -122,32 +122,32 @@ VARID
 ; VARID = « VARID ,
 VARID »
 
-; VARID :: VARID -> VARID -> VARID
+; VARID :: VARID => VARID => VARID
 
 ; VARID ::
 CONID VARID
 => VARID
--> VARID
--> VARID
+=> VARID
+=> VARID
 
 ; VARID ::
 « CONID VARID »
 => VARID
--> VARID
--> VARID
+=> VARID
+=> VARID
 
 ; VARID :: « CONID VARID , CONID VARID »
 => VARID
--> VARID
--> VARID
+=> VARID
+=> VARID
 
 ; VARID :: CONID VARID
 => « VARID :: CONID VARID »
 => VARID
--> VARID
--> VARID
+=> VARID
+=> VARID
 
 ; VARID :: « CONID VARID , CONID CONID VARID » =>
 « VARID :: CONID VARID » =>
-VARID -> VARID -> VARID
+VARID => VARID => VARID
 }
diff --git a/test/src/layout.hs.lexer b/test/src/layout.hs.lexer
index e523ca9..241136b 100644
--- a/test/src/layout.hs.lexer
+++ b/test/src/layout.hs.lexer
@@ -3,18 +3,18 @@ module CONID « CONID , VARID , VARID , VARID , VARID » where
 { data CONID VARID = CONID
 | CONID VARID « CONID VARID »
 
-; VARID :: VARID -> CONID VARID -> CONID VARID
+; VARID :: VARID => CONID VARID => CONID VARID
 ; VARID VARID VARID = CONID VARID VARID
 
-; VARID :: CONID VARID -> CONID
+; 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 -> « VARID , CONID VARID »
+} } ; VARID :: CONID VARID => « VARID , CONID VARID »
 ; VARID « CONID VARID VARID »
 = « VARID , case VARID of { VARID -> VARID VARID where { VARID VARID = VARID } 
} »
 
-; VARID :: CONID VARID -> VARID
+; VARID :: CONID VARID => VARID
 ; VARID « CONID VARID VARID » = VARID
 }
diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer
index b391454..b676f68 100644
--- a/test/src/medley.hs.lexer
+++ b/test/src/medley.hs.lexer
@@ -49,7 +49,7 @@ VARID , VARID , VARID »
 ; VARID = §
 
 ; class CONID VARID VARID where
-{ VARID :: CONID VARID -> VARID
+{ VARID :: CONID VARID => VARID
 
 } ; instance CONID VARID « VARID KINDSYM VARID » where
 { VARID « CONID VARID _ » = VARID
@@ -65,8 +65,8 @@ VARID , VARID , VARID »
 » deriving « CONID , CONID »
 
 ; class « CONID VARID » => CONID VARID where
-{ « SYMID » , « SYMID » , « SYMID » , « SYMID » :: VARID -> VARID -> CONID
-; VARID @ CONID , VARID :: VARID -> VARID -> VARID
+{ « SYMID » , « SYMID » , « SYMID » , « SYMID » :: VARID => VARID => CONID
+; VARID @ CONID , VARID :: VARID => VARID => VARID
 
 } ; instance « CONID VARID » => CONID « CONID VARID » where
 { CONID VARID SYMID CONID VARID = VARID SYMID VARID
@@ -93,11 +93,11 @@ deriving VARID « CONID , CONID »
 
 ; VARID ::
 CONID
--> CONID
--> CONID
--> CONID
--> « VARID :: CONID »
--> « CONID
+=> CONID
+=> CONID
+=> CONID
+=> « VARID :: CONID »
+=> « CONID
 VARID VARID VARID »
 
 ; « VARID :: « CONID CONID » » VARID