Refactor SrcLoc and SrcSpan

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

diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 97f4ab3..b333373 100644 (file)
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -12,7 +12,7 @@ module RnEnv (
        lookupLocalDataTcNames, lookupSigOccRn,
        lookupFixityRn, lookupTyFixityRn, 
        lookupInstDeclBndr, lookupSubBndr, lookupConstructorFields,
-       lookupSyntaxName, lookupSyntaxTable, 
+       lookupSyntaxName, lookupSyntaxTable, lookupIfThenElse,
        lookupGreRn, lookupGreLocalRn, lookupGreRn_maybe,
        getLookupOccRn, addUsedRdrNames,
 
@@ -754,6 +754,17 @@ 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}
+lookupIfThenElse :: RnM (Maybe (SyntaxExpr Name), FreeVars)
+-- Different to lookupSyntaxName because in the non-rebindable
+-- case we desugar directly rather than calling an existing function
+-- Hence the (Maybe (SyntaxExpr Name)) return type
+lookupIfThenElse 
+  = do { rebind <- xoptM Opt_RebindableSyntax
+       ; if not rebind 
+         then return (Nothing, emptyFVs)
+         else do { ite <- lookupOccRn (mkVarUnqual (fsLit "ifThenElse"))
+                 ; return (Just (HsVar ite), unitFV ite) } }
+
 lookupSyntaxName :: Name                               -- The standard name
                 -> RnM (SyntaxExpr Name, FreeVars)     -- Possibly a non-standard name
 lookupSyntaxName std_name
@@ -1042,7 +1053,11 @@ unknownNameSuggestErr where_look tried_rdr_name
   where
     pp_item :: (RdrName, HowInScope) -> SDoc
     pp_item (rdr, Left loc) = quotes (ppr rdr) <+>   -- Locally defined
-                              parens (ptext (sLit "line") <+> int (srcSpanStartLine loc))
+                              parens (ptext (sLit "line") <+> int (srcSpanStartLine loc'))
+        where loc' = case loc of
+                     UnhelpfulSpan _ ->
+                         panic "unknownNameSuggestErr UnhelpfulSpan"
+                     RealSrcSpan l -> l
     pp_item (rdr, Right is) = quotes (ppr rdr) <+>   -- Imported
                               parens (ptext (sLit "imported from") <+> ppr (is_mod is))