1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
-----------------------------------------------------------------------------
-- |
-- 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
|
