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

EqPred pretty prints as ~ and equalities without brackets

parent 0aa1d46a
...@@ -971,8 +971,13 @@ ctype :: { LHsType RdrName } ...@@ -971,8 +971,13 @@ ctype :: { LHsType RdrName }
-- errors in ctype. The basic problem is that -- errors in ctype. The basic problem is that
-- (Eq a, Ord a) -- (Eq a, Ord a)
-- looks so much like a tuple type. We can't tell until we find the => -- looks so much like a tuple type. We can't tell until we find the =>
--
-- We have the t1 ~ t2 form here and in gentype, to permit an individual
-- equational constraint without parenthesis.
context :: { LHsContext RdrName } context :: { LHsContext RdrName }
: btype {% checkContext $1 } : btype '~' btype {% checkContext
(LL $ HsPredTy (HsEqualP $1 $3)) }
| btype {% checkContext $1 }
type :: { LHsType RdrName } type :: { LHsType RdrName }
: ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) } : ipvar '::' gentype { LL (HsPredTy (HsIParam (unLoc $1) $3)) }
...@@ -983,7 +988,7 @@ gentype :: { LHsType RdrName } ...@@ -983,7 +988,7 @@ gentype :: { LHsType RdrName }
| btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 } | btype qtyconop gentype { LL $ HsOpTy $1 $2 $3 }
| btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 } | btype tyvarop gentype { LL $ HsOpTy $1 $2 $3 }
| btype '->' ctype { LL $ HsFunTy $1 $3 } | btype '->' ctype { LL $ HsFunTy $1 $3 }
| btype '~' gentype { LL $ HsPredTy (HsEqualP $1 $3) } | btype '~' btype { LL $ HsPredTy (HsEqualP $1 $3) }
btype :: { LHsType RdrName } btype :: { LHsType RdrName }
: btype atype { LL $ HsAppTy $1 $2 } : btype atype { LL $ HsAppTy $1 $2 }
......
...@@ -232,7 +232,7 @@ Predicates are represented inside GHC by PredType: ...@@ -232,7 +232,7 @@ Predicates are represented inside GHC by PredType:
data PredType data PredType
= ClassP Class [Type] -- Class predicate = ClassP Class [Type] -- Class predicate
| IParam (IPName Name) Type -- Implicit parameter | IParam (IPName Name) Type -- Implicit parameter
| EqPred Type Type -- Equality predicate (ty1 :=: ty2) | EqPred Type Type -- Equality predicate (ty1 ~ ty2)
type ThetaType = [PredType] type ThetaType = [PredType]
\end{code} \end{code}
...@@ -251,7 +251,7 @@ represented by evidence (a dictionary, for example, of type (predRepTy p). ...@@ -251,7 +251,7 @@ represented by evidence (a dictionary, for example, of type (predRepTy p).
Note [Equality predicates] Note [Equality predicates]
~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~
forall a b. (a :=: S b) => a -> b forall a b. (a ~ S b) => a -> b
could be represented by could be represented by
ForAllTy a (ForAllTy b (FunTy (PredTy (EqPred a (S b))) ...)) ForAllTy a (ForAllTy b (FunTy (PredTy (EqPred a (S b))) ...))
OR OR
...@@ -395,7 +395,7 @@ isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindCon tc ...@@ -395,7 +395,7 @@ isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindCon tc
isLiftedTypeKind other = False isLiftedTypeKind other = False
isCoercionKind :: Kind -> Bool isCoercionKind :: Kind -> Bool
-- All coercions are of form (ty1 :=: ty2) -- All coercions are of form (ty1 ~ ty2)
-- This function is here rather than in Coercion, -- This function is here rather than in Coercion,
-- because it's used in a knot-tied way to enforce invariants in Var -- because it's used in a knot-tied way to enforce invariants in Var
isCoercionKind (NoteTy _ k) = isCoercionKind k isCoercionKind (NoteTy _ k) = isCoercionKind k
...@@ -436,7 +436,7 @@ pprParendType ty = ppr_type TyConPrec ty ...@@ -436,7 +436,7 @@ pprParendType ty = ppr_type TyConPrec ty
pprPred :: PredType -> SDoc pprPred :: PredType -> SDoc
pprPred (ClassP cls tys) = pprClassPred cls tys pprPred (ClassP cls tys) = pprClassPred cls tys
pprPred (IParam ip ty) = ppr ip <> dcolon <> pprType ty pprPred (IParam ip ty) = ppr ip <> dcolon <> pprType ty
pprPred (EqPred ty1 ty2) = sep [ppr ty1, nest 2 (ptext SLIT(":=:")), ppr ty2] pprPred (EqPred ty1 ty2) = sep [ppr ty1, nest 2 (ptext SLIT("~")), ppr ty2]
pprClassPred :: Class -> [Type] -> SDoc pprClassPred :: Class -> [Type] -> SDoc
pprClassPred clas tys = parenSymOcc (getOccName clas) (ppr clas) pprClassPred clas tys = parenSymOcc (getOccName clas) (ppr clas)
......
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