ghc/compiler/main/GetImports.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: GetImports.hs,v 1.5 2001/04/20 10:42:46 sewardj 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
  17 getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
  18 getImports s
  19    = case f [{-accum source imports-}] [{-accum normal imports-}]
  20           Nothing (clean s) of
  21         (si, ni, Nothing) -> (si, ni, mkModuleName "Main")
  22         (si, ni, Just me) -> (si, ni, me)
  23      where
  24         -- Only pick up the name following 'module' the first time.
  25         -- Otherwise, we would be fooled by 'module Me ( module Wrong )'
  26         -- and conclude that the module name is Wrong instead of Me.
  27         f si ni old_me  ("eludom" : me : ws)
  28            = case old_me of
  29                 Nothing -> f si ni (Just (mkMN me)) ws
  30                 Just _  -> f si ni old_me ws
  31
  32         f si ni me ("ngierof" : "tropmi" : ws) = f si ni me ws
  33         f si ni me ("tropmi" : "#-{" : "ECRUOS" : "}-#" : "deifilauq" : m : ws)
  34            = f ((mkMN m):si) ni me ws
  35         f si ni me ("tropmi" : "#-{" : "ECRUOS" : "}-#" : m : ws)
  36            = f ((mkMN m):si) ni me ws
  37
  38         -- skip other contents of pragma comments
  39         f si ni me ("#-{" : ws)
  40            = f si ni me (drop 1 (dropWhile (/= "}-#") ws))
  41
  42         f si ni me ("tropmi" : "deifilauq" : m : ws)
  43            = f si ((mkMN m):ni) me ws
  44         f si ni me ("tropmi" : m : ws)
  45            = f si ((mkMN m):ni) me ws
  46         f si ni me (w:ws) = f si ni me ws
  47         f si ni me [] = (nub si, nub ni, me)
  48
  49         mkMN str = mkModuleName (takeWhile isModId (reverse str))
  50         isModId c = isAlphaNum c || c `elem` "'_"
  51
  52
  53 -- remove literals and comments from a string, producing a
  54 -- list of reversed words.
  55 clean :: String -> [String]
  56 clean s
  57    = keep "" s
  58      where
  59         -- running through text we want to keep
  60         keep acc []                   = cons acc []
  61         keep acc (c:cs) | isSpace c   = cons acc (keep "" cs)
  62
  63         keep acc ('"':cs)             = cons acc (dquote cs)            -- "
  64
  65         -- don't be fooled by single quotes which are part of an identifier
  66         keep acc (c:'\'':cs)
  67            | isAlphaNum c || c == '_' = keep ('\'':c:acc) (c:cs)
  68
  69         keep acc ('\'':cs)            = cons acc (squote cs)
  70         keep acc ('-':'-':cs)         = cons acc (linecomment cs)
  71         keep acc ('{':'-':'#':' ':cs) = cons acc (cons "#-{" (keep "" cs))
  72         keep acc ('{':'-':cs)         = cons acc (runcomment cs)        -- -}
  73         keep acc (c:cs)               = keep (c:acc) cs
  74
  75         cons [] xs = xs
  76         cons x  xs = x : xs
  77
  78         -- in a double-quoted string
  79         dquote []             = []
  80         dquote ('\\':'\"':cs) = dquote cs               -- "
  81         dquote ('\\':'\\':cs) = dquote cs
  82         dquote ('\"':cs)      = keep "" cs              -- "
  83         dquote (c:cs)         = dquote cs
  84
  85         -- in a single-quoted string
  86         squote []             = []
  87         squote ('\\':'\'':cs) = squote cs
  88         squote ('\\':'\\':cs) = squote cs
  89         squote ('\'':cs)      = keep "" cs
  90         squote (c:cs)         = squote cs
  91
  92         -- in a line comment
  93         linecomment []        = []
  94         linecomment ('\n':cs) = keep "" cs
  95         linecomment (c:cs)    = linecomment cs
  96
  97         -- in a running comment
  98         runcomment []           = []
  99         runcomment ('-':'}':cs) = keep "" cs
 100         runcomment (c:cs)       = runcomment cs