[nongnu] elpa/haskell-tng-mode 79aeb82 076/385: most of the grammar

[ELPA Syncer]

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

    most of the grammar
---
 haskell-tng-smie.el           | 97 ++++++++++++++-----------------------------
 test/haskell-tng-sexp-test.el | 49 +++++++++++-----------
 test/src/layout.hs.sexps      | 30 ++++++-------
 3 files changed, 71 insertions(+), 105 deletions(-)

diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el
index 56c329a..bc729ac 100644
--- a/haskell-tng-smie.el
+++ b/haskell-tng-smie.el
@@ -22,11 +22,13 @@
 (require 'haskell-tng-font-lock)
 (require 'haskell-tng-lexer)
 
-;; FIXME a haskell grammar that doesn't have warnings during the tests
-
 ;; 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.
+;;
 ;; exp       infixexp :: [context =>] type         (expression type signature)
 ;;     |     infixexp
 ;;
@@ -60,80 +62,43 @@
    (smie-bnf->prec2
     '((id)
       (exp
-       ;; TODO context
-       ;;(infixexp "::" context "=>" type)
+       (infixexp "::" context "=>" type)
        (infixexp "::" type)
-       (infixexp)
-       )
+       (infixexp))
 
-      ;; TODO update the lexer to provide a virtual token for infix but keep
-      ;; popular operators with important fixity.
+      (context
+       ("(" context ")")
+       (context "," context))
+
+      ;; TODO the lexer should provide virtual infix operators
       (infixexp
        (lexp "$" infixexp)
-       (lexp "+" infixexp)
-       (lexp "-" infixexp)
-       ;; (lexp "*" infixexp)
-       ;; (lexp "/" infixexp)
-       ;; (lexp "<$>" infixexp)
-       ;; (lexp "<*>" infixexp)
-       ;; (lexp ">>=" infixexp)
-       ;; (lexp "`should`" infixexp)
-       ;; (lexp "&" infixexp)
-
-       ;;("-" infixexp) ;; can't be opener and neither
-       (lexp)
-       )
-
-      ;; TODO should we support terminators as separators?
-      ;;(insts (insts ";" insts) (inst))
+       (lexp))
 
       (lexp
        ("if" exp "then" exp "else" exp)
-       ;; TODO apats
-       ;;("let" decls "in" exp)
-       ;;("case" exp "of" alts)
-       ;;("do" stmts)
-       ;; TODO where?
-       ;; TODO fexp
-       )
-
-      ;; (decls
-      ;;  ;;("{" decls "}")
-      ;;  (decls ";" decls)
-      ;;  (decl))
-      ;; (decl
-      ;;  (id "=" exp))
-      ;; (alts
-      ;;  ;;("{" alts "}")
-      ;;  (alts ";" alts)
-      ;;  (alt))
-      ;; (alt
-      ;;  (id "->" exp))
-      ;; (stmts
-      ;;  ;;("{" stmts "}")
-      ;;  (stmts ";" stmts)
-      ;;  (stmt))
-      ;; (stmt
-      ;;  (id "<-" exp))
-
+       ("where" decls)
+       ("let" decls "in" exp)
+       ("do" stmts)
+       ("case" exp "of" alts))
+
+      (decls
+       ("{" decls "}")
+       (decls ";" decls)
+       (id "=" exp))
+      (alts
+       ("{" alts "}")
+       (alts ";" alts)
+       (id "->" exp))
+      (stmts
+       ("{" stmts "}")
+       (stmts ";" stmts)
+       (id "<-" exp))
       )
 
     ;; operator precedences
-    ;;'((assoc ";"))
-    ;;'((assoc ","))
-    '((assoc "else" "::") ;; TODO keywords here
-      (assoc "$")
-      ;; TODO arrange by fixity
-      (assoc "+" "-"))
-    ;; '((assoc "*"))
-    ;; '((assoc "/"))
-    ;; '((assoc "<$>"))
-    ;; '((assoc "<*>"))
-    ;; '((assoc ">>="))
-    ;; '((assoc "&"))
-
-;; Read the "<" and ">" as parentheses: when confronted with "... else E $ ..."
-;;SMIE is not sure if you meant "... else E) $ ..." or "... else (E $ ...".
+    '((left ";" "," "::" "else" "in" "of" "->" "do" "<-" "where" "=")
+      (left "$"))
 
     )))
 
