Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
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
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issues
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
Shayne Fletcher
Glasgow Haskell Compiler
Commits
8dc6da83
Commit
8dc6da83
authored
Nov 24, 2015
by
Simon Peyton Jones
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Comments only
parent
8c5fe53b
Changes
1
Hide whitespace changes
Inline
Sidebyside
Showing
1 changed file
with
31 additions
and
13 deletions
+31
13
compiler/typecheck/TcSMonad.hs
compiler/typecheck/TcSMonad.hs
+31
13
No files found.
compiler/typecheck/TcSMonad.hs
View file @
8dc6da83
...
@@ 714,7 +714,10 @@ Note that inertness is not the same as idempotence. To apply S to a
...
@@ 714,7 +714,10 @@ Note that inertness is not the same as idempotence. To apply S to a
type, you may have to apply it recursive. But inertness does
type, you may have to apply it recursive. But inertness does
guarantee that this recursive use will terminate.
guarantee that this recursive use will terminate.
 The main theorem 
Note [Extending the inert equalities]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This is the main theorem!
Suppose we have a "work item"
Suppose we have a "work item"
a fw> t
a fw> t
and an inert generalised substitution S,
and an inert generalised substitution S,
...
@@ 724,6 +727,9 @@ guarantee that this recursive use will terminate.
...
@@ 724,6 +727,9 @@ guarantee that this recursive use will terminate.
(T3) a not in t  No occurs check in the work item
(T3) a not in t  No occurs check in the work item
(K1) for every (a fs> s) in S, then not (fw >= fs)
(K1) for every (a fs> s) in S, then not (fw >= fs)
Reason: the work item is fully rewritten by S, hence not (fs >= fw)
but if (fw >= fs) then the work item could rewrite
the inert item
(K2) for every (b fs> s) in S, where b /= a, then
(K2) for every (b fs> s) in S, where b /= a, then
(K2a) not (fs >= fs)
(K2a) not (fs >= fs)
...
@@ 740,11 +746,16 @@ guarantee that this recursive use will terminate.
...
@@ 740,11 +746,16 @@ guarantee that this recursive use will terminate.
then the extended substition T = S+(a fw> t)
then the extended substition T = S+(a fw> t)
is an inert generalised substitution.
is an inert generalised substitution.
Conditions (T1T3) are established by the canonicaliser
Conditions (K1K3) are established by TcSMonad.kickOutRewriteable
The idea is that
The idea is that
* (T12) are guaranteed by exhaustively rewriting the workitem
* (T12) are guaranteed by exhaustively rewriting the workitem
with S(fw,_).
with S(fw,_).
* T3 is guaranteed by a simple occurscheck on the work item.
* T3 is guaranteed by a simple occurscheck on the work item.
This is done during canonicalisation, in canEqTyVar;
(invariant: a CTyEqCan never has an occurs check).
* (K13) are the "kickout" criteria. (As stated, they are really the
* (K13) are the "kickout" criteria. (As stated, they are really the
"keep" criteria.) If the current inert S contains a triple that does
"keep" criteria.) If the current inert S contains a triple that does
...
@@ 761,6 +772,12 @@ The idea is that
...
@@ 761,6 +772,12 @@ The idea is that
us to kick out an inert wanted that mentions a, because of (K2a). This
us to kick out an inert wanted that mentions a, because of (K2a). This
is a common case, hence good not to kick out.
is a common case, hence good not to kick out.
* Lemma (L2): if not (fw >= fw), then K1K3 all hold.
Proof: using Definition [Canrewrite relation], fw can't rewrite anything
and so K1K3 hold. Intuitivel, since fw can't rewrite anything,
adding it cannot cause any loops
This is a common case, because Wanteds cannot rewrite Wanteds.
* Lemma (L1): The conditions of the Main Theorem imply that there is no
* Lemma (L1): The conditions of the Main Theorem imply that there is no
(a fs> t) in S, s.t. (fs >= fw).
(a fs> t) in S, s.t. (fs >= fw).
Proof. Suppose the contrary (fs >= fw). Then because of (T1),
Proof. Suppose the contrary (fs >= fw). Then because of (T1),
...
@@ 1304,6 +1321,7 @@ kickOutRewritable :: CtFlavourRole  Flavour and role of the equality that is
...
@@ 1304,6 +1321,7 @@ kickOutRewritable :: CtFlavourRole  Flavour and role of the equality that is
 take the substitution into account
 take the substitution into account
kickOutRewritable
new_fr
new_tv
ics
@
(
IC
{
inert_funeqs
=
funeqmap
})
kickOutRewritable
new_fr
new_tv
ics
@
(
IC
{
inert_funeqs
=
funeqmap
})

not
(
new_fr
`
eqCanRewriteFR
`
new_fr
)

not
(
new_fr
`
eqCanRewriteFR
`
new_fr
)
 Lemma (L2) in Note [Extending the inert equalities]
