From 5ea1ee91c2ad1db38ada2590f30dc0ea4ed6ef29 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sun, 17 Mar 2019 23:55:52 -0400
Subject: Use refactored comment parser.

---
 monkeypatch.cabal |  2 +-
 monkeypatch.hs    | 40 ++++++++++++----------------------------
 2 files changed, 13 insertions(+), 29 deletions(-)

diff --git a/monkeypatch.cabal b/monkeypatch.cabal
index 21146e4..ac31a6d 100644
--- a/monkeypatch.cabal
+++ b/monkeypatch.cabal
@@ -52,7 +52,7 @@ extra-source-files:  CHANGELOG.md
 
 executable monkeypatch
   main-is:             monkeypatch.hs
-  -- other-modules:
+  other-modules:       Comments
   -- other-extensions:
   build-depends:       base >=4.10.1.0  && <=4.12
                      , containers ^>=0.5.10.2
diff --git a/monkeypatch.hs b/monkeypatch.hs
index 4942859..9060c3e 100644
--- a/monkeypatch.hs
+++ b/monkeypatch.hs
@@ -46,6 +46,8 @@ import Text.PrettyPrint             (Doc, doubleQuotes, empty, text, vcat, ($$),
                                      (<+>))
 import Text.Show.Pretty
 
+import Comments
+
 -- trace _ = id
 
 -- | Pretty print the given tranlation unit, but replace declarations from header files with @#include@ directives.
@@ -144,6 +146,10 @@ data Computation st = Computation
     }
  deriving (Eq,Ord,Functor)
 
+{-
+ CUnary CAdrOp (CVar _) LT) LT
+-}
+
 grokExpression (CVar cv _) = Just Computation
     { compFree  = Map.singleton (identToString cv) ()
     , compIntro = Map.empty
@@ -272,11 +278,12 @@ transpile o fname incs (CTranslUnit edecls _) = do
                         -- putStrLn $ show (fmap (const LT) c)
                         putStrLn . HS.prettyPrint $ changeType makeFunctionUseIO hh
                         putStrLn $ unwords (hname:as) ++ " ="
+                cleanTree d = fmap (const LT) $ everywhere (mkT eraseNodeInfo) $ d
             forM_ mprintHeader $ \printHeader -> do
                 let bdy = concat $ take 1 $ dropWhile null $ map body $ symbolSource sym
                 if oPrettyTree o
                     then do printHeader
-                            forM_ bdy $ \d -> putStrLn $ ppShow $ fmap (const LT) $ everywhere (mkT eraseNodeInfo) $ d
+                            forM_ bdy $ \d -> putStrLn $ ppShow $ cleanTree d
                     else do
                         let mhask = do
                                 xs <- sequence $ map grokStatement bdy
@@ -287,8 +294,10 @@ transpile o fname incs (CTranslUnit edecls _) = do
                             Nothing -> forM_ (oSelectFunction o) $ \_ -> do
                                 printHeader
                                 forM_ bdy $ \d -> do
-                                    putStrLn . show . pretty $ d
-                                    mapM_ (putStrLn . HS.prettyPrint . comp) (grokStatement d)
+                                    putStrLn $ " C: " ++ show (pretty d)
+                                    case grokStatement d of
+                                        Just hd -> putStrLn $ "HS: " ++ HS.prettyPrint (comp hd)
+                                        Nothing -> putStrLn $ "??: " ++ ppShow (cleanTree d)
     return ()
 
 isHeaderDecl :: CNode a => a -> Bool
@@ -1105,31 +1114,6 @@ goMissing haskmod db cfun = do
 readComments :: (Num lin, Num col) => FilePath -> IO [(lin, col, [Char])]
 readComments fname = parseComments 1 1 <$> readFile fname
 
-findCloser :: (Num a4, Num a3, Num a2, Num a1, Eq a1) =>
-                    a1 -> (a4, a2, a3) -> [Char] -> (a4, a2, a3)
-findCloser !1 (l,c,b) ('*':'/':_)  = (l,c+2,b+2)
-findCloser !d (l,c,b) ('*':'/':xs) = findCloser (d - 1) (l,c+2,b+2) xs
-findCloser !d (l,c,b) ('/':'*':xs) = findCloser (d + 1) (l,c+2,b+2) xs
-findCloser !d (l,c,b) ('\n':xs)    = findCloser d (l+1,1,b+1) xs
-findCloser !d (l,c,b) (_:xs)       = findCloser d (l,c+1,b+1) xs
-findCloser !d (l,c,b) []           = (l,c,b)
-
-mkComment :: a -> b -> c -> (a, b, c)
-mkComment lin no str = (lin,no,str)
-
-parseComments :: (Num col, Num lin) => lin -> col -> [Char] -> [(lin, col, [Char])]
-parseComments !lin !col = \case
-    ('/':'*':cs) -> let (lcnt,col',bcnt) = findCloser 1 (0,col,0) cs
-                        (xs,cs') = case drop (bcnt-2) cs of
-                            '*':'/':_ -> second (drop 2) $ splitAt (bcnt-2) cs
-                            _         -> splitAt bcnt cs
-                    in mkComment lin col xs : parseComments (lin + lcnt) col' cs'
-    ('/':'/':cs) -> let (comment,ds) = break (=='\n') cs
-                    in mkComment lin col comment : parseComments (lin + 1) 1 cs
-    ('\n' : cs) -> parseComments (lin+1) 1       cs
-    (  x  : cs) -> parseComments lin     (col+1) cs
-    []          -> []
-
 sanitizeArgs :: [String] -> [String]
 sanitizeArgs (('-':'M':_):args) = sanitizeArgs args
 sanitizeArgs (('-':'O':_):args) = sanitizeArgs args
-- 
cgit v1.2.3