Commit 1ea8c451 authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot

PredType for type constraints in the pattern match checker instead of EvVar

Using EvVars for capturing type constraints implied side-effects in DsM
when we just wanted to *construct* type constraints.

But giving names to type constraints is only necessary when passing
Givens to the type checker, of which the majority of the pattern match
checker should be unaware.

Thus, we simply generate `newtype TyCt = TyCt PredType`, which are
nicely stateless. But at the same time this means we have to allocate
EvVars when we want to query the type oracle! So we keep the type oracle
state as `newtype TyState = TySt (Bag EvVar)`, which nicely makes a
distinction between new, unchecked `TyCt`s and the inert set in
`TyState`.
parent 0dad81ca
Pipeline #10413 passed with stages
in 398 minutes and 6 seconds
......@@ -51,9 +51,11 @@ import PatSyn
import HscTypes (CompleteMatch(..))
import BasicTypes (Boxity(..))
import Var (EvVar)
import Coercion
import TcEvidence
import {-# SOURCE #-} DsExpr (dsExpr, dsLExpr)
import MatchLit (dsLit, dsOverLit)
import IOEnv
import DsMonad
import Bag
import TyCoRep
......@@ -66,9 +68,6 @@ import Data.List (find)
import Control.Monad (forM, when, forM_)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe
import Coercion
import TcEvidence
import IOEnv
import qualified Data.Semigroup as Semi
{-
......
This diff is collapsed.
......@@ -29,7 +29,7 @@ module PmTypes (
setIndirectSDIE, setEntrySDIE, traverseSDIE,
-- * The pattern match oracle
VarInfo(..), TmState(..), Delta(..), initDelta,
VarInfo(..), TmState(..), TyState(..), Delta(..), initDelta
) where
#include "HsVersions.h"
......@@ -57,7 +57,7 @@ import CoreUtils (exprType)
import PrelNames
import TysWiredIn
import TysPrim
import TcRnTypes (pprEvVarWithType)
import TcType (evVarPred)
import Numeric (fromRat)
import Data.Foldable (find)
......@@ -441,7 +441,7 @@ instance Outputable a => Outputable (SharedDIdEnv a) where
-- equal, thus represent the same set of values.
--
-- See Note [TmState invariants].
newtype TmState = TS (SharedDIdEnv VarInfo)
newtype TmState = TmSt (SharedDIdEnv VarInfo)
-- Deterministic so that we generate deterministic error messages
-- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@,
......@@ -498,7 +498,7 @@ data VarInfo
-- | Not user-facing.
instance Outputable TmState where
ppr (TS state) = ppr state
ppr (TmSt state) = ppr state
-- | Not user-facing.
instance Outputable VarInfo where
......@@ -507,23 +507,34 @@ instance Outputable VarInfo where
-- | Initial state of the oracle.
initTmState :: TmState
initTmState = TS emptySDIE
initTmState = TmSt emptySDIE
-- | The type oracle state. A poor man's inert set: The invariant is that all
-- constraints in there are mutually compatible.
newtype TyState = TySt (Bag EvVar)
-- | Not user-facing.
instance Outputable TyState where
ppr (TySt evs)
= braces $ hcat $ punctuate comma $ map (ppr . evVarPred) $ bagToList evs
initTyState :: TyState
initTyState = TySt emptyBag
-- | Term and type constraints to accompany each value vector abstraction.
-- For efficiency, we store the term oracle state instead of the term
-- constraints.
data Delta = MkDelta { delta_ty_cs :: Bag EvVar -- Type oracle; things like a~Int
, delta_tm_cs :: TmState } -- Term oracle; things like x~Nothing
data Delta = MkDelta { delta_ty_st :: TyState -- Type oracle; things like a~Int
, delta_tm_st :: TmState } -- Term oracle; things like x~Nothing
-- | An initial delta that is always satisfiable
initDelta :: Delta
initDelta = MkDelta emptyBag initTmState
initDelta = MkDelta initTyState initTmState
instance Outputable Delta where
ppr delta = vcat [
-- intentionally formatted this way enable the dev to comment in only
-- the info she needs
ppr (delta_tm_cs delta),
ppr (pprEvVarWithType <$> delta_ty_cs delta)
--ppr (delta_ty_cs delta)
ppr (delta_tm_st delta),
ppr (delta_ty_st delta)
]
......@@ -860,12 +860,12 @@ see Note [Required quantifiers in the type of a term] in TcExpr.
********************************************************************** -}
-- | A type of the form @p@ of kind @Constraint@ represents a value whose type is
-- | A type of the form @p@ of constraint kind represents a value whose type is
-- the Haskell predicate @p@, where a predicate is what occurs before
-- the @=>@ in a Haskell type.
--
-- We use 'PredType' as documentation to mark those types that we guarantee to have
-- this kind.
-- We use 'PredType' as documentation to mark those types that we guarantee to
-- have this kind.
--
-- It can be expanded into its representation, but:
--
......
......@@ -327,3 +327,9 @@ instance Foldable.Foldable Bag where
foldl' k z (UnitBag x) = k z x
foldl' k z (TwoBags b1 b2) = let r1 = foldl' k z b1 in seq r1 $ foldl' k r1 b2
foldl' k z (ListBag xs) = foldl' k z xs
instance Traversable Bag where
traverse _ EmptyBag = pure EmptyBag
traverse f (UnitBag x) = UnitBag <$> f x
traverse f (TwoBags b1 b2) = TwoBags <$> traverse f b1 <*> traverse f b2
traverse f (ListBag xs) = ListBag <$> traverse f xs
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment