ghc/compiler/main/GetImports.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: GetImports.hs,v 1.8 2001/06/27 11:11:03 simonmar Exp $
   3 --
   4 -- GHC Driver program
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module GetImports ( getImportsFromFile, getImports ) where
  11
  12 import Module
  13
  14 import IO
  15 import List
  16 import Char
  17
  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 ()
  27         hClose hdl
  28         return (srcimps,imps,mod_name)
  29
  30 getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
  31 getImports s
  32    = case f [{-accum source imports-}] [{-accum normal imports-}]
  33           Nothing (clean s) of
  34         (si, ni, Nothing) -> (si, ni, mkModuleName "Main")
  35         (si, ni, Just me) -> (si, ni, me)
  36      where
  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)
  41            = case old_me of
  42                 Nothing -> f si ni (Just (mkMN me)) ws
  43                 Just _  -> f si ni old_me ws
  44
  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
  50
  51         -- skip other contents of pragma comments
  52         f si ni me ("#-{" : ws)
  53            = f si ni me (drop 1 (dropWhile (/= "}-#") ws))
  54
  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)
  61
  62         mkMN str = mkModuleName (takeWhile isModId (reverse str))
  63         isModId c = isAlphaNum c || c `elem` "'._"
  64
  65
  66 -- remove literals and comments from a string, producing a
  67 -- list of reversed words.
  68 clean :: String -> [String]
  69 clean s
  70    = keep "" s
  71      where
  72         -- running through text we want to keep
  73         keep acc []                   = cons acc []
  74         keep acc (c:cs) | isSpace c   = cons acc (keep "" cs)
  75
  76         keep acc ('"':cs)             = cons acc (dquote cs)            -- "
  77
  78         -- don't be fooled by single quotes which are part of an identifier
  79         keep acc (c:'\'':cs)
  80            | isAlphaNum c || c == '_' = keep ('\'':c:acc) (c:cs)
  81
  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 (c:cs)               = keep (c:acc) cs
  87
  88         cons [] xs = xs
  89         cons x  xs = x : xs
  90
  91         -- in a double-quoted string
  92         dquote []             = []
  93         dquote ('\\':'\"':cs) = dquote cs               -- "
  94         dquote ('\\':'\\':cs) = dquote cs
  95         dquote ('\"':cs)      = keep "" cs              -- "
  96         dquote (c:cs)         = dquote cs
  97
  98         -- in a single-quoted string
  99         squote []             = []
 100         squote ('\\':'\'':cs) = squote cs
 101         squote ('\\':'\\':cs) = squote cs
 102         squote ('\'':cs)      = keep "" cs
 103         squote (c:cs)         = squote cs
 104
 105         -- in a line comment
 106         linecomment []        = []
 107         linecomment ('\n':cs) = keep "" cs
 108         linecomment (c:cs)    = linecomment cs
 109
 110         -- in a running comment
 111         runcomment _ []           = []
 112         runcomment n ('{':'-':cs) = runcomment (n+1) cs -- catches both nested comments and pragmas.
 113         runcomment n ('-':'}':cs)
 114           | n == 0    = keep "" cs
 115           | otherwise = runcomment (n-1) cs
 116         runcomment n (c:cs)       = runcomment n cs