diff options
Diffstat (limited to 'compiler/ghci')
| -rw-r--r-- | compiler/ghci/ByteCodeGen.lhs | 8 | ||||
| -rw-r--r-- | compiler/ghci/Linker.lhs | 3 | ||||
| -rw-r--r-- | compiler/ghci/RtClosureInspect.hs | 10 |
3 files changed, 12 insertions, 9 deletions
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs index 5d1bd27ca8..90931cc973 100644 --- a/compiler/ghci/ByteCodeGen.lhs +++ b/compiler/ghci/ByteCodeGen.lhs @@ -250,7 +250,7 @@ schemeR fvs (nm, rhs) {- | trace (showSDoc ( (char ' ' - $$ (ppr.filter (not.isTyVar).varSetElems.fst) rhs + $$ (ppr.filter (not.isTyCoVar).varSetElems.fst) rhs $$ pprCoreExpr (deAnnotate rhs) $$ char ' ' ))) False @@ -834,7 +834,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple rhs_code <- schemeE (d_alts+size) s p' rhs return (my_discr alt, unitOL (UNPACK size) `appOL` rhs_code) where - real_bndrs = filter (not.isTyVar) bndrs + real_bndrs = filter (not.isTyCoVar) bndrs my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) @@ -1146,6 +1146,8 @@ maybe_getCCallReturnRep fn_ty -- if it was, it would be impossible -- to create a valid return value -- placeholder on the stack + + blargh :: a -- Used at more than one type blargh = pprPanic "maybe_getCCallReturn: can't handle:" (pprType fn_ty) in @@ -1455,7 +1457,7 @@ bcView :: AnnExpr' Var ann -> Maybe (AnnExpr' Var ann) -- whereas value lambdas cannot; that is why they are nuked here bcView (AnnNote _ (_,e)) = Just e bcView (AnnCast (_,e) _) = Just e -bcView (AnnLam v (_,e)) | isTyVar v = Just e +bcView (AnnLam v (_,e)) | isTyCoVar v = Just e bcView (AnnApp (_,e) (_, AnnType _)) = Just e bcView _ = Nothing diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index 45cbdc095f..d53d2477e6 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -633,6 +633,7 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods text "module" <+> ppr mod <+> text "cannot be linked; it is only available as a boot module"))) + no_obj :: Outputable a => a -> IO b no_obj mod = dieWith span $ ptext (sLit "cannot find object file for module ") <> quotes (ppr mod) $$ @@ -657,7 +658,7 @@ getLinkDeps hsc_env hpt pls maybe_normal_osuf span mods -- ...and then find the linkable for it mb_lnk <- findObjectLinkableMaybe mod loc ; case mb_lnk of { - Nothing -> no_obj mod ; + Nothing -> no_obj mod ; Just lnk -> adjust_linkable lnk }} diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index a23d355ecf..fa167e32ba 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -569,13 +569,13 @@ liftTcM :: TcM a -> TR a liftTcM = id newVar :: Kind -> TR TcType -newVar = liftTcM . liftM mkTyVarTy . newBoxyTyVar +newVar = liftTcM . newFlexiTyVarTy -- | Returns the instantiated type scheme ty', and the substitution sigma -- such that sigma(ty') = ty instScheme :: Type -> TR (TcType, TvSubst) instScheme ty = liftTcM$ do - (tvs, _, _) <- tcInstType return ty + (tvs, _, _) <- tcInstType return ty (tvs',_,ty') <- tcInstType (mapM tcInstTyVar) ty return (ty', zipTopTvSubst tvs' (mkTyVarTys tvs)) @@ -590,7 +590,7 @@ addConstraint actual expected = do recoverTR (traceTR $ fsep [text "Failed to unify", ppr actual, text "with", ppr expected]) (congruenceNewtypes actual expected >>= - (getLIE . uncurry boxyUnify) >> return ()) + (getConstraints . uncurry unifyType) >> return ()) -- TOMDO: what about the coercion? -- we should consider family instances @@ -861,7 +861,7 @@ improveRTTIType hsc_env _ty rtti_ty = runTR_maybe hsc_env $ do (ty_tvs, _, _) <- tcInstType return ty (ty_tvs', _, ty') <- tcInstType (mapM tcInstTyVar) ty (_, _, rtti_ty') <- tcInstType (mapM tcInstTyVar) (sigmaType rtti_ty) - _ <- getLIE(boxyUnify rtti_ty' ty') + _ <- getConstraints(unifyType rtti_ty' ty') tvs1_contents <- zonkTcTyVars ty_tvs' let subst = (uncurry zipTopTvSubst . unzip) [(tv,ty) | (tv,ty) <- zip ty_tvs tvs1_contents @@ -1101,7 +1101,7 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs') text " in presence of newtype evidence " <> ppr new_tycon) vars <- mapM (newVar . tyVarKind) (tyConTyVars new_tycon) let ty' = mkTyConApp new_tycon vars - _ <- liftTcM (boxyUnify ty (repType ty')) + _ <- liftTcM (unifyType ty (repType ty')) -- assumes that reptype doesn't ^^^^ touch tyconApp args return ty' |