Commit fb83cd02 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Finish fixing #5529: Require that constructors are imported from all types

We used to have a hack for Foreign.C.Types and System.Posix.Types,
but I've removed that now. We also mark any constructors that we look
through as "used", so that we don't get warnings about unused imports.
parent 1269e055
......@@ -26,6 +26,7 @@ import TcRnMonad
import TcHsType
import TcExpr
import TcEnv
import RnEnv
import FamInst
import FamInstEnv
......@@ -47,7 +48,6 @@ import Platform
import SrcLoc
import Bag
import FastString
import Util
import Control.Monad
\end{code}
......@@ -99,13 +99,29 @@ normaliseFfiType' env ty0 = go [] ty0
else do newtypeOK <- do env <- getGblEnv
case tyConSingleDataCon_maybe tc of
Just dataCon ->
return $ notNull $ lookupGRE_Name (tcg_rdr_env env) $ dataConName dataCon
case lookupGRE_Name (tcg_rdr_env env) $ dataConName dataCon of
[gre] ->
do -- If we look through a newtype constructor, then we need it to be in scope.
-- But if this is the only use if that import then we'll get an unused import
-- warning, so we need to mark a valid RdrName for it as used.
case gre_prov gre of
Imported (is : _) ->
do let modName = is_as (is_decl is)
occName = nameOccName (dataConName dataCon)
rdrName = mkRdrQual modName occName
addUsedRdrNames [rdrName]
Imported [] ->
panic "normaliseFfiType': Imported []"
LocalDef ->
return ()
return True
[] ->
return False
_ ->
panic "normaliseFfiType': Got more GREs than expected"
_ ->
return False
let newtypeForeign = nameModule_maybe (tyConName tc) `elem`
[Just (mkBaseModule (fsLit "Foreign.C.Types")),
Just (mkBaseModule (fsLit "System.Posix.Types"))]
if newtypeOK || newtypeForeign
if newtypeOK
then do let nt_co = mkAxInstCo (newTyConCo tc) tys
add_co nt_co rec_nts' nt_rhs
else children_only
......
......@@ -84,6 +84,8 @@ import Panic
import Data.Char
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word
import System.IO ( Handle, stderr, stdout, hFlush )
import System.FilePath
......@@ -644,6 +646,9 @@ instance (Outputable a) => Outputable [a] where
instance (PlatformOutputable a) => PlatformOutputable [a] where
pprPlatform platform xs = brackets (fsep (punctuate comma (map (pprPlatform platform) xs)))
instance (Outputable a) => Outputable (Set a) where
ppr s = braces (fsep (punctuate comma (map ppr (Set.toList s))))
instance (Outputable a, Outputable b) => Outputable (a, b) where
ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
instance (PlatformOutputable a, PlatformOutputable b) => PlatformOutputable (a, b) where
......
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