Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Alex D
GHC
Commits
8d6feaef
Commit
8d6feaef
authored
Sep 16, 2010
by
simonpj@microsoft.com
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add more location info in CoreLint
parent
6f8f947c
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
16 additions
and
10 deletions
+16
-10
compiler/coreSyn/CoreLint.lhs
compiler/coreSyn/CoreLint.lhs
+16
-10
No files found.
compiler/coreSyn/CoreLint.lhs
View file @
8d6feaef
...
...
@@ -381,7 +381,7 @@ lintValApp arg fun_ty arg_ty
\end{code}
\begin{code}
checkKinds :: Var -> OutType -> LintM ()
checkKinds ::
Out
Var -> OutType -> LintM ()
-- Both args have had substitution applied
checkKinds tyvar arg_ty
-- Arg type might be boxed for a function with an uncommitted
...
...
@@ -604,26 +604,29 @@ lintSplitCoVar cv
, nest 2 (ppr cv <+> dcolon <+> ppr (tyVarKind cv))])
-------------------
lintCoercion :: OutType -> LintM (OutType, OutType)
lintCoercion
, lintCoercion'
:: OutType -> LintM (OutType, OutType)
-- Check the kind of a coercion term, returning the kind
lintCoercion ty@(TyVarTy tv)
lintCoercion co
= addLoc (InCoercion co) $ lintCoercion' co
lintCoercion' ty@(TyVarTy tv)
= do { checkTyVarInScope tv
; if isCoVar tv then return (coVarKind tv)
else return (ty, ty) }
lintCoercion ty@(AppTy ty1 ty2)
lintCoercion
'
ty@(AppTy ty1 ty2)
= do { (s1,t1) <- lintCoercion ty1
; (s2,t2) <- lintCoercion ty2
; check_co_app ty (typeKind s1) [s2]
; return (mkAppTy s1 s2, mkAppTy t1 t2) }
lintCoercion
ty@(FunTy ty1 ty2)
lintCoercion
' ty@(FunTy ty1 ty2)
= do { (s1,t1) <- lintCoercion ty1
; (s2,t2) <- lintCoercion ty2
; check_co_app ty (tyConKind funTyCon) [s1, s2]
; return (FunTy s1 s2, FunTy t1 t2) }
lintCoercion ty@(TyConApp tc tys)
lintCoercion
'
ty@(TyConApp tc tys)
| Just (ar, desc) <- isCoercionTyCon_maybe tc
= do { unless (tys `lengthAtLeast` ar) (badCo ty)
; (s,t) <- lintCoTyConApp ty desc (take ar tys)
...
...
@@ -639,19 +642,19 @@ lintCoercion ty@(TyConApp tc tys)
; check_co_app ty (tyConKind tc) ss
; return (TyConApp tc ss, TyConApp tc ts) }
lintCoercion ty@(PredTy (ClassP cls tys))
lintCoercion
'
ty@(PredTy (ClassP cls tys))
= do { (ss,ts) <- mapAndUnzipM lintCoercion tys
; check_co_app ty (tyConKind (classTyCon cls)) ss
; return (PredTy (ClassP cls ss), PredTy (ClassP cls ts)) }
lintCoercion (PredTy (IParam n p_ty))
lintCoercion
'
(PredTy (IParam n p_ty))
= do { (s,t) <- lintCoercion p_ty
; return (PredTy (IParam n s), PredTy (IParam n t)) }
lintCoercion ty@(PredTy (EqPred {}))
lintCoercion
'
ty@(PredTy (EqPred {}))
= failWithL (badEq ty)
lintCoercion (ForAllTy tv ty)
lintCoercion
'
(ForAllTy tv ty)
| isCoVar tv
= do { (co1, co2) <- lintSplitCoVar tv
; (s1,t1) <- lintCoercion co1
...
...
@@ -848,6 +851,7 @@ data LintLocInfo
| ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which)
| TopLevelBindings
| InType Type -- Inside a type
| InCoercion Coercion -- Inside a type
\end{code}
...
...
@@ -1003,6 +1007,8 @@ dumpLoc TopLevelBindings
= (noSrcLoc, empty)
dumpLoc (InType ty)
= (noSrcLoc, text "In the type" <+> quotes (ppr ty))
dumpLoc (InCoercion ty)
= (noSrcLoc, text "In the coercion" <+> quotes (ppr ty))
pp_binders :: [Var] -> SDoc
pp_binders bs = sep (punctuate comma (map pp_binder bs))
...
...
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