branch: elpa/haskell-tng-mode commit 6e70344fec4aa36f6d4870c7498b2dd7f8eb27a4 Author: Tseen She <ts33n....@gmail.com> Commit: Tseen She <ts33n....@gmail.com>
duplicate ; tokens to be used as terminators --- haskell-tng-lexer.el | 26 +++++++-- haskell-tng-smie.el | 29 +++++----- test/haskell-tng-indent-test.el | 4 ++ test/haskell-tng-lexer-test.el | 14 ++++- test/src/grammar.hs.sexps | 6 +- test/src/indentation.hs.insert.indent | 2 +- test/src/indentation.hs.lexer | 90 ++++++++++++++--------------- test/src/indentation.hs.reindent | 82 +++++++++++++------------- test/src/indentation.hs.sexps | 102 ++++++++++++++++---------------- test/src/layout.hs.lexer | 22 +++---- test/src/layout.hs.sexps | 22 +++---- test/src/medley.hs.lexer | 106 +++++++++++++++++----------------- 12 files changed, 269 insertions(+), 236 deletions(-) diff --git a/haskell-tng-lexer.el b/haskell-tng-lexer.el index 8ea1a68..124198b 100644 --- a/haskell-tng-lexer.el +++ b/haskell-tng-lexer.el @@ -26,6 +26,7 @@ ;; backwards parsing, and we'd need to write an FFI interface that may introduce ;; performance problems (converting Emacs buffers into the Flex input format). +(require 'dash) (require 'smie) (require 'haskell-tng-rx) @@ -85,7 +86,8 @@ the lexer." ;; lookback is fast). (setq haskell-tng-lexer:state (unless haskell-tng-lexer:state - (haskell-tng-layout:virtuals-at-point))) + (haskell-tng-lexer:expand-virtuals + (haskell-tng-layout:virtuals-at-point)))) (cond ;; new virtual tokens @@ -151,9 +153,8 @@ the lexer." (setq haskell-tng-lexer:state (unless haskell-tng-lexer:state - ;; TODO semicolon cannot be used as a separator and a line end - ;; in the grammar rules, so should we emit multiple tokens? - (haskell-tng-layout:virtuals-at-point))) + (haskell-tng-lexer:expand-virtuals + (haskell-tng-layout:virtuals-at-point)))) (if haskell-tng-lexer:state (haskell-tng-lexer:replay-virtual 'reverse) @@ -220,5 +221,22 @@ the lexer." (goto-char (if reverse (match-beginning 0) (match-end 0))) (or alt (match-string-no-properties 0))) +(defun haskell-tng-lexer:expand-virtuals (virtuals) + "We add an additional `;;' token before every `;' and `}' to +workaround a limitation of SMIE whereby tokens can only be used +as openers/closers or separators, but not both. + +In particular we would like to use `;' and `}' as terminators, +and this allows us to do so. + +These are not useful in all locations, but it is much simpler to +add them everywhere than to try and be contextual." + (--mapcat + (pcase it + (";" (list ";;" ";")) + ("}" (list ";;" "}")) + (other (list other))) + virtuals)) + (provide 'haskell-tng-lexer) ;;; haskell-tng-lexer.el ends here diff --git a/haskell-tng-smie.el b/haskell-tng-smie.el index 6f2cc0a..07126ef 100644 --- a/haskell-tng-smie.el +++ b/haskell-tng-smie.el @@ -70,7 +70,7 @@ (id "SYMID" infixexp)) (adt - ("data" id "=" cop)) + ("data" id "=" cop ";;")) (cop (cop "|" cop)) @@ -191,14 +191,14 @@ information, to aid in the creation of new rules." (insert " NEWLINE IS |\n"))) "|") - ((smie-rule-next-p ";" "}") + ((smie-rule-next-p ";;" ";" "}") ;; TODO semantic indentation ;; ;; Consult a local table, populated by an external tool, containing ;; the parameter requirements for function calls. For simple cases, ;; we should be able to infer if the user wants to terminate ; or ;; continue "" the current line. - ";") + ";;") ((save-excursion (forward-comment (point-max)) @@ -217,14 +217,14 @@ information, to aid in the creation of new rules." (:after (pcase arg ((or "let" "do" "of" "in" "->" "\\") 2) - ("=" (when (not (smie-rule-parent-p "data")) 2)) + ((and "=" (guard (not (smie-rule-parent-p "data")))) 2) ("\\case" 2) ;; LambdaCase - ("where" (when (not (smie-rule-parent-p "module")) 2)) + ((and "where" (guard (not (smie-rule-parent-p "module")))) 2) ((or "[" "(") 2) - ("{" (when (not (smie-rule-prev-p - "\\case" ;; LambdaCase - "where" "let" "do" "of")) - 2)) + ((and "{" (guard (not (smie-rule-prev-p + "\\case" ;; LambdaCase + "where" "let" "do" "of")))) + 2) ("," (smie-rule-separator method)) ((or "SYMID") (if (smie-rule-hanging-p) 2 (smie-rule-parent))) @@ -250,12 +250,13 @@ information, to aid in the creation of new rules." (if (smie-rule-parent-p "=") (smie-rule-parent-column) (smie-rule-separator method))) - ((or "[" "(" "{") - (when (smie-rule-hanging-p) - (smie-rule-parent))) + ((and (or "[" "(" "{") (guard (smie-rule-hanging-p))) + (smie-rule-parent)) ("," (smie-rule-separator method)) - (_ (when (smie-rule-parent-p "SYMID") - (smie-rule-parent))) + ((and ";;" (guard (smie-rule-parent-p ","))) + (smie-rule-parent)) + ((guard (smie-rule-parent-p "SYMID")) + (smie-rule-parent)) )) )) diff --git a/test/haskell-tng-indent-test.el b/test/haskell-tng-indent-test.el index 11a14ca..da015fc 100644 --- a/test/haskell-tng-indent-test.el +++ b/test/haskell-tng-indent-test.el @@ -14,10 +14,14 @@ ;; FIXME implement more indentation rules ;; +;; TODO records +;; TODO coproducts ;; TODO multiline type signatures ;; TODO if/then/else ;; TODO data: one conid ~> record, multi ~> coproduct +;; TODO reindenting needs attention, it's all over the radar + ;; Three indentation regression tests are possible: ;; ;; 1. newline-and-indent with the rest of the file deleted (append) diff --git a/test/haskell-tng-lexer-test.el b/test/haskell-tng-lexer-test.el index 5fc7c0e..1dc4d77 100644 --- a/test/haskell-tng-lexer-test.el +++ b/test/haskell-tng-lexer-test.el @@ -29,26 +29,31 @@ ;; three parses at this position will produce a virtual token and a real ;; token, then move the point for another token. (goto-char 317) + (should (equal (haskell-tng-lexer-test:indent-forward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-forward-token) ";")) (should (equal (haskell-tng-lexer-test:indent-forward-token) "VARID")) (should (equal (haskell-tng-lexer-test:indent-forward-token) "«")) ;; repeating the above, but with a user edit, should reset the state (goto-char 317) + (should (equal (haskell-tng-lexer-test:indent-forward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-forward-token) ";")) (save-excursion (goto-char (point-max)) (insert " ")) + (should (equal (haskell-tng-lexer-test:indent-forward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-forward-token) ";")) (should (equal (haskell-tng-lexer-test:indent-forward-token) "VARID")) (should (equal (haskell-tng-lexer-test:indent-forward-token) "«")) ;; repeating again, but jumping the lexer, should reset the state (goto-char 317) + (should (equal (haskell-tng-lexer-test:indent-forward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-forward-token) ";")) (goto-char 327) (should (equal (haskell-tng-lexer-test:indent-forward-token) "CONID")) (goto-char 317) + (should (equal (haskell-tng-lexer-test:indent-forward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-forward-token) ";")) (should (equal (haskell-tng-lexer-test:indent-forward-token) "VARID")) (should (equal (haskell-tng-lexer-test:indent-forward-token) "«")) @@ -56,29 +61,34 @@ ;; repeating those tests, but for the backward lexer (goto-char 317) (should (equal (haskell-tng-lexer-test:indent-backward-token) ";")) + (should (equal (haskell-tng-lexer-test:indent-backward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-backward-token) "[]")) (goto-char 317) (should (equal (haskell-tng-lexer-test:indent-backward-token) ";")) + (should (equal (haskell-tng-lexer-test:indent-backward-token) ";;")) (save-excursion (goto-char (point-max)) (insert " ")) (should (equal (haskell-tng-lexer-test:indent-backward-token) ";")) + (should (equal (haskell-tng-lexer-test:indent-backward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-backward-token) "[]")) (goto-char 317) (should (equal (haskell-tng-lexer-test:indent-backward-token) ";")) + (should (equal (haskell-tng-lexer-test:indent-backward-token) ";;")) (goto-char 327) (should (equal (haskell-tng-lexer-test:indent-backward-token) "«")) (goto-char 317) (should (equal (haskell-tng-lexer-test:indent-backward-token) ";")) + (should (equal (haskell-tng-lexer-test:indent-backward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-backward-token) "[]")) ;; jumping between forward and backward at point should reset state (goto-char 317) - (should (equal (haskell-tng-lexer-test:indent-forward-token) ";")) + (should (equal (haskell-tng-lexer-test:indent-forward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-backward-token) ";")) - (should (equal (haskell-tng-lexer-test:indent-forward-token) ";")) + (should (equal (haskell-tng-lexer-test:indent-forward-token) ";;")) (should (equal (haskell-tng-lexer-test:indent-backward-token) ";")) )) diff --git a/test/src/grammar.hs.sexps b/test/src/grammar.hs.sexps index b3cd0f7..e6e1e89 100644 --- a/test/src/grammar.hs.sexps +++ b/test/src/grammar.hs.sexps @@ -2,7 +2,7 @@ ((module ((Foo).(Bar)) (where) ((calc) (::) (Int) -> (Int) -((calc) (a) = (if (a) < ((10) +(calc) (a) = (if (a) < ((10) (then) (a) + (a) * (a) + ((a) - (else) ((a) + (a)) * ((a) + (a)))))) -))) \ No newline at end of file + (else) ((a) + (a)) * ((a) + (a)) +)))))) \ No newline at end of file diff --git a/test/src/indentation.hs.insert.indent b/test/src/indentation.hs.insert.indent index dc63d4c..88c080c 100644 --- a/test/src/indentation.hs.insert.indent +++ b/test/src/indentation.hs.insert.indent @@ -171,7 +171,7 @@ data Record2 = Record2 { fieldA :: String 1 v , fieldB :: String -2 1 v +1 v } v 1 diff --git a/test/src/indentation.hs.lexer b/test/src/indentation.hs.lexer index b4eddbc..fb28a8c 100644 --- a/test/src/indentation.hs.lexer +++ b/test/src/indentation.hs.lexer @@ -10,110 +10,110 @@ module CONID where { import CONID -; import CONID VARID « VARID , +;; ; import CONID VARID « VARID , VARID » -; VARID = do +;; ; VARID = do { VARID <- VARID VARID VARID -; VARID <- VARID VARID +;; ; VARID <- VARID VARID VARID VARID -; VARID -; VARID VARID -; let { VARID = VARID VARID +;; ; VARID +;; ; VARID VARID +;; ; let { VARID = VARID VARID VARID -; VARID = VARID -; VARID = +;; ; VARID = VARID +;; ; VARID = VARID -} ; VARID VARID +;; } ;; ; VARID VARID -} ; VARID = +;; } ;; ; VARID = do { VARID <- VARID -; do { VARID <- VARID -; VARID +;; ; do { VARID <- VARID +;; ; VARID -} } ; VARID VARID VARID = VARID VARID VARID +;; } ;; } ;; ; VARID VARID VARID = VARID VARID VARID where { VARID = VARID VARID -; VARID = VARID VARID +;; ; VARID = VARID VARID where { VARID VARID = VARID -; VARID = VARID +;; ; VARID = VARID -} } ; VARID VARID VARID = let +;; } ;; } ;; ; VARID VARID VARID = let { VARID = VARID -; VARID _ = VARID -; in +;; ; VARID _ = VARID +;; ; in VARID VARID -} ; VARID VARID VARID = +;; } ;; ; VARID VARID VARID = let { VARID = VARID -; VARID = VARID -} in VARID +;; ; VARID = VARID +;; } in VARID -; VARID VARID = case VARID of +;; ; VARID VARID = case VARID of { CONID -> § -; CONID VARID -> +;; ; CONID VARID -> VARID -} ; VARID = \case +;; } ;; ; VARID = \case { CONID -> § -; CONID VARID -> VARID +;; ; CONID VARID -> VARID -} ; VARID VARID CONID = VARID SYMID +;; } ;; ; VARID VARID CONID = VARID SYMID § § § -; VARID VARID « CONID VARID » = VARID SYMID \ VARID -> +;; ; VARID VARID « CONID VARID » = VARID SYMID \ VARID -> VARID -; VARID = do +;; ; VARID = do { VARID <- VARID SYMID VARID VARID -; VARID SYMID +;; ; VARID SYMID VARID -} ; data CONID = CONID CONID +;; } ;; ; data CONID = CONID CONID | CONID CONID | CONID CONID -; data CONID = CONID « +;; ; data CONID = CONID « VARID :: CONID -; , VARID :: CONID -; » +;; ; , VARID :: CONID +;; ; » -; data CONID = CONID +;; ; data CONID = CONID « VARID :: CONID , VARID :: CONID » -; VARID = « VARID +;; ; VARID = « VARID , VARID , « VARID , VARID , VARID » » -; VARID = « +;; ; VARID = « VARID -; , VARID -; » +;; ; , VARID +;; ; » -; VARID = « VARID , +;; ; VARID = « VARID , VARID » -; VARID = « VARID +;; ; VARID = « VARID , VARID , « VARID , VARID , VARID » » -; VARID = « +;; ; VARID = « VARID -; , VARID -; » +;; ; , VARID +;; ; » -; VARID = « VARID , +;; ; VARID = « VARID , VARID » -} +;; } diff --git a/test/src/indentation.hs.reindent b/test/src/indentation.hs.reindent index f764170..27d7179 100644 --- a/test/src/indentation.hs.reindent +++ b/test/src/indentation.hs.reindent @@ -22,7 +22,7 @@ v v import Foo.Bar -v 1 +1 v 2 import Foo.Baz hiding ( gaz, 1 2 v baz @@ -30,125 +30,125 @@ import Foo.Baz hiding ( gaz, ) v 1 2 -v 1 2 3 +2 1 v 3 4 basic_do = do 1 v 2 foo <- blah blah blah -v 1 2 +2 1 v 3 bar <- blah blah 2 1 v blah -- manual correction 2 1 v blah -- manual correction -v 2 1 +2 1 v sideeffect -v 1 2 3 +2 v 1 3 sideeffect' blah -v 1 3 2 +3 1 4 2 v let baz = blah blah 3 2 1 4 v blah -- manual correction -v 3 2 4 1 +2 3 1 4 v gaz = blah -v 3 1 24 5 +3 4 1 25 v haz = 3 2 1 v4 5 blah -2 v 3 14 5 +2 3 v 14 5 pure faz -- manual correction 1 v 2 34 5 -v 2 13 45 6 +2 v 13 45 6 nested_do = -- manual correction v 1 do foo <- blah -v 1 3 2 +3 1 2 v 4 do bar <- blah -- same level as foo -v 2 1 4 3 +3 2 1 4 v baz -- same level as bar 1 2 v 3 4 -v 1 2 3 4 +2 1 v 3 4 5 nested_where a b = foo a b 1 v 2 where -- manual correction 1 v foo = bar baz -- indented -v 1 +2 1 v baz = blah blah -- same level as foo 2 v 1 where -- manual correction 1 2 v gaz a = blah -- indented -v 2 1 +2 3 1 v faz = blah -- same level as gaz 1 2 v -v 1 2 3 +2 1 v 3 let_in a b = let 1 v blah = bloo -v 1 +2 1 v wobble _ = fish -v 1 2 +3 1 2 v in 2 1 v flibble blah 2 v 1 -v 2 3 1 +2 v 3 1 implicit_let foo bar = v 1 let ?foo = foo -v 2 1 +3 2 1 v ?bar = bar -v 1 +1 v in rar v 1 2 -v 1 2 +1 v 2 case_of wibble = case wibble of 1 v 2 Nothing -> 2 1 v "" -v 2 1 +1 2 v Just fish -> 2 1 v fish 2 v 1 -v 1 2 +1 v 2 lambda_case = \case 1 v Nothing -> "" -v 1 +2 1 v Just fish -> fish 1 v -v 1 +1 v dollars f Nothing = f $ 1 v "" "" 1 v "" -v 1 +1 v dollars f (Just a) = f $ \s -> 1 v a v 1 -v 1 +1 v not_dollars = do 1 v 2 db' <- liftIO $ readMVar db -v 1 3 2 +4 1 3 2 v shouldGoHere <$> 2 1 v 3 here 2 v 1 3 -v 2 3 4 1 +2 v 3 4 1 data Wibble = Wibble Int 1 v | Wobble Int @@ -156,17 +156,17 @@ data Wibble = Wibble Int | Vibble Int v 1 -v 1 2 +2 1 3 v data Record1 = Record1 { 1 v fieldA :: String -v 1 +2 1 v , fieldB :: String v } v -v 1 +2 1 v data Record2 = Record2 1 2 v { fieldA :: String @@ -176,7 +176,7 @@ data Record2 = Record2 } v 1 -v 2 1 +2 v 1 lists1 = [ foo 1 v , bar @@ -190,23 +190,23 @@ lists1 = [ foo ] v 1 2 -v 1 2 3 +2 1 v 3 lists2 = [ 1 v foo -v 1 +1 v , bar v ] v -v 1 +2 v 1 lists3 = [ foo , 1 v bar ] v 1 -v 12 +2 v13 tuples1 = ( foo 1 v , bar @@ -220,17 +220,17 @@ tuples1 = ( foo ) v 1 2 -v 1 2 3 +2 1 v 3 tuples2 = ( 1 v foo -v 1 +1 v , bar v ) v -v 1 +2 v 1 tuples3 = ( foo , 1 v bar ) \ No newline at end of file diff --git a/test/src/indentation.hs.sexps b/test/src/indentation.hs.sexps index e149595..d554d21 100644 --- a/test/src/indentation.hs.sexps +++ b/test/src/indentation.hs.sexps @@ -10,110 +10,110 @@ ((module (Indentation) (where) (((import) ((Foo).)(Bar)) -(((import) ((Foo).)(Baz)) (hiding) ( (gaz), +((import) ((Foo).)(Baz)) (hiding) ( (gaz), (baz) - )) + ) -((basic_do) = (do +(basic_do) = (do ((foo) <- (blah) (blah) (blah) - ((bar) <- (blah) (blah) + (bar) <- (blah) (blah) + (blah) -- manual correction (blah) -- manual correction - (blah)) -- manual correction (sideeffect) - ((sideeffect') (blah)) - (let ((baz) = (blah) (blah) + (sideeffect') (blah) + let (((baz) = (blah) (blah) (blah) -- manual correction - ((gaz) = (blah)) - ((haz) = - (blah)) - )(pure) (faz)) -- manual correction + )((gaz) = (blah) + )(haz) = + (blah) + )(pure) (faz) -- manual correction )(nested_do) = -- manual correction (do (((foo) <- (blah) - (do ((bar) <- (blah) -- same level as foo + do ((bar) <- (blah) -- same level as foo (baz) -- same level as bar -)))(nested_where) (a) (b) = (foo) (a) (b) +))(nested_where) (a) (b) = (foo) (a) (b) (where) -- manual correction - (((foo) = (bar) (baz) -- indented - ((baz) = (blah) (blah)) -- same level as foo + ((((foo) = (bar) (baz) -- indented + )(baz) = (blah) (blah) -- same level as foo (where) -- manual correction - ((gaz) (a) = (blah) -- indented - ((faz) = (blah)) -- same level as gaz + (((gaz) (a) = (blah) -- indented + )(faz) = (blah) -- same level as gaz )))(let_in) (a) (b) = (let - (((blah) = (bloo) - (((wobble) (_) = (fish)) + ((((blah) = (bloo) + )((wobble) (_) = (fish) )in) (flibble) (blah) -)(implicit_let) (foo) (bar) = - (let ((?foo) = (foo) - ((?bar) = (bar)) +)((implicit_let) (foo) (bar) = + (let (((?foo) = (foo) + )(?bar) = (bar) )in) (rar) -((case_of) (wibble) = ((case (wibble) (of) +)(case_of) (wibble) = ((case (wibble) (of) ((Nothing) -> ("") - ((Just) (fish) -> - (fish)) + (Just) (fish) -> + (fish) )(lambda_case) = (\(case ((Nothing) -> ("") - ((Just) (fish) -> (fish)) + (Just) (fish) -> (fish) ))(dollars) (f) (Nothing) = (f) $ ("") ("") ("") -((dollars) (f) ((Just) (a)) = (f) $ (\)(s) -> +(dollars) (f) ((Just) (a)) = (f) $ (\)(s) -> (a) -((not_dollars) = (do +(not_dollars) = (do ((db') <- (liftIO) $ (readMVar) (db) - ((shouldGoHere) <$> - (here)) + (shouldGoHere) <$> + (here) -)data (Wibble) = (Wibble) (Int) +)(data (Wibble) = (Wibble) (Int) | (Wobble) (Int) | (Vibble) (Int) -(data (Record1) = (Record1) ({ +)(data (Record1) = (Record1) ({ (fieldA) (::) (String) -((, (fieldB) (::) (String)) -)})) +(, (fieldB) (::) (String) +)}) -(data (Record2) = (Record2) +)(data (Record2) = (Record2) ({ (fieldA) (::) (String) , (fieldB) (::) (String) - })) + }) -((lists1) = ([ (foo) +)((lists1) = ([ (foo) , (bar) , ([ (blah) , (blah) , (blah) ]) - ])) + ]) -((lists2) = ([ +)((lists2) = ([ (foo) -((, (bar)) -)])) +, (bar) +]) -((lists3) = ([ (foo) , - (bar) ])) +)((lists3) = ([ (foo) , + (bar) ]) -((tuples1) = ( (foo) +)((tuples1) = ( (foo) , (bar) , ( (blah) , (blah) , (blah) ) - )) + ) -((tuples2) = ( +)((tuples2) = ( (foo) -((, (bar)) -))) +, (bar) +) -((tuples3) = ( (foo) , - (bar) )))))))))))))) -))) \ No newline at end of file +)(tuples3) = ( (foo) , + (bar) ) +))))))))))) \ No newline at end of file diff --git a/test/src/layout.hs.lexer b/test/src/layout.hs.lexer index 4128c01..c4c96a9 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 VARID = CONID VARID VARID +;; ; VARID :: VARID -> CONID VARID -> CONID VARID +;; ; VARID VARID VARID = CONID VARID VARID -; VARID :: CONID VARID -> CONID -; VARID VARID = VARID « VARID VARID » where +;; ; VARID :: CONID VARID -> CONID +;; ; VARID VARID = VARID « VARID VARID » where { VARID CONID = [] -; VARID « CONID VARID VARID » = VARID : VARID where { VARID = VARID VARID +;; ; VARID « CONID VARID VARID » = VARID : VARID where { VARID = VARID 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 , 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 -} +;; ; VARID :: CONID VARID -> VARID +;; ; VARID « CONID VARID VARID » = VARID +;; } diff --git a/test/src/layout.hs.sexps b/test/src/layout.hs.sexps index 44af28c..d20fc96 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) +(((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 + = ((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 diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer index 0a2047f..c866593 100644 --- a/test/src/medley.hs.lexer +++ b/test/src/medley.hs.lexer @@ -10,88 +10,88 @@ module CONID » where { import CONID « VARID , VARID , VARID , « SYMID » , « SYMID » » -; import CONID « VARID » -; import CONID « « SYMID » » -; import CONID « VARID » -; import CONID « « SYMID » » -; import VARID CONID -; import VARID CONID VARID CONID -; import VARID CONID +;; ; import CONID « VARID » +;; ; import CONID « « SYMID » » +;; ; import CONID « VARID » +;; ; import CONID « « SYMID » » +;; ; import VARID CONID +;; ; import VARID CONID VARID CONID +;; ; import VARID CONID VARID CONID -; import VARID CONID VARID « VARID , VARID , VARID » -; import CONID « VARID , VARID , VARID » -; import CONID VARID « VARID , VARID , VARID » -; import VARID CONID « VARID , VARID , VARID » -; import CONID « CONID « .. » , VARID , VARID , +;; ; import VARID CONID VARID « VARID , VARID , VARID » +;; ; import CONID « VARID , VARID , VARID » +;; ; import CONID VARID « VARID , VARID , VARID » +;; ; import VARID CONID « VARID , VARID , VARID » +;; ; import CONID « CONID « .. » , VARID , VARID , CONID , VARID , CONID » -; import CONID « VARID , CONID « CONID , « CONSYM » » » -; import CONID « CONID « .. » , VARID , VARID , +;; ; import CONID « VARID , CONID « CONID , « CONSYM » » » +;; ; import CONID « CONID « .. » , VARID , VARID , VARID , VARID , VARID , VARID , VARID , CONID » -; import CONID « CONID « .. » , CONID « .. » , +;; ; import CONID « CONID « .. » , CONID « .. » , VARID , VARID , VARID » -; VARID = « § , § , § » +;; ; VARID = « § , § , § » -; VARID = « § , § , § , § » +;; ; VARID = « § , § , § , § » -; VARID = §§ +;; ; VARID = §§ -; VARID = §§ +;; ; VARID = §§ -; VARID = VARID § 2 +;; ; VARID = VARID § 2 -; VARID = § +;; ; VARID = § -; class CONID VARID VARID where +;; ; class CONID VARID VARID where { VARID :: CONID VARID -> VARID -} ; instance CONID VARID « VARID ': VARID » where +;; } ;; ; instance CONID VARID « VARID ': VARID » where { VARID « CONID VARID _ » = VARID -} ; instance CONID VARID VARID => CONID VARID « VARID ': VARID » where +;; } ;; ; instance CONID VARID VARID => CONID VARID « VARID ': VARID » where { VARID « CONID _ VARID » = VARID VARID -} ; data CONID = CONID +;; } ;; ; data CONID = CONID « VARID :: CONID , VARID :: CONID CONID , VARID :: CONID CONID , VARID :: « CONID » » deriving « CONID , CONID » -; class « CONID VARID » => CONID VARID where +;; ; class « CONID VARID » => CONID VARID where { « SYMID » , « SYMID » , « SYMID » , « SYMID » :: VARID -> VARID -> CONID -; VARID @ CONID , VARID :: VARID -> VARID -> VARID +;; ; VARID @ CONID , VARID :: VARID -> VARID -> VARID -} ; instance « CONID VARID » => CONID « CONID VARID » where +;; } ;; ; instance « CONID VARID » => CONID « CONID VARID » where { CONID VARID SYMID CONID VARID = VARID SYMID VARID -; « CONID VARID VARID » SYMID « CONID VARID VARID » = « VARID SYMID VARID » SYMID « VARID SYMID VARID » -; _ SYMID _ = CONID +;; ; « CONID VARID VARID » SYMID « CONID VARID VARID » = « VARID SYMID VARID » SYMID « VARID SYMID VARID » +;; ; _ SYMID _ = CONID -} ; data CONID = CONID +;; } ;; ; data CONID = CONID | CONID | CONID | CONID | CONID deriving « CONID , CONID » -; type VARID CONID VARID where +;; ; type VARID CONID VARID where { CONID CONID = CONID -; CONID VARID = CONID +;; ; CONID VARID = CONID -} ; data CONID = CONID +;; } ;; ; data CONID = CONID deriving « CONID » VARID « CONID « CONID CONID » » deriving VARID « CONID » deriving VARID « CONID , CONID » -; newtype CONID = CONID +;; ; newtype CONID = CONID -; VARID :: +;; ; VARID :: CONID -> CONID -> CONID @@ -100,17 +100,17 @@ CONID -> « CONID VARID VARID VARID » -; « VARID :: « CONID CONID » » VARID +;; ; « VARID :: « CONID CONID » » VARID -; newtype CONID +;; ; newtype CONID « VARID :: CONID » « VARID :: CONID » VARID VARID = CONID VARID -; VARID :: CONID CONID -; VARID = CONID +;; ; VARID :: CONID CONID +;; ; VARID = CONID SYMID « VARID CONID « VARID § SYMID VARID § » SYMID VARID CONID « VARID § SYMID VARID § » SYMID VARID CONID « VARID § SYMID VARID § » » @@ -119,9 +119,9 @@ SYMID VARID « VARID § SYMID VARID § » » -; type CONID +;; ; type CONID -; type CONID = +;; ; type CONID = § CONSYM CONID § CONID CONSYM CONID § CONID CONSYM CONID § CONID CONSYM CONID CONID CONID @@ -132,22 +132,22 @@ CONSYM CONID CONID CONID CONSYM CONID CONSYM CONID « CONID » « CONID CONID » -; deriving instance CONID CONID -; deriving VARID instance CONID CONID -; deriving newtype instance CONID CONID +;; ; deriving instance CONID CONID +;; ; deriving VARID instance CONID CONID +;; ; deriving newtype instance CONID CONID -; VARID = do +;; ; VARID = do { VARID :: CONID <- VARID -; where { VARID = _ +;; ; where { VARID = _ -; « SYMID » = _ +;; ; « SYMID » = _ -} } ; VARID = 1 SYMID 1 +;; } ;; } ;; ; VARID = 1 SYMID 1 -; VARID = \case +;; ; VARID = \case { CONID -> § SYMID VARID -; CONID _ -> VARID SYMID § +;; ; CONID _ -> VARID SYMID § -} ; VARID = do -{ } } +;; } ;; ; VARID = do +{ ;; } ;; }