diff options
author | Joe Crayne <joe@jerkface.net> | 2019-03-21 16:28:07 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-03-21 16:28:07 -0400 |
commit | 9e1579d5074f895cce9ac4a32ea5b94c70e4b269 (patch) | |
tree | b2450529c5a383f43aadc71b4fada0af41465fdb /monkeypatch.hs | |
parent | 9f4cfc458fbe6140ac2793a29068794bcd23883e (diff) |
While parsing coments, use width 8 tabs.
Diffstat (limited to 'monkeypatch.hs')
-rw-r--r-- | monkeypatch.hs | 50 |
1 files changed, 43 insertions, 7 deletions
diff --git a/monkeypatch.hs b/monkeypatch.hs index 461d3c1..ea97252 100644 --- a/monkeypatch.hs +++ b/monkeypatch.hs | |||
@@ -24,6 +24,7 @@ import qualified Data.IntMap as IntMap | |||
24 | import qualified Data.Map as Map | 24 | import qualified Data.Map as Map |
25 | ;import Data.Map (Map) | 25 | ;import Data.Map (Map) |
26 | import Data.Maybe | 26 | import Data.Maybe |
27 | import Data.Ord | ||
27 | import qualified Data.Set as Set | 28 | import qualified Data.Set as Set |
28 | ;import Data.Set (Set) | 29 | ;import Data.Set (Set) |
29 | import Language.C.Data.Ident as C | 30 | import Language.C.Data.Ident as C |
@@ -47,7 +48,7 @@ import Text.PrettyPrint (Doc, doubleQuotes, empty, text, vcat, ($$), | |||
47 | (<+>)) | 48 | (<+>)) |
48 | import Text.Show.Pretty | 49 | import Text.Show.Pretty |
49 | 50 | ||
50 | import Comments | 51 | import GrepNested |
51 | 52 | ||
52 | trace :: p -> a -> a | 53 | trace :: p -> a -> a |
53 | trace _ = id | 54 | trace _ = id |
@@ -480,6 +481,31 @@ isFunctionDecl _ = False | |||
480 | cleanTree :: (Functor f, Data (f b)) => f b -> f Ordering | 481 | cleanTree :: (Functor f, Data (f b)) => f b -> f Ordering |
481 | cleanTree d = fmap (const LT) $ everywhere (mkT eraseNodeInfo) $ d | 482 | cleanTree d = fmap (const LT) $ everywhere (mkT eraseNodeInfo) $ d |
482 | 483 | ||
484 | |||
485 | data SymbolExtent = SymbolExtent { startExtent :: Position, stopExtent :: Position } | ||
486 | |||
487 | instance Show SymbolExtent where | ||
488 | show (SymbolExtent a b) = "sed -n "++show al++","++show bl++"p "++fn | ||
489 | where | ||
490 | fn = posFile a | ||
491 | al = posRow a | ||
492 | bl = posRow b | ||
493 | |||
494 | getSymbolExtent :: (CNode a1, Data a2) => | ||
495 | SymbolInformation a2 -- ^ Symbol database record (symbolSource must have Postion data in it). | ||
496 | -> [a1] -- ^ function body (only used for filename) | ||
497 | -> SymbolExtent | ||
498 | getSymbolExtent sym bdy = | ||
499 | -- TODO: This could probably be a lot more efficient using NodeInfo's PosLength field. | ||
500 | let bdy_poss = map (posOfNode . nodeInfo) bdy | ||
501 | -- hpos = map (posOfNode . nodeInfo) (symbolSource sym) | ||
502 | cmodule = map posFile (take 1 $ filter isSourcePos $ bdy_poss) -- TODO: What if first statement is provided by macro? | ||
503 | allposss = listify (\p -> case cmodule of { [f] | isSourcePos p -> posFile p == f ; _ -> isSourcePos p }) (symbolSource sym) :: [Position] | ||
504 | start = minimumBy (comparing posRow) allposss | ||
505 | stop = maximumBy (comparing posRow) allposss | ||
506 | in SymbolExtent start stop | ||
507 | |||
508 | |||
483 | transpile :: C2HaskellOptions -> FilePath -> IncludeStack -> CTranslationUnit NodeInfo -> IO () | 509 | transpile :: C2HaskellOptions -> FilePath -> IncludeStack -> CTranslationUnit NodeInfo -> IO () |
484 | transpile o fname incs (CTranslUnit edecls _) = do | 510 | transpile o fname incs (CTranslUnit edecls _) = do |
485 | let db = foldr update initTranspile edecls | 511 | let db = foldr update initTranspile edecls |
@@ -529,6 +555,15 @@ transpile o fname incs (CTranslUnit edecls _) = do | |||
529 | 555 | ||
530 | Nothing -> putStrLn $ "??: " ++ ppShow (cleanTree d) | 556 | Nothing -> putStrLn $ "??: " ++ ppShow (cleanTree d) |
531 | putStrLn "" | 557 | putStrLn "" |
558 | let extent = getSymbolExtent sym bdy | ||
559 | cs <- readComments (posFile $ startExtent extent) | ||
560 | let (pcs,cs') = seekComment (startExtent extent) cs | ||
561 | (cs'',ds) = seekComment (stopExtent extent) cs' | ||
562 | -- lineOfComment | ||
563 | forM_ cs' $ \(_,col,cmt) -> do | ||
564 | putStrLn "" | ||
565 | putStrLn $ replicate col ' ' ++ cmt | ||
566 | print extent | ||
532 | return () | 567 | return () |
533 | 568 | ||
534 | isHeaderDecl :: CNode a => a -> Bool | 569 | isHeaderDecl :: CNode a => a -> Bool |
@@ -895,8 +930,9 @@ enumCases (CDeclExt (CDecl xs _ ni)) = do | |||
895 | lineOfComment :: (Int, b, String) -> Int | 930 | lineOfComment :: (Int, b, String) -> Int |
896 | lineOfComment (l,_,s) = l + length (lines s) | 931 | lineOfComment (l,_,s) = l + length (lines s) |
897 | 932 | ||
898 | seekComment :: NodeInfo -> [(Int,Int,String)] -> ([(Int,Int,String)],[(Int,Int,String)]) | 933 | -- Break a comment list into comments preceding the given node and comments that come after it. |
899 | seekComment ni cs = break (\c -> lineOfComment c>=posRow (posOfNode ni)) cs | 934 | seekComment :: Position -> [(Int,Int,String)] -> ([(Int,Int,String)],[(Int,Int,String)]) |
935 | seekComment pos cs = break (\c -> lineOfComment c>=posRow pos) cs | ||
900 | 936 | ||
901 | strip :: [Char] -> [Char] | 937 | strip :: [Char] -> [Char] |
902 | strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace | 938 | strip = reverse . dropWhile isSpace . reverse . dropWhile isSpace |
@@ -955,13 +991,13 @@ c2haskell opts cs cmodname missings incs (CTranslUnit edecls _) = do | |||
955 | cs <- maybe (return []) readComments symfile | 991 | cs <- maybe (return []) readComments symfile |
956 | -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ cs | 992 | -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ cs |
957 | -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ symbolSource si | 993 | -- mapM_ (hPutStrLn haskmod . commented . ppShow) $ symbolSource si |
958 | let (_,cs') = seekComment eni cs | 994 | let (_,cs') = seekComment (posOfNode eni) cs |
959 | forM_ (take 1 cs') $ \(_,c,s) -> | 995 | forM_ (take 1 cs') $ \(_,c,s) -> |
960 | when (c==1) $ hPutStr haskmod $ commented $ "| " ++ strip s | 996 | when (c==1) $ hPutStr haskmod $ commented $ "| " ++ strip s |
961 | hPutStrLn haskmod $ unwords ["newtype",t,"=",t,"CInt"] | 997 | hPutStrLn haskmod $ unwords ["newtype",t,"=",t,"CInt"] |
962 | forM_ (zip es [0..]) $ \((e,_),n) -> do | 998 | forM_ (zip es [0..]) $ \((e,_),n) -> do |
963 | let r = posRow . posOfNode . nodeInfo $ e | 999 | let r = posRow . posOfNode . nodeInfo $ e |
964 | case seekComment (nodeInfo e) cs' of | 1000 | case seekComment (posOfNode $ nodeInfo e) cs' of |
965 | (_,(lno,cno,s):_) | lno==r-1 && cno==1 | 1001 | (_,(lno,cno,s):_) | lno==r-1 && cno==1 |
966 | || cno>1 && lno == r | 1002 | || cno>1 && lno == r |
967 | -> hPutStr haskmod $ commented $ "| " ++ strip s | 1003 | -> hPutStr haskmod $ commented $ "| " ++ strip s |
@@ -1356,8 +1392,8 @@ goMissing haskmod db cfun = do | |||
1356 | htyp -> hPutStr haskmod $ commented $ "Unsupported haskell type: " ++ HS.prettyPrint htyp | 1392 | htyp -> hPutStr haskmod $ commented $ "Unsupported haskell type: " ++ HS.prettyPrint htyp |
1357 | 1393 | ||
1358 | 1394 | ||
1359 | readComments :: (Num lin, Num col) => FilePath -> IO [(lin, col, [Char])] | 1395 | readComments :: Num lin => FilePath -> IO [(lin, Int, [Char])] |
1360 | readComments fname = parseComments 1 1 <$> readFile fname | 1396 | readComments fname = grepCComments 1 1 <$> readFile fname |
1361 | 1397 | ||
1362 | sanitizeArgs :: [String] -> [String] | 1398 | sanitizeArgs :: [String] -> [String] |
1363 | sanitizeArgs (('-':'M':_):args) = sanitizeArgs args | 1399 | sanitizeArgs (('-':'M':_):args) = sanitizeArgs args |