diff options
| author | Richard Eisenberg <rae@richarde.dev> | 2022-02-22 10:55:43 +0100 |
|---|---|---|
| committer | sheaf <sam.derbyshire@gmail.com> | 2022-03-01 23:37:27 +0100 |
| commit | cc532a39c2ef58b8d00ff7c1ebf95fb55dc4f9bb (patch) | |
| tree | 34e27b28f6515a8be2c9696e63b54df3e44f32d4 /compiler/GHC/Tc/Solver/Monad.hs | |
| parent | 7aeb6d29313b23cd8d4da5d42cd9e740cca5c1df (diff) | |
| download | haskell-wip/T20231.tar.gz | |
Make inert_cycle_breakers into a stack.wip/T20231
Close #20231.
Diffstat (limited to 'compiler/GHC/Tc/Solver/Monad.hs')
| -rw-r--r-- | compiler/GHC/Tc/Solver/Monad.hs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs index 9f75491dd0..a59bdb0166 100644 --- a/compiler/GHC/Tc/Solver/Monad.hs +++ b/compiler/GHC/Tc/Solver/Monad.hs @@ -8,7 +8,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-incomplete-record-updates #-} +{-# OPTIONS_GHC -Wno-incomplete-record-updates -Wno-orphans #-} -- | Monadic definitions for the constraint solver module GHC.Tc.Solver.Monad ( @@ -1099,7 +1099,8 @@ nestImplicTcS ref inner_tclvl (TcS thing_inside) , tcs_abort_on_insoluble = abort_on_insoluble } -> do { inerts <- TcM.readTcRef old_inert_var - ; let nest_inert = inerts { inert_cycle_breakers = [] + ; let nest_inert = inerts { inert_cycle_breakers = pushCycleBreakerVarStack + (inert_cycle_breakers inerts) , inert_cans = (inert_cans inerts) { inert_given_eqs = False } } -- All other InertSet fields are inherited @@ -1974,8 +1975,8 @@ breakTyVarCycle_maybe ev cte_result (TyVarLHS lhs_tv) rhs ; traceTcS "breakTyVarCycle replacing type family in Given" (ppr new_given) ; emitWorkNC [new_given] ; updInertTcS $ \is -> - is { inert_cycle_breakers = (new_tv, fun_app) : - inert_cycle_breakers is } + is { inert_cycle_breakers = insertCycleBreakerBinding new_tv fun_app + (inert_cycle_breakers is) } ; return $ mkReflRedn Nominal new_ty } -- Why reflexive? See Detail (4) of the Note @@ -1995,8 +1996,9 @@ breakTyVarCycle_maybe _ _ _ _ = return Nothing -- See Note [Type variable cycles] in GHC.Tc.Solver.Canonical. restoreTyVarCycles :: InertSet -> TcM () restoreTyVarCycles is - = forM_ (inert_cycle_breakers is) $ \ (cycle_breaker_tv, orig_ty) -> - TcM.writeMetaTyVar cycle_breaker_tv orig_ty + = forAllCycleBreakerBindings_ (inert_cycle_breakers is) TcM.writeMetaTyVar +{-# SPECIALISE forAllCycleBreakerBindings_ :: + CycleBreakerVarStack -> (TcTyVar -> TcType -> TcM ()) -> TcM () #-} -- Unwrap a type synonym only when either: -- The type synonym is forgetful, or |