diff options
Diffstat (limited to 'compiler/iface/TcIface.hs')
| -rw-r--r-- | compiler/iface/TcIface.hs | 84 |
1 files changed, 24 insertions, 60 deletions
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs index 2553643525..1beae57cc7 100644 --- a/compiler/iface/TcIface.hs +++ b/compiler/iface/TcIface.hs @@ -49,7 +49,7 @@ import DataCon import PrelNames import TysWiredIn import TysPrim ( superKindTyConName ) -import BasicTypes ( strongLoopBreaker, Arity, TupleSort(..), Boxity(..) ) +import BasicTypes ( strongLoopBreaker ) import Literal import qualified Var import VarEnv @@ -643,7 +643,7 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd -- or, even if it is (module loop, perhaps) -- we'll just leave it in the non-local set where - -- This function *must* mirror exactly what Rules.roughTopNames does + -- This function *must* mirror exactly what Rules.topFreeName does -- We could have stored the ru_rough field in the iface file -- but that would be redundant, I think. -- The only wrinkle is that we must not be deceived by @@ -652,7 +652,6 @@ tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bnd -- to write them out in coreRuleToIfaceRule ifTopFreeName :: IfaceExpr -> Maybe Name ifTopFreeName (IfaceType (IfaceTyConApp tc _ )) = Just (ifaceTyConName tc) - ifTopFreeName (IfaceType (IfaceTupleTy s _ ts)) = Just (tupleTyConName s (length (tcArgsIfaceTypes ts))) ifTopFreeName (IfaceApp f _) = ifTopFreeName f ifTopFreeName (IfaceExt n) = Just n ifTopFreeName _ = Nothing @@ -806,7 +805,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo -- name is not a tycon => internal inconsistency Just _ -> notATyConErr -- tycon is external - Nothing -> tcIfaceTyConByName name + Nothing -> tcIfaceTyCon (IfaceTc name) } notATyConErr = pprPanic "TcIface.tcIfaceVectInfo: not a tycon" (ppr name) @@ -825,7 +824,6 @@ tcIfaceType (IfaceAppTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceT tcIfaceType (IfaceLitTy l) = do { l1 <- tcIfaceTyLit l; return (LitTy l1) } tcIfaceType (IfaceFunTy t1 t2) = tcIfaceTypeFun t1 t2 tcIfaceType (IfaceDFunTy t1 t2) = tcIfaceTypeFun t1 t2 -tcIfaceType (IfaceTupleTy s i tks) = tcIfaceTupleTy s i tks tcIfaceType (IfaceTyConApp tc tks) = do { tc' <- tcIfaceTyCon tc ; tks' <- tcIfaceTcArgs tks ; return (mkTyConApp tc' tks') } @@ -844,34 +842,6 @@ tcIfaceKind k = tcIfaceType k tcIfaceKindFun :: IfaceKind -> IfaceKind -> IfL Type tcIfaceKindFun t1 t2 = do { t1' <- tcIfaceKind t1; t2' <- tcIfaceKind t2; return (FunTy t1' t2') } -tcIfaceTupleTy :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> IfL Type -tcIfaceTupleTy sort info args - = do { args' <- tcIfaceTcArgs args - ; let arity = length args' - ; base_tc <- tcTupleTyCon sort arity - ; case info of - NoIfaceTyConInfo - -> return (mkTyConApp base_tc args') - - IfacePromotedTyCon - | Just tc <- promotableTyCon_maybe base_tc - -> return (mkTyConApp tc args') - | otherwise - -> panic "tcIfaceTupleTy" (ppr base_tc) - - IfacePromotedDataCon - -> do { let tc = promoteDataCon (tyConSingleDataCon base_tc) - kind_args = map typeKind args' - ; return (mkTyConApp tc (kind_args ++ args')) } } - -tcTupleTyCon :: TupleSort -> Arity -> IfL TyCon -tcTupleTyCon sort arity - = case sort of - ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity) - ; return (tyThingTyCon thing) } - BoxedTuple -> return (tupleTyCon Boxed arity) - UnboxedTuple -> return (tupleTyCon Unboxed arity) - tcIfaceTcArgs :: IfaceTcArgs -> IfL [Type] tcIfaceTcArgs args = case args of @@ -972,15 +942,15 @@ tcIfaceExpr (IfaceFCall cc ty) = do dflags <- getDynFlags return (Var (mkFCallId dflags u cc ty')) -tcIfaceExpr (IfaceTuple sort args) - = do { args' <- mapM tcIfaceExpr args - ; tc <- tcTupleTyCon sort arity - ; let con_args = map (Type . exprType) args' ++ args' - -- Put the missing type arguments back in - con_id = dataConWorkId (tyConSingleDataCon tc) - ; return (mkApps (Var con_id) con_args) } +tcIfaceExpr (IfaceTuple boxity args) = do + args' <- mapM tcIfaceExpr args + -- Put the missing type arguments back in + let con_args = map (Type . exprType) args' ++ args' + return (mkApps (Var con_id) con_args) where arity = length args + con_id = dataConWorkId (tupleCon boxity arity) + tcIfaceExpr (IfaceLam (bndr, os) body) = bindIfaceBndr bndr $ \bndr' -> @@ -1089,7 +1059,7 @@ tcIfaceLit :: Literal -> IfL Literal -- so tcIfaceLit just fills in the type. -- See Note [Integer literals] in Literal tcIfaceLit (LitInteger i _) - = do t <- tcIfaceTyConByName integerTyConName + = do t <- tcIfaceTyCon (IfaceTc integerTyConName) return (mkLitInteger i (mkTyConTy t)) tcIfaceLit lit = return lit @@ -1267,7 +1237,6 @@ tcIfaceGlobal name -- sure the instances and RULES of this thing (particularly TyCon) are loaded -- Imagine: f :: Double -> Double = do { ifCheckWiredInThing thing; return thing } - | otherwise = do { env <- getGblEnv ; case if_rec_types env of { -- Note [Tying the knot] @@ -1310,25 +1279,20 @@ tcIfaceGlobal name -- Because if M.hs also has M.hs-boot, M.T will *already be* in the HPT, but in its -- emasculated form (e.g. lacking data constructors). -tcIfaceTyConByName :: IfExtName -> IfL TyCon -tcIfaceTyConByName name - = do { thing <- tcIfaceGlobal name - ; return (tyThingTyCon thing) } - tcIfaceTyCon :: IfaceTyCon -> IfL TyCon -tcIfaceTyCon (IfaceTyCon name info) - = do { thing <- tcIfaceGlobal name - ; case info of - NoIfaceTyConInfo -> return (tyThingTyCon thing) - IfacePromotedDataCon -> return (promoteDataCon (tyThingDataCon thing)) - -- Same Name as its underlying DataCon - IfacePromotedTyCon -> return (promote_tc (tyThingTyCon thing)) } - -- Same Name as its underlying TyCon - where - promote_tc tc - | Just prom_tc <- promotableTyCon_maybe tc = prom_tc - | isSuperKind (tyConKind tc) = tc - | otherwise = pprPanic "tcIfaceTyCon" (ppr name $$ ppr tc) +tcIfaceTyCon itc + = do { + ; thing <- tcIfaceGlobal (ifaceTyConName itc) + ; case itc of + IfaceTc _ -> return $ tyThingTyCon thing + IfacePromotedDataCon _ -> return $ promoteDataCon $ tyThingDataCon thing + IfacePromotedTyCon name -> + let ktycon tc + | isSuperKind (tyConKind tc) = return tc + | Just prom_tc <- promotableTyCon_maybe tc = return prom_tc + | otherwise = pprPanic "tcIfaceTyCon" (ppr name $$ ppr thing) + in ktycon (tyThingTyCon thing) + } tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched) tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name |