branch: elpa/haskell-tng-mode
commit 3ddafcee1552af5de7d64101a16ba672b4cd79ea
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@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
