summaryrefslogtreecommitdiff
path: root/compiler/ghci
diff options
context:
space:
mode:
authorsimonpj@microsoft.com <unknown>2010-09-13 09:50:48 +0000
committersimonpj@microsoft.com <unknown>2010-09-13 09:50:48 +0000
commitd2ce0f52d42edf32bb9f13796e6ba6edba8bd516 (patch)
tree1a0792f7eb186fa3d71a02f4a21da3daae3466bb /compiler/ghci
parent0084ab49ab3c0123c4b7f9523d092af45bccfd41 (diff)
downloadhaskell-d2ce0f52d42edf32bb9f13796e6ba6edba8bd516.tar.gz
Super-monster patch implementing the new typechecker -- at last
This major patch implements the new OutsideIn constraint solving algorithm in the typecheker, following our JFP paper "Modular type inference with local assumptions". Done with major help from Dimitrios Vytiniotis and Brent Yorgey.
Diffstat (limited to 'compiler/ghci')
-rw-r--r--compiler/ghci/ByteCodeGen.lhs8
-rw-r--r--compiler/ghci/Linker.lhs3
-rw-r--r--compiler/ghci/RtClosureInspect.hs10
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'