1 -----------------------------------------------------------------------------
2 -- $Id: GetImports.hs,v 1.10 2002/09/13 15:02:34 simonpj Exp $
6 -- (c) Simon Marlow 2000
8 -----------------------------------------------------------------------------
10 module GetImports ( getImportsFromFile, getImports ) where
18 -- getImportsFromFile is careful to close the file afterwards, otherwise
19 -- we can end up with a large number of open handles before the garbage
20 -- collector gets around to closing them.
21 getImportsFromFile :: String -> IO ([ModuleName], [ModuleName], ModuleName)
22 getImportsFromFile filename
23 = do hdl <- openFile filename ReadMode
24 modsrc <- hGetContents hdl
25 let (srcimps,imps,mod_name) = getImports modsrc
26 length srcimps `seq` length imps `seq` return ()
28 return (srcimps,imps,mod_name)
30 getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
32 = case f [{-accum source imports-}] [{-accum normal imports-}]
34 (si, ni, Nothing) -> (si, ni, mkModuleName "Main")
35 (si, ni, Just me) -> (si, ni, me)
37 -- Only pick up the name following 'module' the first time.
38 -- Otherwise, we would be fooled by 'module Me ( module Wrong )'
39 -- and conclude that the module name is Wrong instead of Me.
40 f si ni old_me ("eludom" : me : ws)
42 Nothing -> f si ni (Just (mkMN me)) ws
43 Just _ -> f si ni old_me ws
45 f si ni me ("ngierof" : "tropmi" : ws) = f si ni me ws
46 f si ni me ("tropmi" : "#-{" : "ECRUOS" : "}-#" : "deifilauq" : m : ws)
47 = f ((mkMN m):si) ni me ws
48 f si ni me ("tropmi" : "#-{" : "ECRUOS" : "}-#" : m : ws)
49 = f ((mkMN m):si) ni me ws
51 -- skip other contents of pragma comments
52 f si ni me ("#-{" : ws)
53 = f si ni me (drop 1 (dropWhile (/= "}-#") ws))
55 f si ni me ("tropmi" : "deifilauq" : m : ws)
56 = f si ((mkMN m):ni) me ws
57 f si ni me ("tropmi" : m : ws)
58 = f si ((mkMN m):ni) me ws
59 f si ni me (w:ws) = f si ni me ws
60 f si ni me [] = (nub si, nub ni, me)
62 mkMN str = mkModuleName (takeWhile isModId (reverse str))
63 isModId c = isAlphaNum c || c `elem` "'._"
66 -- remove literals and comments from a string, producing a
67 -- list of reversed words.
68 clean :: String -> [String]
72 -- running through text we want to keep
73 keep acc [] = cons acc []
74 keep acc (c:cs) | isSpace c = cons acc (keep "" cs)
76 keep acc ('"':cs) = cons acc (dquote cs) -- "
78 -- don't be fooled by single quotes which are part of an identifier
80 | isAlphaNum c || c == '_' = keep ('\'':c:acc) (c:cs)
82 keep acc ('\'':cs) = cons acc (squote cs)
83 keep acc ('-':'-':cs) = cons acc (linecomment cs)
84 keep acc ('{':'-':'#':' ':cs) = cons acc (cons "#-{" (keep "" cs))
85 keep acc ('{':'-':cs) = cons acc (runcomment (0::Int) cs) -- -}
86 keep acc ('{':cs) = cons acc (keep "" cs)
87 keep acc (';':cs) = cons acc (keep "" cs)
88 -- treat ';' and '{' as word separators so that stuff
89 -- like "{import A;" and ";;;;import B;" are handled correctly.
90 keep acc (c:cs) = keep (c:acc) cs
95 -- in a double-quoted string
97 dquote ('\\':'\"':cs) = dquote cs -- "
98 dquote ('\\':'\\':cs) = dquote cs
99 dquote ('\"':cs) = keep "" cs -- "
100 dquote (c:cs) = dquote cs
102 -- in a single-quoted string
104 squote ('\\':'\'':cs) = squote cs
105 squote ('\\':'\\':cs) = squote cs
106 squote ('\'':cs) = keep "" cs
107 squote (c:cs) = squote cs
111 linecomment ('\n':cs) = keep "" cs
112 linecomment (c:cs) = linecomment cs
114 -- in a running comment
116 runcomment n ('{':'-':cs) = runcomment (n+1) cs -- catches both nested comments and pragmas.
117 runcomment n ('-':'}':cs)
118 | n == 0 = keep "" cs
119 | otherwise = runcomment (n-1) cs
120 runcomment n (c:cs) = runcomment n cs