ghc/compiler/main/GetImports.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: GetImports.hs,v 1.1 2000/11/16 15:57:05 simonmar Exp $
   3 --
   4 -- GHC Driver program
   5 --
   6 -- (c) Simon Marlow 2000
   7 --
   8 -----------------------------------------------------------------------------
   9
  10 module GetImports ( getImports ) where
  11
  12 import Module
  13 import List
  14 import Char
  15
  16 getImports :: String -> ([ModuleName], [ModuleName])
  17 getImports str
  18    = let all_imps = (nub . gmiBase . clean) str
  19          srcs     = concatMap (either unit nil) all_imps
  20          normals  = concatMap (either nil unit) all_imps
  21          unit x   = [x]
  22          nil x    = []
  23      in  (srcs, normals)
  24
  25 -- really get the imports from a de-litted, cpp'd, de-literal'd string
  26 -- Lefts are source imports.  Rights are normal ones.
  27 gmiBase :: String -> [Either ModuleName ModuleName]
  28 gmiBase s
  29    = f (words s)
  30      where
  31         f ("foreign" : "import" : ws) = f ws
  32         f ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
  33            = Left (mkMN m) : f ws
  34         f ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
  35            = Left (mkMN m) : f ws
  36         f ("import" : "qualified" : m : ws)
  37            = Right (mkMN m) : f ws
  38         f ("import" : m : ws)
  39            = Right (mkMN m) : f ws
  40         f (w:ws) = f ws
  41         f [] = []
  42
  43         mkMN str = mkModuleName (takeWhile isModId str)
  44         isModId c = isAlphaNum c || c `elem` "'_"
  45
  46 -- remove literals and comments from a string
  47 clean :: String -> String
  48 clean s
  49    = keep s
  50      where
  51         -- running through text we want to keep
  52         keep []                   = []
  53         keep ('"':cs)             = dquote cs           -- "
  54                 -- try to eliminate single quotes when they're part of
  55                 -- an identifier...
  56         keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
  57         keep ('\'':cs)            = squote cs
  58         keep ('-':'-':cs)         = linecomment cs
  59         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
  60         keep ('{':'-':cs)         = runcomment cs       -- -}
  61         keep (c:cs)               = c : keep cs
  62
  63         -- in a double-quoted string
  64         dquote []             = []
  65         dquote ('\\':'\"':cs) = dquote cs               -- "
  66         dquote ('\\':'\\':cs) = dquote cs
  67         dquote ('\"':cs)      = keep cs                 -- "
  68         dquote (c:cs)         = dquote cs
  69
  70         -- in a single-quoted string
  71         squote []             = []
  72         squote ('\\':'\'':cs) = squote cs
  73         squote ('\\':'\\':cs) = squote cs
  74         squote ('\'':cs)      = keep cs
  75         squote (c:cs)         = squote cs
  76
  77         -- in a line comment
  78         linecomment []        = []
  79         linecomment ('\n':cs) = '\n':keep cs
  80         linecomment (c:cs)    = linecomment cs
  81
  82         -- in a running comment
  83         runcomment []           = []
  84         runcomment ('-':'}':cs) = keep cs
  85         runcomment (c:cs)       = runcomment cs