=
if
isFlattenTyVar
new_tv
=
if
isFlattenTyVar
new_tv
then
(
emptyWorkList
{
wl_funeqs
=
feqs_out
},
ics
{
inert_funeqs
=
feqs_in
})
then
(
emptyWorkList
{
wl_funeqs
=
feqs_out
},
ics
{
inert_funeqs
=
feqs_in
})
else
(
emptyWorkList
,
ics
)
else
(
emptyWorkList
,
ics
)
...
@@ 1356,8 +1374,8 @@ kickOutRewritable new_fr new_tv (IC { inert_eqs = tv_eqs
...
@@ 1356,8 +1374,8 @@ kickOutRewritable new_fr new_tv (IC { inert_eqs = tv_eqs
(
insols_out
,
insols_in
)
=
partitionBag
kick_out_ct
insols
(
insols_out
,
insols_in
)
=
partitionBag
kick_out_ct
insols
 Kick out even insolubles; see Note [Kick out insolubles]
 Kick out even insolubles; see Note [Kick out insolubles]
can_rewrite
::
CtEvidence
>
Bool
fr_
can_rewrite
::
CtEvidence
>
Bool
can_rewrite
=
(
new_fr
`
eqCanRewriteFR
`)
.
ctEvFlavourRole
fr_
can_rewrite
=
(
new_fr
`
eqCanRewriteFR
`)
.
ctEvFlavourRole
kick_out_ct
::
Ct
>
Bool
kick_out_ct
::
Ct
>
Bool
kick_out_ct
ct
=
kick_out_ctev
(
ctEvidence
ct
)
kick_out_ct
ct
=
kick_out_ctev
(
ctEvidence
ct
)
...
@@ 1368,12 +1386,12 @@ kickOutRewritable new_fr new_tv (IC { inert_eqs = tv_eqs
...
@@ 1368,12 +1386,12 @@ kickOutRewritable new_fr new_tv (IC { inert_eqs = tv_eqs
kick_out_fe
_
=
False
 Can't happen
kick_out_fe
_
=
False
 Can't happen
kick_out_ctev
::
CtEvidence
>
Bool
kick_out_ctev
::
CtEvidence
>
Bool
kick_out_ctev
ev
=
can_rewrite
ev
kick_out_ctev
ev
=
fr_
can_rewrite
ev
&&
new_tv
`
elemVarSet
`
tyVarsOfType
(
ctEvPred
ev
)
&&
new_tv
`
elemVarSet
`
tyVarsOfType
(
ctEvPred
ev
)
 See Note [Kicking out inert constraints]
 See Note [Kicking out inert constraints]
kick_out_irred
::
Ct
>
Bool
kick_out_irred
::
Ct
>
Bool
kick_out_irred
ct
=
can_rewrite
(
cc_ev
ct
)
kick_out_irred
ct
=
fr_
can_rewrite
(
cc_ev
ct
)
&&
new_tv
`
elemVarSet
`
closeOverKinds
(
TcM
.
tyVarsOfCt
ct
)
&&
new_tv
`
elemVarSet
`
closeOverKinds
(
TcM
.
tyVarsOfCt
ct
)
 See Note [Kicking out Irreds]
 See Note [Kicking out Irreds]
...
@@ 1386,23 +1404,23 @@ kickOutRewritable new_fr new_tv (IC { inert_eqs = tv_eqs
...
@@ 1386,23 +1404,23 @@ kickOutRewritable new_fr new_tv (IC { inert_eqs = tv_eqs
where
where
(
eqs_in
,
eqs_out
)
=
partition
keep_eq
eqs
(
eqs_in
,
eqs_out
)
=
partition
keep_eq
eqs

implements criteria K1K3 in Note [The inert equalities] in TcFlatten

Implements criteria K1K3 in Note [Extending the inert equalities]
keep_eq
(
CTyEqCan
{
cc_tyvar
=
tv
,
cc_rhs
=
rhs_ty
,
cc_ev
=
ev
keep_eq
(
CTyEqCan
{
cc_tyvar
=
tv
,
cc_rhs
=
rhs_ty
,
cc_ev
=
ev
,
cc_eq_rel
=
eq_rel
})
,
cc_eq_rel
=
eq_rel
})

tv
==
new_tv

tv
==
new_tv
=
not
(
can_rewrite
ev
)
 (K1)
=
not
(
fr_
can_rewrite
ev
)
 (K1)

otherwise

otherwise
=
check_k2
&&
check_k3
=
check_k2
&&
check_k3
where
where
ev_fr
=
ctEvFlavourRole
ev
fs
=
ctEvFlavourRole
ev
check_k2
=
not
(
ev_fr
`
eqCanRewriteFR
`
ev_fr
)
check_k2
=
not
(
fs
`
eqCanRewriteFR
`
fs
)
 (K2a
)

not
(
new_fr
`
eqCanRewriteFR
`
ev_fr
)

(
fs
`
eqCanRewriteFR
`
new_fr
)
 (K2b
)

(
ev_fr
`
eqCanRewriteFR
`
new_fr
)

not
(
new_fr
`
eqCanRewriteFR
`
fs
)
 (K2c
)

not
(
new_tv
`
elemVarSet
`
tyVarsOfType
rhs_ty
)

not
(
new_tv
`
elemVarSet
`
tyVarsOfType
rhs_ty
)
 (K2d)
check_k3
check_k3

new_fr
`
eqCanRewriteFR
`
ev_fr

new_fr
`
eqCanRewriteFR
`
fs
=
case
eq_rel
of
=
case
eq_rel
of
NomEq
>
not
(
rhs_ty
`
eqType
`
mkTyVarTy
new_tv
)
NomEq
>
not
(
rhs_ty
`
eqType
`
mkTyVarTy
new_tv
)
ReprEq
>
not
(
isTyVarExposed
new_tv
rhs_ty
)
ReprEq
>
not
(
isTyVarExposed
new_tv
rhs_ty
)
...
...
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