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 ( ...@@ -31,7 +31,7 @@ module OccName (
mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2, mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc, mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
mkInstTyCoOcc, mkInstTyCoOcc, mkEqPredCoOcc,
-- ** Deconstruction -- ** Deconstruction
occNameFS, occNameString, occNameSpace, occNameFS, occNameString, occNameSpace,
...@@ -445,6 +445,7 @@ mkSpecOcc = mk_simple_deriv varName "$s" ...@@ -445,6 +445,7 @@ mkSpecOcc = mk_simple_deriv varName "$s"
mkForeignExportOcc = mk_simple_deriv varName "$f" mkForeignExportOcc = mk_simple_deriv varName "$f"
mkNewTyCoOcc = mk_simple_deriv tcName ":Co" mkNewTyCoOcc = mk_simple_deriv tcName ":Co"
mkInstTyCoOcc = mk_simple_deriv tcName ":Co" -- derived from rep ty mkInstTyCoOcc = mk_simple_deriv tcName ":Co" -- derived from rep ty
mkEqPredCoOcc = mk_simple_deriv tcName "$co"
-- Generic derivable classes -- Generic derivable classes
mkGenOcc1 = mk_simple_deriv varName "$gfrom" mkGenOcc1 = mk_simple_deriv varName "$gfrom"
......
...@@ -83,7 +83,7 @@ Selection ...@@ -83,7 +83,7 @@ Selection
~~~~~~~~~ ~~~~~~~~~
\begin{code} \begin{code}
instName :: Inst -> Name instName :: Inst -> Name
instName inst = idName (instToId inst) instName inst = Var.varName (instToVar inst)
instToId :: Inst -> TcId instToId :: Inst -> TcId
instToId inst = ASSERT2( isId id, ppr inst ) id instToId inst = ASSERT2( isId id, ppr inst ) id
...@@ -329,9 +329,16 @@ mkPredName uniq loc pred_ty ...@@ -329,9 +329,16 @@ mkPredName uniq loc pred_ty
= mkInternalName uniq occ (srcSpanStart (instLocSpan loc)) = mkInternalName uniq occ (srcSpanStart (instLocSpan loc))
where where
occ = case pred_ty of occ = case pred_ty of
ClassP cls tys -> mkDictOcc (getOccName cls) ClassP cls _ -> mkDictOcc (getOccName cls)
IParam ip ty -> getOccName (ipNameName ip) IParam ip _ -> getOccName (ipNameName ip)
EqPred _ _ -> pprPanic "mkPredName" (ppr pred_ty) 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} \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