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 ...@@ -26,6 +26,7 @@ import TcRnMonad
import TcHsType import TcHsType
import TcExpr import TcExpr
import TcEnv import TcEnv
import RnEnv
import FamInst import FamInst
import FamInstEnv import FamInstEnv
...@@ -47,7 +48,6 @@ import Platform ...@@ -47,7 +48,6 @@ import Platform
import SrcLoc import SrcLoc
import Bag import Bag
import FastString import FastString
import Util
import Control.Monad import Control.Monad
\end{code} \end{code}
...@@ -99,13 +99,29 @@ normaliseFfiType' env ty0 = go [] ty0 ...@@ -99,13 +99,29 @@ normaliseFfiType' env ty0 = go [] ty0
else do newtypeOK <- do env <- getGblEnv else do newtypeOK <- do env <- getGblEnv
case tyConSingleDataCon_maybe tc of case tyConSingleDataCon_maybe tc of
Just dataCon -> 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 return False
let newtypeForeign = nameModule_maybe (tyConName tc) `elem` if newtypeOK
[Just (mkBaseModule (fsLit "Foreign.C.Types")),
Just (mkBaseModule (fsLit "System.Posix.Types"))]
if newtypeOK || newtypeForeign
then do let nt_co = mkAxInstCo (newTyConCo tc) tys then do let nt_co = mkAxInstCo (newTyConCo tc) tys
add_co nt_co rec_nts' nt_rhs add_co nt_co rec_nts' nt_rhs
else children_only else children_only
......
...@@ -84,6 +84,8 @@ import Panic ...@@ -84,6 +84,8 @@ import Panic
import Data.Char import Data.Char
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.IntMap as IM import qualified Data.IntMap as IM
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word import Data.Word
import System.IO ( Handle, stderr, stdout, hFlush ) import System.IO ( Handle, stderr, stdout, hFlush )
import System.FilePath import System.FilePath
...@@ -644,6 +646,9 @@ instance (Outputable a) => Outputable [a] where ...@@ -644,6 +646,9 @@ instance (Outputable a) => Outputable [a] where
instance (PlatformOutputable a) => PlatformOutputable [a] where instance (PlatformOutputable a) => PlatformOutputable [a] where
pprPlatform platform xs = brackets (fsep (punctuate comma (map (pprPlatform platform) xs))) 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 instance (Outputable a, Outputable b) => Outputable (a, b) where
ppr (x,y) = parens (sep [ppr x <> comma, ppr y]) ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
instance (PlatformOutputable a, PlatformOutputable b) => PlatformOutputable (a, b) where 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