diff options
author | simonpj@microsoft.com <unknown> | 2010-09-13 09:50:48 +0000 |
---|---|---|
committer | simonpj@microsoft.com <unknown> | 2010-09-13 09:50:48 +0000 |
commit | d2ce0f52d42edf32bb9f13796e6ba6edba8bd516 (patch) | |
tree | 1a0792f7eb186fa3d71a02f4a21da3daae3466bb /compiler/ghci | |
parent | 0084ab49ab3c0123c4b7f9523d092af45bccfd41 (diff) | |
download | haskell-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.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' |