branch: elpa/haskell-tng-mode
commit 9e19b2b1e62b3348325d661a1e0e3717da9722df
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
double down on simpler grammar
---
haskell-tng-smie.el | 96 +++++++++++++++----------------------------
test/haskell-tng-sexp-test.el | 15 +++++--
test/haskell-tng-testutils.el | 8 ++++
test/src/grammar.hs | 7 ++++
test/src/grammar.hs.sexps | 8 ++++
test/src/layout.hs.sexps | 20 ++++-----
6 files changed, 77 insertions(+), 77 deletions(-)
diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index a584b2c..55832f6 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -25,92 +25,62 @@
;; https://www.gnu.org/software/emacs/manual/html_mono/elisp.html#SMIE-Grammar
;; https://www.haskell.org/onlinereport/haskell2010/haskellch3.html
;;
-;; Transcribed here. Many of these grammar rules cannot be expressed in SMIE
-;; because Haskell uses whitespace separators a lot, whereas the BNF must use
-;; non-terminals.
+;; Many of these grammar rules cannot be expressed in SMIE because Haskell uses
+;; whitespace separators a lot, whereas the BNF must use non-terminals.
;;
-;; exp infixexp :: [context =>] type (expression type signature)
-;; | infixexp
+;; Rules that are unbounded on the right tend to misbehave quite badly, since
+;; there is no way to know how to end the s-expression. For example, the BNF
+;; definition of a TYPE will typically extend to an arbitrary point later in
the
+;; file. We cannot use `;' to end the TYPE definition, because symbols cannot
be
+;; closers and "neither" (i.e. infix) at the same time. An option is always to
+;; push contextual functionality into the lexer, but one must draw a line
+;; somewhere.
;;
-;; infixexp lexp qop infixexp (infix operator application)
-;; | - infixexp (prefix negation)
-;; | lexp
-;;
-;; lexp \ apat1 … apatn -> exp (lambda abstraction, n ≥ 1)
-;; | let decls in exp (let expression)
-;; | if exp [;] then exp [;] else exp (conditional)
-;; | case exp of { alts } (case expression)
-;; | do { stmts } (do expression)
-;; | fexp
-;;
-;; fexp [fexp] aexp (function application)
-;;
-;; aexp qvar (variable)
-;; | gcon (general constructor)
-;; | literal
-;; | ( exp ) (parenthesized expression)
-;; | ( exp1 , … , expk ) (tuple, k ≥ 2)
-;; | [ exp1 , … , expk ] (list, k ≥ 1)
-;; | [ exp1 [, exp2] .. [exp3] ] (arithmetic sequence)
-;; | [ exp | qual1 , … , qualn ] (list comprehension, n ≥ 1)
-;; | ( infixexp qop ) (left section)
-;; | ( qop⟨-⟩ infixexp ) (right section)
-;; | qcon { fbind1 , … , fbindn } (labeled construction, n ≥
0)
-;; | aexp⟨qcon⟩ { fbind1 , … , fbindn } (labeled update, n ≥ 1)
+;; We do not include rules unless they have an impact on indentation.
Navigation
+;; with a more complete grammar has been shown to be less than satisfactory,
+;; therefore there is no reason to do more than is needed.
(defvar haskell-tng-smie:grammar
(smie-prec2->grammar
(smie-bnf->prec2
'((id)
- ;; We do not include rules that do not have an impact on indentation.
- ;; Navigation with the more complete grammar is less than satisfactory,
- ;; therefore there is no reason to maintain it.
- ;; (exp
- ;; (infixexp "::" context "=>" type)
- ;; (infixexp "::" type)
- ;; (infixexp))
- (exp (id))
-
- ;; TODO => and -> may require custom indentation rules
-
- ;; FIXME don't give up hope yet, first see if exp is useful when type is
- ;; defined properly.
+ ;; commas only allowed in brackets
(context
("(" context ")")
(context "," context))
- ;; ;; TODO the lexer should provide virtual infix operators
- ;; (infixexp
- ;; (lexp "$" infixexp)
- ;; (lexp))
+ ;; operators
+ ;; TODO lexer should identify / normalise operators.
+ (infixexp
+ (id "$" infixexp)
+ (id "*" infixexp)
+ (id "+" infixexp)
+ (id))
- (lexp
- ("if" exp "then" exp "else" exp)
+ ;; WLDOs
+ (wldo
("where" decls)
- ("let" decls "in" exp)
+ ("let" decls)
("do" stmts)
- ("case" exp "of" alts))
-
+ ("of" alts))
(decls
("{" decls "}")
(decls ";" decls)
- (id "=" exp))
- (alts
- ("{" alts "}")
- (alts ";" alts)
- (id "->" exp))
+ (id "=" id))
(stmts
("{" stmts "}")
(stmts ";" stmts)
- (id "<-" exp))
+ (id "<-" id))
+ (alts
+ ("{" alts "}")
+ (alts ";" alts)
+ (id "->" id))
+
)
;; operator precedences
- '(;;(left ";" "," "::" "else" "in" "of" "->" "do" "<-" "where" "=")
- ;;(left ";" ",")
- (assoc ",") ;; TODO , and ; conflict but what's the correct ordering?
- (assoc ";")
-;; (left "$")
+ '((assoc ";")
+ (assoc ",")
)
)))
diff --git a/test/haskell-tng-sexp-test.el b/test/haskell-tng-sexp-test.el
index d0abd96..e263d77 100644
--- a/test/haskell-tng-sexp-test.el
+++ b/test/haskell-tng-sexp-test.el
@@ -21,9 +21,12 @@
;; tokens.
(ert-deftest haskell-tng-sexp-file-tests ()
- ;; the baselines have some pretty funky stuff in them...
+ ;; some bizarre output here:
+ ;; 1. `size' definition has an s-exp that extends to the end of `top'
(should (have-expected-sexps (testdata "src/layout.hs")))
+ (should (have-expected-sexps (testdata "src/grammar.hs")))
+
;; to the extent that they aren't even useful
;;(should (have-expected-sexps (testdata "src/medley.hs")))
)
@@ -70,8 +73,9 @@
(goto-char (point-min))
(let (sexps)
(while (not (eobp))
- (let ((here (haskell-tng-sexp-test:sexps-at-point (point))))
- (setq sexps (append here sexps)))
+ (unless (is-comment-at-point)
+ (let ((here (haskell-tng-sexp-test:sexps-at-point (point))))
+ (setq sexps (append here sexps))))
(forward-char))
(delete-dups sexps)))
@@ -88,7 +92,10 @@
(t nil)))
(if (eobp)
(setq exit 't)
- (push (string (char-after)) chars)
+ (let ((c (string (char-after))))
+ ;; output is cleaner if we don't double print parens
+ (unless (member c '("(" ")"))
+ (push c chars)))
(forward-char)))
(s-join "" (reverse chars))))
diff --git a/test/haskell-tng-testutils.el b/test/haskell-tng-testutils.el
index 32713f1..e2546b5 100644
--- a/test/haskell-tng-testutils.el
+++ b/test/haskell-tng-testutils.el
@@ -40,5 +40,13 @@ Will fail and write out the expected version to FILE.SUFFIX."
file
(haskell-tng-testutils:this-lisp-directory)))
+(defun is-comment-at-point ()
+ ;; this could be sped up by storing all comment regions in an alist
+ (or (nth 8 (syntax-ppss))
+ (looking-at "--")
+ (and (looking-at "-")
+ (looking-back "-" 1)))
+ )
+
(provide 'haskell-tng-testutils)
;;; haskell-tng-testutils.el ends here
diff --git a/test/src/grammar.hs b/test/src/grammar.hs
new file mode 100644
index 0000000..4631ea2
--- /dev/null
+++ b/test/src/grammar.hs
@@ -0,0 +1,7 @@
+-- | Tests for grammar rules (i.e. sexps, not indentation)
+module Foo.Bar where
+
+calc :: Int -> Int
+calc a = if a < 10
+ then a + a * a + a
+ else (a + a) * (a + a)
diff --git a/test/src/grammar.hs.sexps b/test/src/grammar.hs.sexps
new file mode 100644
index 0000000..2e8f24b
--- /dev/null
+++ b/test/src/grammar.hs.sexps
@@ -0,0 +1,8 @@
+-- | Tests for grammar rules i.e. sexps, not indentation
+(module) (Foo.Bar) (where
+
+(((calc) (::) (Int) (->) (Int))
+((calc) (a) = (if) (a) (<) (10)
+ (then) (a) + (a) * (a) + (a)
+ (else) ((a) + (a)) * ((a) + (a)))
+))
\ No newline at end of file
diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps
index 4106a8f..4519f81 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
+-- Figure 2.1 from the Haskell2010 report
+(module) (AStack)( (Stack), (push), (pop), (top), (size) ) (where
((data) (Stack) (a) = (Empty)
- (|) (MkStack) (a) (((Stack) (a)))
+ (|) (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
+((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)))
- = (((x), ((case (s) (of) ((r (->) (i) (r) (where (i (x) = x))))))))) ((--)
(((pop) (Empty))) (is) (an) (error)
+))))((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
-(((top) (::) (Stack) (a) (->) (a))))
-((top) (((MkStack) (x) (s))) = (x)))) (--) (((top)
(Empty))) (is) (an) (error)
+(((top) (::) (Stack) (a) (->) (a)))
+((top) ((MkStack) (x) (s)) = (x)))) -- top Empty is an
error
))
\ No newline at end of file
