diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2014-11-06 13:54:20 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2014-11-06 15:42:26 +0000 |
commit | c945477fba81b541b5a9c59d982447b862f601f4 (patch) | |
tree | cfd15dc71d434670ce49edfe97dba93c3db3f338 | |
parent | cb6ccadf78eba0a36742d4f99eda41c1464fbec6 (diff) | |
download | haskell-c945477fba81b541b5a9c59d982447b862f601f4.tar.gz |
Allow the solved dictionaries to propagate from outside in
See Note [Propagate solved dictionaries] in TcSMonad. This
can signficantly reduce the number of solver steps.
-rw-r--r-- | compiler/typecheck/TcSMonad.lhs | 29 |
1 files changed, 26 insertions, 3 deletions
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index c539c1ee2a..0b3b9d844a 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1165,8 +1165,9 @@ recoverTcS (TcS recovery_code) (TcS thing_inside) nestTcS :: TcS a -> TcS a -- Use the current untouchables, augmenting the current --- evidence bindings, and solved caches --- But have no effect on the InertCans or insolubles +-- evidence bindings, and solved dictionaries +-- But have no effect on the InertCans, or on the inert_flat_cache +-- (the latter because the thing inside a nestTcS does unflattening) nestTcS (TcS thing_inside) = TcS $ \ env@(TcSEnv { tcs_inerts = inerts_var }) -> do { inerts <- TcM.readTcRef inerts_var @@ -1174,7 +1175,14 @@ nestTcS (TcS thing_inside) ; new_wl_var <- TcM.newTcRef emptyWorkList ; let nest_env = env { tcs_inerts = new_inert_var , tcs_worklist = new_wl_var } - ; thing_inside nest_env } + + ; res <- thing_inside nest_env + + ; new_inerts <- TcM.readTcRef new_inert_var + ; TcM.writeTcRef inerts_var -- See Note [Propagate the solved dictionaries] + (inerts { inert_solved_dicts = inert_solved_dicts new_inerts }) + + ; return res } tryTcS :: TcS a -> TcS a -- Like runTcS, but from within the TcS monad @@ -1191,7 +1199,21 @@ tryTcS (TcS thing_inside) , tcs_inerts = is_var , tcs_worklist = wl_var } ; thing_inside nest_env } +\end{code} + +Note [Propagate the solved dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It's really quite important that nestTcS does not discard the solved +dictionaries from the thing_inside. +Consider + Eq [a] + forall b. empty => Eq [a] +We solve the flat (Eq [a]), under nestTcS, and then turn our attention to +the implications. It's definitely fine to use the solved dictionaries on +the inner implications, and it can make a signficant performance difference +if you do so. +\begin{code} -- Getters and setters of TcEnv fields -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1365,6 +1387,7 @@ zonkFlats :: Cts -> TcS Cts zonkFlats cts = wrapTcS (TcM.zonkFlats cts) \end{code} + Note [Do not add duplicate derived insolubles] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In general we *must* add an insoluble (Int ~ Bool) even if there is |