Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
ac41c500
Commit
ac41c500
authored
Nov 03, 2003
by
simonpj
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[project @ 2003-11-03 16:00:57 by simonpj]
Wibbles to pretty printing of types
parent
a16253b8
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
16 additions
and
8 deletions
+16
-8
ghc/compiler/typecheck/TcType.lhs
ghc/compiler/typecheck/TcType.lhs
+3
-0
ghc/compiler/typecheck/TcUnify.lhs
ghc/compiler/typecheck/TcUnify.lhs
+4
-2
ghc/compiler/types/Type.lhs
ghc/compiler/types/Type.lhs
+1
-0
ghc/compiler/types/TypeRep.lhs
ghc/compiler/types/TypeRep.lhs
+8
-6
No files found.
ghc/compiler/typecheck/TcType.lhs
View file @
ac41c500
...
...
@@ -85,6 +85,7 @@ module TcType (
-- Rexported from Type
Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, isSuperKind,
superBoxity, liftedBoxity, hasMoreBoxityInfo, defaultKind, superKind,
isTypeKind, isAnyTypeKind, typeCon,
...
...
@@ -120,6 +121,8 @@ import Type ( -- Re-exports
tyVarsOfTheta, Kind, Type, PredType(..),
ThetaType, unliftedTypeKind, typeCon,
liftedTypeKind, openTypeKind, mkArrowKind,
isLiftedTypeKind, isUnliftedTypeKind,
isOpenTypeKind, isSuperKind,
mkArrowKinds, mkForAllTy, mkForAllTys,
defaultKind, isTypeKind, isAnyTypeKind,
mkFunTy, mkFunTys, zipFunTys,
...
...
ghc/compiler/typecheck/TcUnify.lhs
View file @
ac41c500
...
...
@@ -30,7 +30,7 @@ module TcUnify (
import HsSyn ( HsExpr(..) )
import TcHsSyn ( mkHsLet,
ExprCoFn, idCoercion, isIdCoercion, mkCoercion, (<.>), (<$>) )
import TypeRep ( Type(..), PredType(..), TyNote(..), typeCon, openKindCon )
import TypeRep ( Type(..), PredType(..), TyNote(..), typeCon, openKindCon
, isSuperKind
)
import TcRnMonad -- TcType, amongst others
import TcType ( TcKind, TcType, TcSigmaType, TcRhoType, TcTyVar, TcTauType,
...
...
@@ -43,7 +43,7 @@ import TcType ( TcKind, TcType, TcSigmaType, TcRhoType, TcTyVar, TcTauType,
isSkolemTyVar, isUserTyVar,
tidyOpenType, tidyOpenTypes, tidyOpenTyVar, tidyOpenTyVars,
eqKind, openTypeKind, liftedTypeKind, isTypeKind, mkArrowKind,
hasMoreBoxityInfo, allDistinctTyVars, pprType )
hasMoreBoxityInfo, allDistinctTyVars, pprType
, pprKind
)
import Inst ( newDicts, instToId, tcInstCall )
import TcMType ( getTcTyVar, putTcTyVar, tcInstType, newKindVar,
newTyVarTy, newTyVarTys, newOpenTypeKind,
...
...
@@ -992,6 +992,8 @@ unifyMisMatch ty1 ty2
zonkTcType ty2 `thenM` \ ty2' ->
let
(env, [tidy_ty1, tidy_ty2]) = tidyOpenTypes emptyTidyEnv [ty1',ty2']
ppr | isSuperKind (typeKind ty1) = pprKind
| otherwise = pprType
msg = hang (ptext SLIT("Couldn't match"))
4 (sep [quotes (ppr tidy_ty1),
ptext SLIT("against"),
...
...
ghc/compiler/types/Type.lhs
View file @
ac41c500
...
...
@@ -15,6 +15,7 @@ module Type (
openKindCon, -- :: KX
typeCon, -- :: BX -> KX
liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX
isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, isSuperKind,
mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
isTypeKind, isAnyTypeKind,
funTyCon,
...
...
ghc/compiler/types/TypeRep.lhs
View file @
ac41c500
...
...
@@ -17,7 +17,7 @@ module TypeRep (
openKindCon, -- :: KX
typeCon, -- :: BX -> KX
liftedTypeKind, unliftedTypeKind, openTypeKind, -- :: KX
isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind,
isSuperKind,
mkArrowKind, mkArrowKinds, -- :: KX -> KX -> KX
funTyCon,
...
...
@@ -362,7 +362,7 @@ isOpenTypeKind (TyConApp tc []) = tyConName tc == openKindConName
isOpenTypeKind other = False
isSuperKind (TyConApp tc []) = tyConName tc == superKindName
isSuper
Type
Kind other = False
isSuperKind other = False
\end{code}
------------------------------------------
...
...
@@ -522,11 +522,13 @@ ppr_type p ty@(ForAllTy _ _)
(tvs, rho) = split1 [] ty
(ctxt, tau) = split2 [] rho
split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
split1 tvs ty = (reverse tvs, ty)
split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
split1 tvs (NoteTy (FTVNote _) ty) = split1 tvs ty
split1 tvs ty = (reverse tvs, ty)
split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty
split2 ps ty = (reverse ps, ty)
split2 ps (PredTy p `FunTy` ty) = split2 (p:ps) ty
split2 ps (NoteTy (FTVNote _) ty) = split2 ps ty
split2 ps ty = (reverse ps, ty)
ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
ppr_tc_app p tc []
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment