%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
%
\section[TcSimplify]{TcSimplify}
#include "HsVersions.h"
module TcSimplify (
- tcSimplify, tcSimplifyAndCheck, tcSimplifyWithExtraGlobals,
+ tcSimplify, tcSimplifyAndCheck,
tcSimplifyTop, tcSimplifyThetas, tcSimplifyCheckThetas, tcSimplifyRank2,
bindInstsOfLocalFuns
) where
-import Ubiq
+IMP_Ubiq()
import HsSyn ( MonoBinds(..), HsExpr(..), InPat, OutPat, HsLit,
- Match, HsBinds, Qual, PolyType, ArithSeqInfo,
+ Match, HsBinds, Qualifier, PolyType, ArithSeqInfo,
GRHSsAndBinds, Stmt, Fake )
-import TcHsSyn ( TcIdOcc(..), TcIdBndr(..), TcExpr(..), TcMonoBinds(..) )
+import TcHsSyn ( TcIdOcc(..), SYN_IE(TcIdBndr), SYN_IE(TcExpr), SYN_IE(TcMonoBinds) )
import TcMonad hiding ( rnMtoTcM )
import Inst ( lookupInst, lookupSimpleInst,
- tyVarsOfInst, isTyVarDict, isDict, matchesInst,
- instToId, instBindingRequired, instCanBeGeneralised, newDictsAtLoc,
- Inst(..), LIE(..), zonkLIE, emptyLIE, plusLIE, unitLIE, consLIE,
- InstOrigin(..), OverloadedLit )
+ tyVarsOfInst, isTyVarDict, isDict,
+ matchesInst, instToId, instBindingRequired,
+ instCanBeGeneralised, newDictsAtLoc,
+ pprInst,
+ Inst(..), SYN_IE(LIE), zonkLIE, emptyLIE,
+ plusLIE, unitLIE, consLIE, InstOrigin(..),
+ OverloadedLit )
import TcEnv ( tcGetGlobalTyVars )
-import TcType ( TcType(..), TcTyVar(..), TcTyVarSet(..), TcMaybe, tcInstType )
+import SpecEnv ( SpecEnv )
+import TcType ( SYN_IE(TcType), SYN_IE(TcTyVar), SYN_IE(TcTyVarSet), TcMaybe, tcInstType )
import Unify ( unifyTauTy )
import Bag ( Bag, unitBag, listToBag, foldBag, filterBag, emptyBag, bagToList,
snocBag, consBag, unionBags, isEmptyBag )
-import Class ( GenClass, Class(..), ClassInstEnv(..),
+import Class ( GenClass, SYN_IE(Class), SYN_IE(ClassInstEnv),
isNumericClass, isStandardClass, isCcallishClass,
isSuperClassOf, classSuperDictSelId, classInstEnv
)
import Id ( GenId )
-import Maybes ( expectJust, firstJust, catMaybes, seqMaybe, maybeToBool, Maybe(..) )
+import Maybes ( expectJust, firstJust, catMaybes, seqMaybe, maybeToBool )
import Outputable ( Outputable(..){-instance * []-} )
-import PprStyle--ToDo:rm
-import PprType ( GenType, GenTyVar, GenClass{-instance Outputable;ToDo:rm-} )
+--import PprStyle--ToDo:rm
+import PprType ( GenType, GenTyVar )
import Pretty
import SrcLoc ( mkUnknownSrcLoc )
-import Util
-import Type ( GenType, Type(..), TauType(..), mkTyVarTy, getTyVar, eqSimpleTy,
+import Type ( GenType, SYN_IE(Type), SYN_IE(TauType), mkTyVarTy, getTyVar, eqSimpleTy,
getTyVar_maybe )
import TysWiredIn ( intTy )
-import TyVar ( GenTyVar, GenTyVarSet(..),
+import TyVar ( GenTyVar, SYN_IE(GenTyVarSet),
elementOfTyVarSet, emptyTyVarSet, unionTyVarSets,
isEmptyTyVarSet, tyVarSetToList )
import Unique ( Unique )
+import Util
\end{code}
tcSimpl False global_tvs local_tvs emptyBag wanteds
\end{code}
-@tcSimplifyWithExtraGlobals@ is just like @tcSimplify@ except that you get
-to specify some extra global type variables that the simplifer will treat
-as free in the environment.
-
-\begin{code}
-tcSimplifyWithExtraGlobals
- :: TcTyVarSet s -- Extra ``Global'' type variables
- -> TcTyVarSet s -- ``Local'' type variables
- -> LIE s -- Wanted
- -> TcM s (LIE s, -- Free
- [(TcIdOcc s,TcExpr s)], -- Bindings
- LIE s) -- Remaining wanteds; no dups
-
-tcSimplifyWithExtraGlobals extra_global_tvs local_tvs wanteds
- = tcGetGlobalTyVars `thenNF_Tc` \ global_tvs ->
- tcSimpl False
- (global_tvs `unionTyVarSets` extra_global_tvs)
- local_tvs emptyBag wanteds
-\end{code}
-
@tcSimplifyAndCheck@ is similar to the above, except that it checks
that there is an empty wanted-set at the end. It may still return
some of constant insts, which have to be resolved finally at the end.
%************************************************************************
%* *
\subsection[elimSCs]{@elimSCs@}
-%* 2 *
+%* *
%************************************************************************
\begin{code}
where
rest' = elimSCsSimple rest
(c1,t1) `subsumes` (c2,t2) = t1 `eqSimpleTy` t2 &&
- maybeToBool (c2 `isSuperClassOf` c1)
+ (c1 == c2 || maybeToBool (c2 `isSuperClassOf` c1))
+-- We deal with duplicates here ^^^^^^^^
+-- It's a simple place to do it, although it's done in elimTyCons in the
+-- full-blown version of the simpifier.
\end{code}
%************************************************************************
\end{verbatim}
Since we're not using the result of @foo@, the result if (presumably)
@void@.
-WDP Comment: no such thing as voidTy; so not quite in yet (94/07).
-SLPJ comment: since
\begin{code}
disambigOne :: [SimpleDictInfo s] -> TcM s ()
-- See if any default works, and if so bind the type variable to it
try_default default_tys `thenTc` \ chosen_default_ty ->
tcInstType [] chosen_default_ty `thenNF_Tc` \ chosen_default_tc_ty -> -- Tiresome!
- unifyTauTy (mkTyVarTy tyvar) chosen_default_tc_ty
+ unifyTauTy chosen_default_tc_ty (mkTyVarTy tyvar)
where
(_,_,tyvar) = head dict_infos -- Should be non-empty
\begin{code}
ambigErr insts sty
- = ppHang (ppStr "Ambiguous overloading")
- 4 (ppAboves (map (ppr sty) insts))
+ = ppAboves (map (pprInst sty "Ambiguous overloading") insts)
\end{code}
@reduceErr@ complains if we can't express required dictionaries in
\begin{code}
reduceErr insts sty
- = ppHang (ppStr "Type signature lacks context required by inferred type")
- 4 (ppHang (ppStr "Context reqd: ")
- 4 (ppAboves (map (ppr sty) (bagToList insts)))
- )
+ = ppAboves (map (pprInst sty "Context required by inferred type, but missing on a type signature")
+ (bagToList insts))
\end{code}
\begin{code}
= ppHang (ppStr "Ambiguously-overloaded types could not be resolved:")
4 (ppAboves [
ppHang (ppStr "Conflicting:")
- 4 (ppInterleave ppSemi (map (ppr sty) dicts)),
+ 4 (ppInterleave ppSemi (map (pprInst sty ""{-???-}) dicts)),
ppHang (ppStr "Defaulting types :")
4 (ppr sty defaulting_tys),
ppStr "([Int, Double] is the default list of defaulting types.)" ])
projects / ghc-hetmet.git / blobdiff