[nongnu] elpa/haskell-tng-mode 9e19b2b 080/385: double down on simpler grammar

[ELPA Syncer]

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