diff --git a/test/haskell-tng-sexp-test.el b/test/haskell-tng-sexp-test.el
index dc3a15f..7332243 100644
--- a/test/haskell-tng-sexp-test.el
+++ b/test/haskell-tng-sexp-test.el
@@ -21,9 +21,10 @@
 ;; tokens.
 
 (ert-deftest haskell-tng-sexp-file-tests ()
+  ;; the baselines have some pretty funky stuff in them...
   (should (have-expected-sexps (testdata "src/layout.hs")))
 
-  ;; TODO enable when layout.hs gives better results...
+  ;; to the extent that they aren't even useful
   ;;(should (have-expected-sexps (testdata "src/medley.hs")))
   )
 
@@ -37,24 +38,24 @@
 ;; and `backward-sexp', provided by SMIE.
 (defun haskell-tng-sexp-test:sexps-at-point (p)
   "Return a list of cons cells (start . end)"
-  (let* (sexps
-         (forward-backward
-          (ignore-errors
-            (save-excursion
-              (goto-char p)
-              (forward-sexp)
-              (let ((forward (point)))
-                (backward-sexp)
-                (unless (= (point) forward)
-                  (cons (point) forward))))))
-         (backward-forward
-          (ignore-errors
-            (save-excursion
-              (goto-char p)
-              (backward-sexp)
-              (let ((backward (point)))
-                (forward-sexp)
-                (unless (= backward (point))
+  (let (sexps
+        (forward-backward
+         (ignore-errors
+           (save-excursion
+             (goto-char p)
+             (forward-sexp)
+             (let ((forward (point)))
+               (backward-sexp)
+               (unless (= (point) forward)
+                 (cons (point) forward))))))
+        (backward-forward
+         (ignore-errors
+           (save-excursion
+             (goto-char p)
+             (backward-sexp)
+             (let ((backward (point)))
+               (forward-sexp)
+               (unless (= backward (point))
                  (cons backward (point))))))))
     (when forward-backward
       (push forward-backward sexps))
@@ -67,9 +68,8 @@
   (goto-char (point-min))
   (let (sexps)
     (while (not (eobp))
-      (unless (nth 8 (syntax-ppss)) ;; don't query in comments/strings
-        (let ((here (haskell-tng-sexp-test:sexps-at-point (point))))
-          (setq sexps (append here sexps))))
+      (let ((here (haskell-tng-sexp-test:sexps-at-point (point))))
+        (setq sexps (append here sexps)))
       (forward-char))
     (delete-dups sexps)))
 
@@ -78,10 +78,11 @@
   (let (chars exit)
     (goto-char (point-min))
     (while (not exit)
-      (--each sexps
+      ;; there is ambiguity around multiple parens at the same point
+      (--each (reverse sexps)
         (cond
-         ((= (point) (car it)) (push "(" chars))
          ((= (point) (cdr it)) (push ")" chars))
+         ((= (point) (car it)) (push "(" chars))
          (t nil)))
       (if (eobp)
           (setq exit 't)
diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps
index a412dc4..b260243 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)
-(data) (Stack) (a) (=) (Empty)
+((--) (Figure) (2.1) (from) (the) (Haskell2010) (report)
+(module)) (AStack)(( (Stack), (push), (pop), (top), (size) )) (where
+(((data) (Stack) (a) = (Empty)
              (|) (MkStack) (a) (((Stack) (a)))
 
-(push) (::) (a) (->) (Stack) (a) (->) (Stack) (a)
-(push) (x) (s) (=) (MkStack) (x) (s)
+(push) (::) (((a) (->) ((Stack) (a) (->) (Stack) (a)))
+((push) (x) (s) = (MkStack) (x) (s))
 
-(size)) (::) (Stack) (a) (->) (Int)
-(size) (s) (=) (length) (((stkToLst) (s)))  (where)
-           (stkToLst)  (Empty)         (=) ([])
-           (stkToLst) (((MkStack) (x) (s)))  (=) (x:xs) (where) (xs) (=) 
(stkToLst) (s)
+(size) (::) ((((Stack) (a) (->) (Int))
+((size) (s) = (length) (((stkToLst) (s)))  (where
+           ((stkToLst)  (Empty)         = ([])
+           ((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
-)
\ No newline at end of file
+(top)) (::) ((Stack) (a) (->) (a))
+((top) (((MkStack) (x) (s))) = (x))))))                     (--) (((top) 
(Empty))) (is) (an) (error)
+))
\ No newline at end of file