ghc/compiler/main/GetImports.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: GetImports.hs,v 1.2 2000/11/17 13:33:17 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 getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
  17 getImports s
  18    = f [{-accum source imports-}] [{-accum normal imports-}]
  19        (mkModuleName "Main") (words (clean s))
  20      where
  21         f si ni _  ("module" : me : ws) = f si ni (mkModuleName me) ws
  22
  23         f si ni me ("foreign" : "import" : ws) = f si ni me ws
  24         f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : "qualified" : m : ws)
  25            = f ((mkMN m):si) ni me ws
  26         f si ni me ("import" : "{-#" : "SOURCE" : "#-}" : m : ws)
  27            = f ((mkMN m):si) ni me ws
  28         f si ni me ("import" : "qualified" : m : ws)
  29            = f si ((mkMN m):ni) me ws
  30         f si ni me ("import" : m : ws)
  31            = f si ((mkMN m):ni) me ws
  32         f si ni me (w:ws) = f si ni me ws
  33         f si ni me [] = (nub si, nub ni, me)
  34
  35         mkMN str = mkModuleName (takeWhile isModId str)
  36         isModId c = isAlphaNum c || c `elem` "'_"
  37
  38 -- remove literals and comments from a string
  39 clean :: String -> String
  40 clean s
  41    = keep s
  42      where
  43         -- running through text we want to keep
  44         keep []                   = []
  45         keep ('"':cs)             = dquote cs           -- "
  46                 -- try to eliminate single quotes when they're part of
  47                 -- an identifier...
  48         keep (c:'\'':cs) | isAlphaNum c || c == '_' = keep (dropWhile (=='\'') cs)
  49         keep ('\'':cs)            = squote cs
  50         keep ('-':'-':cs)         = linecomment cs
  51         keep ('{':'-':'#':' ':cs) = "{-# " ++ keep cs
  52         keep ('{':'-':cs)         = runcomment cs       -- -}
  53         keep (c:cs)               = c : keep cs
  54
  55         -- in a double-quoted string
  56         dquote []             = []
  57         dquote ('\\':'\"':cs) = dquote cs               -- "
  58         dquote ('\\':'\\':cs) = dquote cs
  59         dquote ('\"':cs)      = keep cs                 -- "
  60         dquote (c:cs)         = dquote cs
  61
  62         -- in a single-quoted string
  63         squote []             = []
  64         squote ('\\':'\'':cs) = squote cs
  65         squote ('\\':'\\':cs) = squote cs
  66         squote ('\'':cs)      = keep cs
  67         squote (c:cs)         = squote cs
  68
  69         -- in a line comment
  70         linecomment []        = []
  71         linecomment ('\n':cs) = '\n':keep cs
  72         linecomment (c:cs)    = linecomment cs
  73
  74         -- in a running comment
  75         runcomment []           = []
  76         runcomment ('-':'}':cs) = keep cs
  77         runcomment (c:cs)       = runcomment cs