[project @ 2005-05-17 08:48:28 by simonmar]

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

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index a580884..2fb2549 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -10,10 +10,10 @@ module RnEnv (
        lookupLocatedTopBndrRn, lookupTopBndrRn,
        lookupLocatedOccRn, lookupOccRn, 
        lookupLocatedGlobalOccRn, lookupGlobalOccRn,
-       lookupTopFixSigNames, lookupSrcOcc_maybe,
+       lookupLocalDataTcNames, lookupSrcOcc_maybe,
        lookupFixityRn, lookupLocatedSigOccRn, 
        lookupLocatedInstDeclBndr,
-       lookupSyntaxName, lookupSyntaxNames, lookupImportedName,
+       lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
 
        newLocalsRn, newIPNameRn,
        bindLocalNames, bindLocalNamesFV,
@@ -32,7 +32,7 @@ module RnEnv (
 
 import LoadIface       ( loadHomeInterface, loadSrcInterface )
 import IfaceEnv                ( lookupOrig, newGlobalBinder, newIPName )
-import HsSyn           ( FixitySig(..), ReboundNames, HsExpr(..), 
+import HsSyn           ( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
                          HsType(..), HsExplicitForAll(..), LHsTyVarBndr, LHsType, 
                          LSig, Sig(..), Fixity, hsLTyVarName, hsLTyVarLocNames, replaceTyVarName )
 import RdrHsSyn                ( extractHsTyRdrTyVars )
@@ -253,7 +253,7 @@ lookupGlobalOccRn rdr_name
        Nothing   -> 
 
        -- We allow qualified names on the command line to refer to 
-       -- *any* name exported by any module in scope, just as if 
+       --  *any* name exported by any module in scope, just as if 
        -- there was an "import qualified M" declaration for every 
        -- module.
    getModule           `thenM` \ mod ->
@@ -361,16 +361,21 @@ lookupQualifiedName rdr_name
 %*********************************************************
 
 \begin{code}
-lookupTopFixSigNames :: RdrName -> RnM [Name]
+lookupLocalDataTcNames :: RdrName -> RnM [Name]
 -- GHC extension: look up both the tycon and data con 
 -- for con-like things
-lookupTopFixSigNames rdr_name
+-- Complain if neither is in scope
+lookupLocalDataTcNames rdr_name
   | Just n <- isExact_maybe rdr_name   
        -- Special case for (:), which doesn't get into the GlobalRdrEnv
   = return [n] -- For this we don't need to try the tycon too
   | otherwise
   = do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
-       ; return [gre_name gre | Just gre <- mb_gres] }
+       ; case [gre_name gre | Just gre <- mb_gres] of
+           [] -> do { addErr (unknownNameErr rdr_name)
+                    ; return [] }
+           names -> return names
+    }
 
 --------------------------------
 bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
@@ -428,10 +433,10 @@ lookupFixityRn name
       --
       -- loadHomeInterface will find B.hi even if B is a hidden module,
       -- and that's what we want.
-        initIfaceTcRn (loadHomeInterface doc name)     `thenM` \ iface ->
+        loadHomeInterface doc name     `thenM` \ iface ->
        returnM (mi_fix_fn iface (nameOccName name))
   where
-    doc      = ptext SLIT("Checking fixity for") <+> ppr name
+    doc = ptext SLIT("Checking fixity for") <+> ppr name
 
 dataTcOccs :: RdrName -> [RdrName]
 -- If the input is a data constructor, return both it and a type
@@ -485,7 +490,7 @@ At the moment this just happens for
 We store the relevant Name in the HsSyn tree, in 
   * HsIntegral/HsFractional    
   * NegApp
-  * NPlusKPatIn
+  * NPlusKPat
   * HsDo
 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
 fromRationalName etc), but the renamer changes this to the appropriate user
@@ -495,21 +500,21 @@ We treat the orignal (standard) names as free-vars too, because the type checker
 checks the type of the user thing against the type of the standard thing.
 
 \begin{code}
-lookupSyntaxName :: Name                       -- The standard name
-                -> RnM (Name, FreeVars)        -- Possibly a non-standard name
+lookupSyntaxName :: Name                               -- The standard name
+                -> RnM (SyntaxExpr Name, FreeVars)     -- Possibly a non-standard name
 lookupSyntaxName std_name
   = doptM Opt_ImplicitPrelude          `thenM` \ implicit_prelude -> 
     if implicit_prelude then normal_case
     else
        -- Get the similarly named thing from the local environment
     lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
-    returnM (usr_name, unitFV usr_name)
+    returnM (HsVar usr_name, unitFV usr_name)
   where
-    normal_case = returnM (std_name, emptyFVs)
+    normal_case = returnM (HsVar std_name, emptyFVs)
 
-lookupSyntaxNames :: [Name]                            -- Standard names
-                 -> RnM (ReboundNames Name, FreeVars)  -- See comments with HsExpr.ReboundNames
-lookupSyntaxNames std_names
+lookupSyntaxTable :: [Name]                            -- Standard names
+                 -> RnM (SyntaxTable Name, FreeVars)   -- See comments with HsExpr.ReboundNames
+lookupSyntaxTable std_names
   = doptM Opt_ImplicitPrelude          `thenM` \ implicit_prelude -> 
     if implicit_prelude then normal_case 
     else
@@ -745,12 +750,11 @@ warnUnusedName (name, prov)
        -- TODO should be a proper span
   where
     (loc,msg) = case prov of
-                 Just (Imported is _) -> 
-                    ( is_loc (head is), imp_from (is_mod imp_spec) )
-                    where
-                        imp_spec = head is
-                 other -> 
-                    ( srcLocSpan (nameSrcLoc name), unused_msg )
+                 Just (Imported is)
+                       -> (is_loc imp_spec, imp_from (is_mod imp_spec))
+                       where
+                         imp_spec = head is
+                 other -> (srcLocSpan (nameSrcLoc name), unused_msg)
 
     unused_msg   = text "Defined but not used"
     imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"