----------------------------------------------------------------------------- -- | -- Module : Position -- Copyright : 2000-2004 Malcolm Wallace -- Licence : LGPL -- -- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk> -- Stability : experimental -- Portability : All -- -- Simple file position information, with recursive inclusion points. ----------------------------------------------------------------------------- module Language.Preprocessor.Cpphs.Position ( Posn(..) , newfile , addcol, newline, tab, newlines, newpos , cppline, haskline, cpp2hask , filename, lineno, directory , cleanPath ) where import Data.List (isPrefixOf) -- | Source positions contain a filename, line, column, and an -- inclusion point, which is itself another source position, -- recursively. data Posn = Pn String !Int !Int (Maybe Posn) deriving (Eq) instance Show Posn where showsPrec _ (Pn f l c i) = showString f . showString " at line " . shows l . showString " col " . shows c . ( case i of Nothing -> id Just p -> showString "\n used by " . shows p ) -- | Constructor. Argument is filename. newfile :: String -> Posn newfile name = Pn (cleanPath name) 1 1 Nothing -- | Increment column number by given quantity. addcol :: Int -> Posn -> Posn addcol n (Pn f r c i) = Pn f r (c+n) i -- | Increment row number, reset column to 1. newline :: Posn -> Posn --newline (Pn f r _ i) = Pn f (r+1) 1 i newline (Pn f r _ i) = let r' = r+1 in r' `seq` Pn f r' 1 i -- | Increment column number, tab stops are every 8 chars. tab :: Posn -> Posn tab (Pn f r c i) = Pn f r (((c`div`8)+1)*8) i -- | Increment row number by given quantity. newlines :: Int -> Posn -> Posn newlines n (Pn f r _ i) = Pn f (r+n) 1 i -- | Update position with a new row, and possible filename. newpos :: Int -> Maybe String -> Posn -> Posn newpos r Nothing (Pn f _ c i) = Pn f r c i newpos r (Just ('"':f)) (Pn _ _ c i) = Pn (init f) r c i newpos r (Just f) (Pn _ _ c i) = Pn f r c i -- | Project the line number. lineno :: Posn -> Int -- | Project the filename. filename :: Posn -> String -- | Project the directory of the filename. directory :: Posn -> FilePath lineno (Pn _ r _ _) = r filename (Pn f _ _ _) = f directory (Pn f _ _ _) = dirname f -- | cpp-style printing of file position cppline :: Posn -> String cppline (Pn f r _ _) = "#line "++show r++" "++show f -- | haskell-style printing of file position haskline :: Posn -> String haskline (Pn f r _ _) = "{-# LINE "++show r++" "++show f++" #-}" -- | Conversion from a cpp-style "#line" to haskell-style pragma. cpp2hask :: String -> String cpp2hask line | "#line" `isPrefixOf` line = "{-# LINE " ++unwords (tail (words line)) ++" #-}" | otherwise = line -- | Strip non-directory suffix from file name (analogous to the shell -- command of the same name). dirname :: String -> String dirname = reverse . safetail . dropWhile (not.(`elem`"\\/")) . reverse where safetail [] = [] safetail (_:x) = x -- | Sigh. Mixing Windows filepaths with unix is bad. Make sure there is a -- canonical path separator. cleanPath :: FilePath -> FilePath cleanPath [] = [] cleanPath ('\\':cs) = '/': cleanPath cs cleanPath (c:cs) = c: cleanPath cs