ghc/compiler/main/GetImports.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: GetImports.hs,v 1.11 2004/11/26 16:20:57 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 ([Module], [Module], Module)
  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 -> ([Module], [Module], Module)
  31 getImports s
  32    = case f [{-accum source imports-}] [{-accum normal imports-}]
  33           Nothing (clean s) of
  34         (si, ni, Nothing) -> (si, ni, mkModule "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 = mkModule (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 ('{':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
  91
  92         cons [] xs = xs
  93         cons x  xs = x : xs
  94
  95         -- in a double-quoted string
  96         dquote []             = []
  97         dquote ('\\':'\"':cs) = dquote cs               -- "
  98         dquote ('\\':'\\':cs) = dquote cs
  99         dquote ('\"':cs)      = keep "" cs              -- "
 100         dquote (c:cs)         = dquote cs
 101
 102         -- in a single-quoted string
 103         squote []             = []
 104         squote ('\\':'\'':cs) = squote cs
 105         squote ('\\':'\\':cs) = squote cs
 106         squote ('\'':cs)      = keep "" cs
 107         squote (c:cs)         = squote cs
 108
 109         -- in a line comment
 110         linecomment []        = []
 111         linecomment ('\n':cs) = keep "" cs
 112         linecomment (c:cs)    = linecomment cs
 113
 114         -- in a running comment
 115         runcomment _ []           = []
 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