X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FParseUtils.lhs;h=e3fde6b2ac8076d737106b43d9205a62383eca6e;hb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;hp=6701b7a3f44be9f4029c5ef5b00530addf26fe9f;hpb=4250d64191132fd493985549eda5ca05b82a663f;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/ParseUtils.lhs b/ghc/compiler/rename/ParseUtils.lhs
index 6701b7a..e3fde6b 100644
--- 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}