[project @ 1996-05-01 18:36:59 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 5927136..3283794 100644 (file)
--- a/ghc/compiler/rename/ParseUtils.lhs
+++ b/ghc/compiler/rename/ParseUtils.lhs
@@ -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
@@ -45,7 +50,8 @@ data ParsedIface
       Module           -- Module name
       Version          -- Module version number
       (Maybe Version)  -- Source version number
-      LocalVersionsMap  -- Local version numbers
+      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
@@ -57,11 +63,11 @@ data ParsedIface
 -----------------------------------------------------------------
 
 data RdrIfaceDecl
-  = TypeSig    RdrName           SrcLoc RdrNameTyDecl
-  | NewTypeSig RdrName RdrName  SrcLoc RdrNameTyDecl
-  | DataSig    RdrName [RdrName] SrcLoc RdrNameTyDecl
-  | ClassSig   RdrName [RdrName] SrcLoc RdrNameClassDecl
-  | ValSig     RdrName           SrcLoc RdrNamePolyType
+  = TypeSig    RdrName                    SrcLoc RdrNameTyDecl
+  | NewTypeSig RdrName RdrName            SrcLoc RdrNameTyDecl
+  | DataSig    RdrName [RdrName] [RdrName] SrcLoc RdrNameTyDecl
+  | ClassSig   RdrName [RdrName]          SrcLoc RdrNameClassDecl
+  | ValSig     RdrName                    SrcLoc RdrNamePolyType
                                 
 data RdrIfaceInst               
   = InstSig    RdrName RdrName   SrcLoc RdrNameInstDecl
@@ -71,6 +77,7 @@ data RdrIfaceInst
 -----------------------------------------------------------------
 data IfaceToken
   = ITinterface                -- keywords
+  | ITusages
   | ITversions
   | ITexports
   | ITinstance_modules
@@ -151,14 +158,18 @@ mk_data   :: RdrNameContext
 mk_data ctxt (qtycon, tyvars) names_and_constrs
   = let
        (qconnames, constrs) = unzip names_and_constrs
-       tycon    = de_qual qtycon
-       connames = map de_qual qconnames
-       qtyvars  = map Unqual tyvars
+       qfieldnames = [] -- ToDo ...
+       tycon      = de_qual qtycon
+       connames   = map de_qual qconnames
+       fieldnames = map de_qual qfieldnames
+       qtyvars    = map Unqual tyvars
        
-       decl = DataSig qtycon qconnames mkIfaceSrcLoc (
+       decl = DataSig qtycon qconnames qfieldnames mkIfaceSrcLoc (
                TyData ctxt qtycon qtyvars constrs Nothing noDataPragmas mkIfaceSrcLoc)
     in
-    (unitFM tycon decl, listToFM [(c,decl) | c <- connames])
+    (unitFM tycon decl, listToFM [(c,decl) | c <- connames]
+                       `plusFM` 
+                       listToFM [(f,decl) | f <- fieldnames])
 
 mk_new :: RdrNameContext
        -> (RdrName, [FAST_STRING])
@@ -326,6 +337,7 @@ lexIface str
     keywordsFM = listToFM [
        ("interface",    ITinterface)
 
+       ,("__usages__",         ITusages)
        ,("__versions__",       ITversions)
        ,("__exports__",                ITexports)
        ,("__instance_modules__",ITinstance_modules)