[Git][ghc/ghc][wip/az/ghc-cpp] 2 commits: Small cleanup

[Alan Zimmerman (@alanz)]

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC


Commits:
89facfce by Alan Zimmerman at 2023-09-27T18:50:45+01:00
Small cleanup

- - - - -
014d69b2 by Alan Zimmerman at 2023-09-27T21:21:08+01:00
Get rid of some cruft

- - - - -


1 changed file:

- utils/check-cpp/Main.hs


Changes:

=====================================
utils/check-cpp/Main.hs
=====================================
@@ -1,7 +1,9 @@
 -- Note: this file formatted with fourmolu
+{-# LANGUAGE BangPatterns #-}
 
 import Control.Monad.IO.Class
 import Data.Data hiding (Fixity)
+import Data.List
 import qualified Data.Set as Set
 import Debug.Trace (trace)
 import GHC
@@ -39,27 +41,6 @@ ppLexerDbg queueComments cont = ppLexer queueComments contDbg
   where
     contDbg tok = trace ("pptoken: " ++ show (unLoc tok)) (cont tok)
 
--- NOTE: instead of pulling tokens and calling cont, consider putting
--- this inside Lexer.lexer, much like the queueComments stuff
--- That sorts out
---    - ALR
---    - queueing comments
--- ppLexer _queueComments cont = do
---     tok <- ppLexToken
---     trace ("ppLexer:" ++ show (unLoc tok)) $ do
---         tok' <- case tok of
---             L _ ITcppIf -> preprocessIf tok
---             L _ ITcppDefine -> preprocessDefine tok
---             L _ ITcppIfdef -> preprocessIfDef tok
---             L _ ITcppElse -> preprocessElse tok
---             L _ ITcppEndif -> preprocessEnd tok
---             L l _ -> do
---                 accepting <- getAccepting
---                 if accepting
---                     then return tok
---                     else return (L l (ITcppIgnored [tok]))
---         cont tok'
-
 ppLexer queueComments cont =
     Lexer.lexer
         queueComments
@@ -73,11 +54,11 @@ ppLexer queueComments cont =
                     L _ ITcppIf -> contPush
                     L _ ITcppIfdef -> contPush
                     L _ ITcppElse -> do
-                      tk' <- preprocessElse tk
-                      contInner tk'
+                        tk' <- preprocessElse tk
+                        contInner tk'
                     L _ ITcppEndif -> do
-                      tk' <- preprocessEnd tk
-                      contInner tk'
+                        tk' <- preprocessEnd tk
+                        contInner tk'
                     L l tok -> do
                         state <- getCppState
                         case (trace ("CPP state:" ++ show state) state) of
@@ -96,36 +77,6 @@ ppLexer queueComments cont =
                             _ -> contInner tk
         )
 
--- Swallow tokens until ITcppEndif
-preprocessIf :: Located Token -> P (Located Token)
-preprocessIf tok = go [tok]
-  where
-    go :: [Located Token] -> P (Located Token)
-    go acc = do
-        tok' <- ppLexToken
-        case tok' of
-            L l ITcppEndif -> return $ L l (ITcppIgnored (reverse (tok' : acc)))
-            _ -> go (tok' : acc)
-
--- preprocessDefine :: Located Token -> P (Located Token)
--- preprocessDefine tok@(L l ITcppDefine) = do
---     L ll cond <- ppLexToken
---     -- ppDefine (show cond)
---     ppDefine (trace ("ppDefine:" ++ show cond) (show cond))
---     return (L l (ITcppIgnored [tok, L ll cond]))
--- preprocessDefine tok = return tok
-
-preprocessIfDef :: Located Token -> P (Located Token)
-preprocessIfDef tok@(L l ITcppIfdef) = do
-    L ll cond <- ppLexToken
-    defined <- ppIsDefined (show cond)
-    if defined
-        then do
-            pushContext ITcppIfdef
-            setAccepting True
-        else setAccepting False
-    return (L l (ITcppIgnored [tok, L ll cond]))
-preprocessIfDef tok = return tok
 
 preprocessElse :: Located Token -> P (Located Token)
 preprocessElse tok@(L l _) = do
@@ -221,16 +172,6 @@ getPushBack :: P (Maybe (Located Token))
 getPushBack = P $ \s ->
     POk s{pp = (pp s){pp_pushed_back = Nothing}} (pp_pushed_back (pp s))
 
--- | Get next token, which may be the pushed back one
-ppLexToken :: P (Located Token)
-ppLexToken = do
-    mtok <- getPushBack
-    case mtok of
-        Just t -> return t
-        Nothing -> do
-            -- TODO: do we need this? Issues with ALR, comments, etc being bypassed
-            (L sp tok) <- Lexer.lexToken
-            return (L (mkSrcSpanPs sp) tok)
 
 -- pp_pushed_back token end ----------------
 
@@ -413,9 +354,9 @@ printToks :: Int -> [Located Token] -> IO ()
 printToks indent toks = mapM_ go toks
   where
     go (L _ (ITcppIgnored ts)) = do
-      putStr "ITcppIgnored ["
-      printToks (indent + 4) ts
-      putStrLn "]"
+        putStr "ITcppIgnored ["
+        printToks (indent + 4) ts
+        putStrLn "]"
     go (L _ tk) = putStrLn (show tk)
 
 -- Testing
@@ -423,13 +364,26 @@ printToks indent toks = mapM_ go toks
 libdirNow :: LibDir
 libdirNow = "/home/alanz/mysrc/git.haskell.org/worktree/bisect/_build/stage1/lib"
 
+doTest :: [String] -> IO ()
+doTest strings = do
+    let test = intercalate "\n" strings
+    !tks <- parseString libdirNow test
+    putStrLn "-----------------------------------------"
+    printToks 0 (reverse tks)
+
 t0 :: IO ()
 t0 = do
-    tks <- parseString libdirNow "#define FOO\n#ifdef FOO\nx = 1\n#endif\n"
-    -- putStrLn $ show (reverse $ map unLoc tks)
-    printToks 0 (reverse tks)
+    doTest
+        [ "#define FOO"
+        , "#ifdef FOO"
+        , "x = 1"
+        , "#endif"
+        , ""
+        ]
 
 t1 :: IO ()
 t1 = do
-    tks <- parseString libdirNow "data X = X\n"
-    putStrLn $ show (reverse $ map unLoc tks)
+    doTest
+        [ "data X = X"
+        , ""
+        ]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a56ed7c32a1d76f255ef3e66935977363aa7a23...014d69b293bdefedf51ee94668ca31275c0a851c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a56ed7c32a1d76f255ef3e66935977363aa7a23...014d69b293bdefedf51ee94668ca31275c0a851c
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230927/fcbaa9da/attachment-0001.html>