GetImports.hs 3.48 KB
Newer Older
1
-----------------------------------------------------------------------------
2
-- $Id: GetImports.hs,v 1.5 2001/04/20 10:42:46 sewardj Exp $
3
4
5
6
7
8
9
10
11
12
13
14
15
--
-- GHC Driver program
--
-- (c) Simon Marlow 2000
--
-----------------------------------------------------------------------------

module GetImports ( getImports ) where

import Module
import List
import Char

16

17
18
getImports :: String -> ([ModuleName], [ModuleName], ModuleName)
getImports s
19
20
21
22
   = case f [{-accum source imports-}] [{-accum normal imports-}] 
          Nothing (clean s) of
        (si, ni, Nothing) -> (si, ni, mkModuleName "Main")
        (si, ni, Just me) -> (si, ni, me)
23
     where
24
25
26
27
28
29
30
        -- Only pick up the name following 'module' the first time.
        -- Otherwise, we would be fooled by 'module Me ( module Wrong )'
        -- and conclude that the module name is Wrong instead of Me.
        f si ni old_me  ("eludom" : me : ws) 
           = case old_me of
                Nothing -> f si ni (Just (mkMN me)) ws
                Just _  -> f si ni old_me ws
31

32
33
	f si ni me ("ngierof" : "tropmi" : ws) = f si ni me ws
        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
39
40
41

        -- skip other contents of pragma comments
        f si ni me ("#-{" : ws)
           = f si ni me (drop 1 (dropWhile (/= "}-#") ws))

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
46
47
           = f si ((mkMN m):ni) me ws
        f si ni me (w:ws) = f si ni me ws
        f si ni me [] = (nub si, nub ni, me)
48

49
        mkMN str = mkModuleName (takeWhile isModId (reverse str))
50
51
        isModId c = isAlphaNum c || c `elem` "'_"

52
53
54
55

-- remove literals and comments from a string, producing a 
-- list of reversed words.
clean :: String -> [String]
56
clean s
57
   = keep "" s
58
59
     where
        -- 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
64

        keep acc ('"':cs)             = cons acc (dquote cs)		-- "

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
70
71
72
73
74
75
76

        keep acc ('\'':cs)            = cons acc (squote cs)
        keep acc ('-':'-':cs)         = cons acc (linecomment cs)
        keep acc ('{':'-':'#':' ':cs) = cons acc (cons "#-{" (keep "" cs))
        keep acc ('{':'-':cs)         = cons acc (runcomment cs)	-- -}
        keep acc (c:cs)               = keep (c:acc) cs

        cons [] xs = xs
        cons x  xs = x : xs
77
78
79
80
81

        -- in a double-quoted string
        dquote []             = []
        dquote ('\\':'\"':cs) = dquote cs		-- "
        dquote ('\\':'\\':cs) = dquote cs
82
        dquote ('\"':cs)      = keep "" cs		-- "
83
84
85
86
87
88
        dquote (c:cs)         = dquote cs

        -- in a single-quoted string
        squote []             = []
        squote ('\\':'\'':cs) = squote cs
        squote ('\\':'\\':cs) = squote cs
89
        squote ('\'':cs)      = keep "" cs
90
91
92
93
        squote (c:cs)         = squote cs

        -- in a line comment
        linecomment []        = []
94
        linecomment ('\n':cs) = keep "" cs
95
96
97
98
        linecomment (c:cs)    = linecomment cs

        -- in a running comment
        runcomment []           = []
99
        runcomment ('-':'}':cs) = keep "" cs
100
        runcomment (c:cs)       = runcomment cs