Add lexerDbg to dump the tokens fed to the parser

This a small utility function that comes in handy when debugging the
lexer and the parser.

2 files changed, 10 insertions, 2 deletions

diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index fc6779a359..efae29e84e 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -49,7 +49,7 @@
 {-# OPTIONS_GHC -funbox-strict-fields #-}
 
 module Lexer (
-   Token(..), lexer, pragState, mkPState, mkPStatePure, PState(..),
+   Token(..), lexer, lexerDbg, pragState, mkPState, mkPStatePure, PState(..),
    P(..), ParseResult(..), mkParserFlags, mkParserFlags', ParserFlags(..),
    appendWarning,
    appendError,
@@ -2808,7 +2808,8 @@ lexError str = do
 -- This is the top-level function: called from the parser each time a
 -- new token is to be read from the input.
 
-lexer :: Bool -> (Located Token -> P a) -> P a
+lexer, lexerDbg :: Bool -> (Located Token -> P a) -> P a
+
 lexer queueComments cont = do
   alr <- getBit AlternativeLayoutRuleBit
   let lexTokenFun = if alr then lexTokenAlr else lexToken
@@ -2827,6 +2828,11 @@ lexer queueComments cont = do
     then queueComment (L (RealSrcSpan span) tok) >> lexer queueComments cont
     else cont (L (RealSrcSpan span) tok)
 
+-- Use this instead of 'lexer' in Parser.y to dump the tokens for debugging.
+lexerDbg queueComments cont = lexer queueComments contDbg
+  where
+    contDbg tok = trace ("token: " ++ show (unLoc tok)) (cont tok)
+
 lexTokenAlr :: P (RealLocated Token)
 lexTokenAlr = do mPending <- popPendingImplicitToken
                  t <- case mPending of
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index ce4d277f6b..c96cd92f5a 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -618,6 +618,8 @@ TH_QQUASIQUOTE  { L _ (ITqQuasiQuote _) }
 
 %monad { P } { >>= } { return }
 %lexer { (lexer True) } { L _ ITeof }
+  -- Replace 'lexer' above with 'lexerDbg'
+  -- to dump the tokens fed to the parser.
 %tokentype { (Located Token) }
 
 -- Exported parsers