ghc/compiler/main/GetImports.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: GetImports.hs,v 1.4 2000/11/20 15:54:27 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         f si ni me ("tropmi" : "deifilauq" : m : ws)
  38            = f si ((mkMN m):ni) me ws
  39         f si ni me ("tropmi" : m : ws)
  40            = f si ((mkMN m):ni) me ws
  41         f si ni me (w:ws) = f si ni me ws
  42         f si ni me [] = (nub si, nub ni, me)
  43
  44         mkMN str = mkModuleName (takeWhile isModId (reverse str))
  45         isModId c = isAlphaNum c || c `elem` "'_"
  46
  47
  48 -- remove literals and comments from a string, producing a
  49 -- list of reversed words.
  50 clean :: String -> [String]
  51 clean s
  52    = keep "" s
  53      where
  54         -- running through text we want to keep
  55         keep acc []                   = cons acc []
  56         keep acc (c:cs) | isSpace c
  57                         = cons acc (keep "" cs)
  58
  59         keep acc ('"':cs)             = cons acc (dquote cs)            -- "
  60
  61         -- try to eliminate single quotes when they're part of
  62         -- an identifier...
  63         keep acc (c:'\'':cs)
  64            | isAlphaNum c || c == '_' = keep acc (c:cs)
  65
  66         keep acc ('\'':cs)            = cons acc (squote cs)
  67         keep acc ('-':'-':cs)         = cons acc (linecomment cs)
  68         keep acc ('{':'-':'#':' ':cs) = cons acc (cons "#-{" (keep "" cs))
  69         keep acc ('{':'-':cs)         = cons acc (runcomment cs)        -- -}
  70         keep acc (c:cs)               = keep (c:acc) cs
  71
  72         cons [] xs = xs
  73         cons x  xs = x : xs
  74
  75         -- in a double-quoted string
  76         dquote []             = []
  77         dquote ('\\':'\"':cs) = dquote cs               -- "
  78         dquote ('\\':'\\':cs) = dquote cs
  79         dquote ('\"':cs)      = keep "" cs              -- "
  80         dquote (c:cs)         = dquote cs
  81
  82         -- in a single-quoted string
  83         squote []             = []
  84         squote ('\\':'\'':cs) = squote cs
  85         squote ('\\':'\\':cs) = squote cs
  86         squote ('\'':cs)      = keep "" cs
  87         squote (c:cs)         = squote cs
  88
  89         -- in a line comment
  90         linecomment []        = []
  91         linecomment ('\n':cs) = keep "" cs
  92         linecomment (c:cs)    = linecomment cs
  93
  94         -- in a running comment
  95         runcomment []           = []
  96         runcomment ('-':'}':cs) = keep "" cs
  97         runcomment (c:cs)       = runcomment cs