Commit 0aa1d46a authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

Construction of EqPred dictionaries

parent 5f8e2da0
......@@ -31,7 +31,7 @@ module OccName (
mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
mkInstTyCoOcc,
mkInstTyCoOcc, mkEqPredCoOcc,
-- ** Deconstruction
occNameFS, occNameString, occNameSpace,
......@@ -445,6 +445,7 @@ mkSpecOcc = mk_simple_deriv varName "$s"
mkForeignExportOcc = mk_simple_deriv varName "$f"
mkNewTyCoOcc = mk_simple_deriv tcName ":Co"
mkInstTyCoOcc = mk_simple_deriv tcName ":Co" -- derived from rep ty
mkEqPredCoOcc = mk_simple_deriv tcName "$co"
-- Generic derivable classes
mkGenOcc1 = mk_simple_deriv varName "$gfrom"
......
......@@ -83,7 +83,7 @@ Selection
~~~~~~~~~
\begin{code}
instName :: Inst -> Name
instName inst = idName (instToId inst)
instName inst = Var.varName (instToVar inst)
instToId :: Inst -> TcId
instToId inst = ASSERT2( isId id, ppr inst ) id
......@@ -329,9 +329,16 @@ mkPredName uniq loc pred_ty
= mkInternalName uniq occ (srcSpanStart (instLocSpan loc))
where
occ = case pred_ty of
ClassP cls tys -> mkDictOcc (getOccName cls)
IParam ip ty -> getOccName (ipNameName ip)
EqPred _ _ -> pprPanic "mkPredName" (ppr pred_ty)
ClassP cls _ -> mkDictOcc (getOccName cls)
IParam ip _ -> getOccName (ipNameName ip)
EqPred ty _ -> mkEqPredCoOcc baseOcc
where
-- we use the outermost tycon of the lhs, which must be a type
-- function, as the base name for an equality
baseOcc = case splitTyConApp_maybe ty of
Nothing ->
pprPanic "Inst.mkPredName:" (ppr ty)
Just (tc, _) -> getOccName tc
\end{code}
%************************************************************************
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment