[project @ 1996-06-05 06:44:31 by partain]

[ghc-hetmet.git] / ghc / compiler / rename / ParseUtils.lhs

diff --git a/ghc/compiler/rename/ParseUtils.lhs b/ghc/compiler/rename/ParseUtils.lhs
index 6701b7a..e3fde6b 100644 (file)
--- a/ghc/compiler/rename/ParseUtils.lhs
+++ b/ghc/compiler/rename/ParseUtils.lhs
@@ -8,7 +8,7 @@
 
 module ParseUtils where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import HsSyn           -- quite a bit of stuff
 import RdrHsSyn                -- oodles of synonyms
@@ -31,7 +31,12 @@ import Util          ( startsWith, isIn, panic, assertPanic )
 \end{code}
 
 \begin{code}
-type LocalVersionsMap = FiniteMap FAST_STRING Version
+type UsagesMap       = FiniteMap Module (Version, VersionsMap)
+                       -- module => its version, then to all its entities
+                       -- and their versions; "instance" is a magic entity
+                       -- representing all the instances def'd in that module
+type VersionsMap      = FiniteMap FAST_STRING Version
+                       -- Versions for things def'd in this module
 type ExportsMap       = FiniteMap FAST_STRING (RdrName, ExportFlag)
 type FixitiesMap      = FiniteMap FAST_STRING RdrNameFixityDecl
 type LocalTyDefsMap   = FiniteMap FAST_STRING RdrIfaceDecl -- for TyCon/Class
@@ -42,17 +47,19 @@ type PragmaStuff = String
 
 data ParsedIface
   = ParsedIface
-      Module           -- Module name
-      Version          -- Module version number
-      (Maybe Version)  -- Source version number
-      LocalVersionsMap  -- Local version numbers
-      ExportsMap       -- Exported names
-      (Bag Module)     -- Special instance modules
-      FixitiesMap      -- fixities of local things
-      LocalTyDefsMap   -- Local TyCon/Class names defined
-      LocalValDefsMap  -- Local value names defined
-      (Bag RdrIfaceInst)-- Local instance declarations
-      LocalPragmasMap  -- Pragmas for local names
+      Module            -- Module name
+      (Bool, Bag Module) -- From a merging of these modules; True => merging occured
+      Version           -- Module version number
+      (Maybe Version)   -- Source version number
+      UsagesMap                 -- Used when compiling this module
+      VersionsMap       -- Version numbers of things from this module
+      ExportsMap        -- Exported names
+      (Bag Module)      -- Special instance modules
+      FixitiesMap       -- fixities of local things
+      LocalTyDefsMap    -- Local TyCon/Class names defined
+      LocalValDefsMap   -- Local value names defined
+      (Bag RdrIfaceInst) -- Local instance declarations
+      LocalPragmasMap   -- Pragmas for local names
 
 -----------------------------------------------------------------
 
@@ -71,6 +78,7 @@ data RdrIfaceInst
 -----------------------------------------------------------------
 data IfaceToken
   = ITinterface                -- keywords
+  | ITusages
   | ITversions
   | ITexports
   | ITinstance_modules
@@ -220,7 +228,8 @@ mk_inst     ctxt clas mono_ty
 lexIface :: String -> [IfaceToken]
 
 lexIface str
-  = case str of
+  = _scc_ "Lexer"
+    case str of
       []    -> []
 
       -- whitespace and comments
@@ -269,8 +278,14 @@ lexIface str
        ITinteger (read num) : lexIface rest }
 
     -----------
-    is_var_sym '_' = True
-    is_var_sym c   = isAlphanum c
+    is_var_sym '_'  = True
+    is_var_sym '\'' = True
+    is_var_sym '#'  = True -- for Glasgow-extended names
+    is_var_sym c    = isAlphanum c
+
+    is_var_sym1 '\'' = False
+    is_var_sym1 '#'  = False
+    is_var_sym1 c    = is_var_sym c
 
     is_sym_sym c = c `elem` ":!#$%&*+./<=>?@\\^|-~" -- ToDo: add ISOgraphic
 
@@ -278,16 +293,17 @@ lexIface str
     lex_word str@(c:cs) -- we know we have a capital letter to start
       = -- we first try for "<module>." on the front...
        case (module_dot str) of
-         Nothing       -> lex_name Nothing  is_var_sym  str
+         Nothing       -> lex_name Nothing  (in_the_club str)  str
          Just (m,rest) -> lex_name (Just m) (in_the_club rest) rest
-           where
-             in_the_club []    = panic "lex_word:in_the_club"
-             in_the_club (c:_) | isAlpha    c = is_var_sym
-                               | is_sym_sym c = is_sym_sym
-                               | otherwise    = panic ("lex_word:in_the_club="++[c])
+      where
+       in_the_club []    = panic "lex_word:in_the_club"
+       in_the_club (c:_) | isAlpha    c = is_var_sym
+                         | c == '_'     = is_var_sym
+                         | is_sym_sym c = is_sym_sym
+                         | otherwise    = panic ("lex_word:in_the_club="++[c])
 
     module_dot (c:cs)
-      = if not (isUpper c) then
+      = if not (isUpper c) || c == '\'' then
           Nothing
        else
           case (span is_var_sym cs) of { (word, rest) ->
@@ -300,8 +316,15 @@ lexIface str
     lex_name module_dot in_the_club str
       =        case (span in_the_club str)     of { (word, rest) ->
        case (lookupFM keywordsFM word) of
-         Just xx -> ASSERT( not (maybeToBool module_dot) )
-                    xx : lexIface rest
+         Just xx -> let
+                       cont = xx : lexIface rest
+                    in
+                    case xx of
+                      ITbang -> case module_dot of
+                                  Nothing -> cont
+                                  Just  m -> ITqvarsym (Qual m SLIT("!"))
+                                             : lexIface rest
+                      _ -> cont
          Nothing -> 
            (let
                f = head word -- first char
@@ -330,6 +353,7 @@ lexIface str
     keywordsFM = listToFM [
        ("interface",    ITinterface)
 
+       ,("__usages__",         ITusages)
        ,("__versions__",       ITversions)
        ,("__exports__",                ITexports)
        ,("__instance_modules__",ITinstance_modules)
@@ -372,5 +396,5 @@ happyError ln toks = Failed (ifaceParseErr ln toks)
 -----------------------------------------------------------------
 
 ifaceParseErr ln toks sty
-  = ppCat [ppPStr SLIT("Interface-file parse error: line"), ppInt ln, ppStr "toks=", ppStr (show toks)]
+  = ppCat [ppPStr SLIT("Interface-file parse error: line"), ppInt ln, ppStr "toks=", ppStr (show (take 10 toks))]
 \end{code}