Commit 658e99a8 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Recover gracefully from a Template Haskell programmers error

If a TH programmer uses a type constructor as a data constructor,
GHC simply crashed.  This commit makes it report the error in a
graceful way.
parent 284e6b50
......@@ -201,11 +201,9 @@ isExact_maybe other = Nothing
\begin{code}
instance Outputable RdrName where
ppr (Exact name) = ppr name
ppr (Unqual occ) = ppr occ <+> ppr_name_space occ
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
ppr_name_space occ = ifPprDebug (parens (pprNonVarNameSpace (occNameSpace occ)))
ppr (Unqual occ) = ppr occ
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
ppr (Orig mod occ) = ppr mod <> dot <> ppr occ
instance OutputableBndr RdrName where
pprBndr _ n
......
......@@ -11,7 +11,7 @@ module TcEnv(
tcExtendGlobalEnv,
tcExtendGlobalValEnv,
tcLookupLocatedGlobal, tcLookupGlobal,
tcLookupGlobalId, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
tcLookupLocatedClass,
......@@ -121,16 +121,19 @@ tcLookupGlobal name
tcImportDecl name -- Go find it in an interface
}}}}}
tcLookupGlobalId :: Name -> TcM Id
-- Never used for Haskell-source DataCons, hence no ADataCon case
tcLookupGlobalId name
tcLookupField :: Name -> TcM Id -- Returns the selector Id
tcLookupField name
= tcLookupGlobal name `thenM` \ thing ->
return (tyThingId thing)
case thing of
AnId id -> return id
other -> wrongThingErr "field name" (AGlobal thing) name
tcLookupDataCon :: Name -> TcM DataCon
tcLookupDataCon con_name
= tcLookupGlobal con_name `thenM` \ thing ->
return (tyThingDataCon thing)
tcLookupDataCon name
= tcLookupGlobal name `thenM` \ thing ->
case thing of
ADataCon con -> return con
other -> wrongThingErr "data constructor" (AGlobal thing) name
tcLookupClass :: Name -> TcM Class
tcLookupClass name
......
......@@ -32,9 +32,7 @@ import BasicTypes ( Arity, isMarkedStrict )
import Inst ( newMethodFromName, newIPDict, instToId,
newDicts, newMethodWithGivenTy, tcInstStupidTheta )
import TcBinds ( tcLocalBinds )
import TcEnv ( tcLookup, tcLookupId,
tcLookupDataCon, tcLookupGlobalId
)
import TcEnv ( tcLookup, tcLookupId, tcLookupDataCon, tcLookupField )
import TcArrows ( tcProc )
import TcMatches ( tcMatchesCase, tcMatchLambda, tcDoStmts, TcMatchCtxt(..) )
import TcHsType ( tcHsSigType, UserTypeCtxt(..) )
......@@ -394,7 +392,7 @@ tcExpr expr@(RecordUpd record_expr rbinds _ _) res_ty
let
field_names = map fst rbinds
in
mappM (tcLookupGlobalId.unLoc) field_names `thenM` \ sel_ids ->
mappM (tcLookupField . unLoc) field_names `thenM` \ sel_ids ->
-- The renamer has already checked that they
-- are all in scope
let
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment