-- Copyright (c) Facebook, Inc. and its affiliates.
--
-- This source code is licensed under the MIT license found in the
-- LICENSE file in the root directory of this source tree.
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
-- NOTE: This was needed for GHC 9.4 due to
-- type Key RFMap = LocatedA (HsRecField GhcPS (LocatedA (HsExpr GhcPs)))
{-# LANGUAGE UndecidableInstances #-}
module Retrie.PatternMap.Instances where

import Control.Monad
import Data.ByteString (ByteString)
import Data.Maybe

import Retrie.AlphaEnv
import Retrie.ExactPrint
import Retrie.GHC
import Retrie.PatternMap.Bag
import Retrie.PatternMap.Class
import Retrie.Quantifiers
import Retrie.Substitution
import Retrie.Util

------------------------------------------------------------------------

data TupArgMap a
  = TupArgMap { forall a. TupArgMap a -> EMap a
tamPresent :: EMap a, forall a. TupArgMap a -> MaybeMap a
tamMissing :: MaybeMap a }
  deriving (forall a b. a -> TupArgMap b -> TupArgMap a
forall a b. (a -> b) -> TupArgMap a -> TupArgMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TupArgMap b -> TupArgMap a
$c<$ :: forall a b. a -> TupArgMap b -> TupArgMap a
fmap :: forall a b. (a -> b) -> TupArgMap a -> TupArgMap b
$cfmap :: forall a b. (a -> b) -> TupArgMap a -> TupArgMap b
Functor)

instance PatternMap TupArgMap where
  -- type Key TupArgMap = Located (HsTupArg GhcPs)
  type Key TupArgMap = HsTupArg GhcPs

  mEmpty :: TupArgMap a
  mEmpty :: forall a. TupArgMap a
mEmpty = forall a. EMap a -> MaybeMap a -> TupArgMap a
TupArgMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: TupArgMap a -> TupArgMap a -> TupArgMap a
  mUnion :: forall a. TupArgMap a -> TupArgMap a -> TupArgMap a
mUnion TupArgMap a
m1 TupArgMap a
m2 = TupArgMap
    { tamPresent :: EMap a
tamPresent = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TupArgMap a -> EMap a
tamPresent TupArgMap a
m1 TupArgMap a
m2
    , tamMissing :: MaybeMap a
tamMissing = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TupArgMap a -> MaybeMap a
tamMissing TupArgMap a
m1 TupArgMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key TupArgMap -> A a -> TupArgMap a -> TupArgMap a
  mAlter :: forall a.
AlphaEnv
-> Quantifiers
-> Key TupArgMap
-> A a
-> TupArgMap a
-> TupArgMap a
mAlter AlphaEnv
env Quantifiers
vs Key TupArgMap
tupArg A a
f TupArgMap a
m = HsTupArg GhcPs -> TupArgMap a
go Key TupArgMap
tupArg
    where
      go :: HsTupArg GhcPs -> TupArgMap a
go (Present XPresent GhcPs
_ LHsExpr GhcPs
e) = TupArgMap a
m { tamPresent :: EMap a
tamPresent = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
e  A a
f (forall a. TupArgMap a -> EMap a
tamPresent TupArgMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XTupArg{} = missingSyntax "XTupArg"
#endif
      go (Missing XMissing GhcPs
_) = TupArgMap a
m { tamMissing :: MaybeMap a
tamMissing = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. TupArgMap a -> MaybeMap a
tamMissing TupArgMap a
m) }

  mMatch :: MatchEnv -> Key TupArgMap -> (Substitution, TupArgMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key TupArgMap
-> (Substitution, TupArgMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env = HsTupArg GhcPs
-> (Substitution, TupArgMap a) -> [(Substitution, a)]
go
    where
      go :: HsTupArg GhcPs
-> (Substitution, TupArgMap a) -> [(Substitution, a)]
go (Present XPresent GhcPs
_ LHsExpr GhcPs
e) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TupArgMap a -> EMap a
tamPresent forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
e
#if __GLASGOW_HASKELL__ < 900
      go XTupArg{} = const []
#endif
      go (Missing XMissing GhcPs
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TupArgMap a -> MaybeMap a
tamMissing forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()

------------------------------------------------------------------------

data BoxityMap a
  = BoxityMap { forall a. BoxityMap a -> MaybeMap a
boxBoxed :: MaybeMap a, forall a. BoxityMap a -> MaybeMap a
boxUnboxed :: MaybeMap a }
  deriving (forall a b. a -> BoxityMap b -> BoxityMap a
forall a b. (a -> b) -> BoxityMap a -> BoxityMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BoxityMap b -> BoxityMap a
$c<$ :: forall a b. a -> BoxityMap b -> BoxityMap a
fmap :: forall a b. (a -> b) -> BoxityMap a -> BoxityMap b
$cfmap :: forall a b. (a -> b) -> BoxityMap a -> BoxityMap b
Functor)

instance PatternMap BoxityMap where
  type Key BoxityMap = Boxity

  mEmpty :: BoxityMap a
  mEmpty :: forall a. BoxityMap a
mEmpty = forall a. MaybeMap a -> MaybeMap a -> BoxityMap a
BoxityMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: BoxityMap a -> BoxityMap a -> BoxityMap a
  mUnion :: forall a. BoxityMap a -> BoxityMap a -> BoxityMap a
mUnion BoxityMap a
m1 BoxityMap a
m2 = BoxityMap
    { boxBoxed :: MaybeMap a
boxBoxed = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. BoxityMap a -> MaybeMap a
boxBoxed BoxityMap a
m1 BoxityMap a
m2
    , boxUnboxed :: MaybeMap a
boxUnboxed = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. BoxityMap a -> MaybeMap a
boxUnboxed BoxityMap a
m1 BoxityMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key BoxityMap -> A a -> BoxityMap a -> BoxityMap a
  mAlter :: forall a.
AlphaEnv
-> Quantifiers
-> Key BoxityMap
-> A a
-> BoxityMap a
-> BoxityMap a
mAlter AlphaEnv
env Quantifiers
vs Boxity
Key BoxityMap
Boxed   A a
f BoxityMap a
m = BoxityMap a
m { boxBoxed :: MaybeMap a
boxBoxed   = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. BoxityMap a -> MaybeMap a
boxBoxed BoxityMap a
m) }
  mAlter AlphaEnv
env Quantifiers
vs Boxity
Key BoxityMap
Unboxed A a
f BoxityMap a
m = BoxityMap a
m { boxUnboxed :: MaybeMap a
boxUnboxed = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. BoxityMap a -> MaybeMap a
boxUnboxed BoxityMap a
m) }

  mMatch :: MatchEnv -> Key BoxityMap -> (Substitution, BoxityMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key BoxityMap
-> (Substitution, BoxityMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env Boxity
Key BoxityMap
Boxed   = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. BoxityMap a -> MaybeMap a
boxBoxed forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
  mMatch MatchEnv
env Boxity
Key BoxityMap
Unboxed = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. BoxityMap a -> MaybeMap a
boxUnboxed forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()

------------------------------------------------------------------------

data VMap a = VM { forall a. VMap a -> IntMap a
bvmap :: IntMap a, forall a. VMap a -> FSEnv a
fvmap :: FSEnv a }
            | VMEmpty
  deriving (forall a b. a -> VMap b -> VMap a
forall a b. (a -> b) -> VMap a -> VMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> VMap b -> VMap a
$c<$ :: forall a b. a -> VMap b -> VMap a
fmap :: forall a b. (a -> b) -> VMap a -> VMap b
$cfmap :: forall a b. (a -> b) -> VMap a -> VMap b
Functor)

instance PatternMap VMap where
  type Key VMap = RdrName

  mEmpty :: VMap a
  mEmpty :: forall a. VMap a
mEmpty = forall a. VMap a
VMEmpty

  mUnion :: VMap a -> VMap a -> VMap a
  mUnion :: forall a. VMap a -> VMap a -> VMap a
mUnion VMap a
VMEmpty VMap a
m = VMap a
m
  mUnion VMap a
m VMap a
VMEmpty = VMap a
m
  mUnion VMap a
m1 VMap a
m2 = VM
    { bvmap :: IntMap a
bvmap = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. VMap a -> IntMap a
bvmap VMap a
m1 VMap a
m2
    , fvmap :: FSEnv a
fvmap = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. VMap a -> FSEnv a
fvmap VMap a
m1 VMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key VMap -> A a -> VMap a -> VMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key VMap -> A a -> VMap a -> VMap a
mAlter AlphaEnv
env Quantifiers
vs Key VMap
v A a
f VMap a
VMEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key VMap
v A a
f (forall a. IntMap a -> FSEnv a -> VMap a
VM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty)
  mAlter AlphaEnv
env Quantifiers
vs Key VMap
v A a
f m :: VMap a
m@VM{}
    | Just Int
bv <- RdrName -> AlphaEnv -> Maybe Int
lookupAlphaEnv Key VMap
v AlphaEnv
env = VMap a
m { bvmap :: IntMap a
bvmap = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Int
bv A a
f (forall a. VMap a -> IntMap a
bvmap VMap a
m) }
    | Bool
otherwise                       = VMap a
m { fvmap :: FSEnv a
fvmap = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (RdrName -> FastString
rdrFS Key VMap
v) A a
f (forall a. VMap a -> FSEnv a
fvmap VMap a
m) }

  mMatch :: MatchEnv -> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key VMap
_ (Substitution
_,VMap a
VMEmpty) = []
  mMatch MatchEnv
env Key VMap
v (Substitution
hs,m :: VMap a
m@VM{})
    | Just Int
bv <- RdrName -> AlphaEnv -> Maybe Int
lookupAlphaEnv Key VMap
v (MatchEnv -> AlphaEnv
meAlphaEnv MatchEnv
env) = forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Int
bv (Substitution
hs, forall a. VMap a -> IntMap a
bvmap VMap a
m)
    | Bool
otherwise = forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (RdrName -> FastString
rdrFS Key VMap
v) (Substitution
hs, forall a. VMap a -> FSEnv a
fvmap VMap a
m)

------------------------------------------------------------------------

data LMap a
  = LMEmpty
  | LM { forall a. LMap a -> Map Char a
lmChar :: Map Char a
       , forall a. LMap a -> Map Char a
lmCharPrim :: Map Char a
       , forall a. LMap a -> FSEnv a
lmString :: FSEnv a
       , forall a. LMap a -> Map ByteString a
lmStringPrim :: Map ByteString a
       , forall a. LMap a -> BoolMap (Map Integer a)
lmInt :: BoolMap (Map Integer a)
       , forall a. LMap a -> Map Integer a
lmIntPrim :: Map Integer a
       , forall a. LMap a -> Map Integer a
lmWordPrim :: Map Integer a
       , forall a. LMap a -> Map Integer a
lmInt64Prim :: Map Integer a
       , forall a. LMap a -> Map Integer a
lmWord64Prim :: Map Integer a
       }
  deriving (forall a b. a -> LMap b -> LMap a
forall a b. (a -> b) -> LMap a -> LMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LMap b -> LMap a
$c<$ :: forall a b. a -> LMap b -> LMap a
fmap :: forall a b. (a -> b) -> LMap a -> LMap b
$cfmap :: forall a b. (a -> b) -> LMap a -> LMap b
Functor)

emptyLMapWrapper :: LMap a
emptyLMapWrapper :: forall a. LMap a
emptyLMapWrapper
  = forall a.
Map Char a
-> Map Char a
-> FSEnv a
-> Map ByteString a
-> BoolMap (Map Integer a)
-> Map Integer a
-> Map Integer a
-> Map Integer a
-> Map Integer a
-> LMap a
LM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty
       forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap LMap where
  type Key LMap = HsLit GhcPs

  mEmpty :: LMap a
  mEmpty :: forall a. LMap a
mEmpty = forall a. LMap a
LMEmpty

  mUnion :: LMap a -> LMap a -> LMap a
  mUnion :: forall a. LMap a -> LMap a -> LMap a
mUnion LMap a
LMEmpty LMap a
m = LMap a
m
  mUnion LMap a
m LMap a
LMEmpty = LMap a
m
  mUnion LMap a
m1 LMap a
m2 = LM
    { lmChar :: Map Char a
lmChar = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> Map Char a
lmChar LMap a
m1 LMap a
m2
    , lmCharPrim :: Map Char a
lmCharPrim = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> Map Char a
lmCharPrim LMap a
m1 LMap a
m2
    , lmString :: FSEnv a
lmString = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> FSEnv a
lmString LMap a
m1 LMap a
m2
    , lmStringPrim :: Map ByteString a
lmStringPrim = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> Map ByteString a
lmStringPrim LMap a
m1 LMap a
m2
    , lmInt :: BoolMap (Map Integer a)
lmInt = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> BoolMap (Map Integer a)
lmInt LMap a
m1 LMap a
m2
    , lmIntPrim :: Map Integer a
lmIntPrim = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> Map Integer a
lmIntPrim LMap a
m1 LMap a
m2
    , lmWordPrim :: Map Integer a
lmWordPrim = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> Map Integer a
lmWordPrim LMap a
m1 LMap a
m2
    , lmInt64Prim :: Map Integer a
lmInt64Prim = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> Map Integer a
lmInt64Prim LMap a
m1 LMap a
m2
    , lmWord64Prim :: Map Integer a
lmWord64Prim = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LMap a -> Map Integer a
lmWord64Prim LMap a
m1 LMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key LMap -> A a -> LMap a -> LMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key LMap -> A a -> LMap a -> LMap a
mAlter AlphaEnv
env Quantifiers
vs Key LMap
lit A a
f LMap a
LMEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key LMap
lit A a
f forall a. LMap a
emptyLMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key LMap
lit A a
f m :: LMap a
m@LM{}  = HsLit GhcPs -> LMap a
go Key LMap
lit
    where
      go :: HsLit GhcPs -> LMap a
go (HsChar XHsChar GhcPs
_ Char
c)       = LMap a
m { lmChar :: Map Char a
lmChar = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Char
c A a
f (forall a. LMap a -> Map Char a
lmChar LMap a
m) }
      go (HsCharPrim XHsCharPrim GhcPs
_ Char
c)   = LMap a
m { lmCharPrim :: Map Char a
lmCharPrim = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Char
c A a
f (forall a. LMap a -> Map Char a
lmCharPrim LMap a
m) }
      go (HsString XHsString GhcPs
_ FastString
fs)    = LMap a
m { lmString :: FSEnv a
lmString = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs FastString
fs A a
f (forall a. LMap a -> FSEnv a
lmString LMap a
m) }
      go (HsStringPrim XHsStringPrim GhcPs
_ ByteString
bs) = LMap a
m { lmStringPrim :: Map ByteString a
lmStringPrim = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs ByteString
bs A a
f (forall a. LMap a -> Map ByteString a
lmStringPrim LMap a
m) }
      go (HsInt XHsInt GhcPs
_ (IL SourceText
_ Bool
b Integer
i)) =
        LMap a
m { lmInt :: BoolMap (Map Integer a)
lmInt = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Bool
b (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
i A a
f)) (forall a. LMap a -> BoolMap (Map Integer a)
lmInt LMap a
m) }
      go (HsIntPrim XHsIntPrim GhcPs
_ Integer
i)    = LMap a
m { lmIntPrim :: Map Integer a
lmIntPrim = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
i A a
f (forall a. LMap a -> Map Integer a
lmIntPrim LMap a
m) }
      go (HsWordPrim XHsWordPrim GhcPs
_ Integer
i)   = LMap a
m { lmWordPrim :: Map Integer a
lmWordPrim = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
i A a
f (forall a. LMap a -> Map Integer a
lmWordPrim LMap a
m) }
      go (HsInt64Prim XHsInt64Prim GhcPs
_ Integer
i)  = LMap a
m { lmInt64Prim :: Map Integer a
lmInt64Prim = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
i A a
f (forall a. LMap a -> Map Integer a
lmInt64Prim LMap a
m) }
      go (HsWord64Prim XHsWord64Prim GhcPs
_ Integer
i) = LMap a
m { lmWord64Prim :: Map Integer a
lmWord64Prim = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
i A a
f (forall a. LMap a -> Map Integer a
lmWord64Prim LMap a
m) }
      go (HsInteger XHsInteger GhcPs
_ Integer
_ Type
_) = forall a. String -> a
missingSyntax String
"HsInteger"
      go HsRat{} = forall a. String -> a
missingSyntax String
"HsRat"
      go HsFloatPrim{} = forall a. String -> a
missingSyntax String
"HsFloatPrim"
      go HsDoublePrim{} = forall a. String -> a
missingSyntax String
"HsDoublePrim"
#if __GLASGOW_HASKELL__ < 900
      go XLit{} = missingSyntax "XLit"
#endif

  mMatch :: MatchEnv -> Key LMap -> (Substitution, LMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key LMap -> (Substitution, LMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key LMap
_   (Substitution
_,LMap a
LMEmpty) = []
  mMatch MatchEnv
env Key LMap
lit (Substitution
hs,m :: LMap a
m@LM{}) = HsLit GhcPs -> (Substitution, LMap a) -> [(Substitution, a)]
go Key LMap
lit (Substitution
hs,LMap a
m)
    where
      go :: HsLit GhcPs -> (Substitution, LMap a) -> [(Substitution, a)]
go (HsChar XHsChar GhcPs
_ Char
c)        = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> Map Char a
lmChar forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Char
c
      go (HsCharPrim XHsCharPrim GhcPs
_ Char
c)    = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> Map Char a
lmCharPrim forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Char
c
      go (HsString XHsString GhcPs
_ FastString
fs)     = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> FSEnv a
lmString forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env FastString
fs
      go (HsStringPrim XHsStringPrim GhcPs
_ ByteString
bs) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> Map ByteString a
lmStringPrim forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ByteString
bs
      go (HsInt XHsInt GhcPs
_ (IL SourceText
_ Bool
b Integer
i)) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> BoolMap (Map Integer a)
lmInt forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Bool
b forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
i
      go (HsIntPrim XHsIntPrim GhcPs
_ Integer
i)     = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> Map Integer a
lmIntPrim forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
i
      go (HsWordPrim XHsWordPrim GhcPs
_ Integer
i)    = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> Map Integer a
lmWordPrim forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
i
      go (HsInt64Prim XHsInt64Prim GhcPs
_ Integer
i)   = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> Map Integer a
lmInt64Prim forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
i
      go (HsWord64Prim XHsWord64Prim GhcPs
_ Integer
i)  = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LMap a -> Map Integer a
lmWord64Prim forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
i
      go HsLit GhcPs
_ = forall a b. a -> b -> a
const [] -- TODO

------------------------------------------------------------------------

data OLMap a
  = OLMEmpty
  | OLM
    { forall a. OLMap a -> BoolMap (Map Integer a)
olmIntegral :: BoolMap (Map Integer a)
    -- ++AZ++:TODO: Fractional has *much* more than Rational now
    , forall a. OLMap a -> Map Rational a
olmFractional :: Map Rational a
    , forall a. OLMap a -> FSEnv a
olmIsString :: FSEnv a
    }
  deriving (forall a b. a -> OLMap b -> OLMap a
forall a b. (a -> b) -> OLMap a -> OLMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> OLMap b -> OLMap a
$c<$ :: forall a b. a -> OLMap b -> OLMap a
fmap :: forall a b. (a -> b) -> OLMap a -> OLMap b
$cfmap :: forall a b. (a -> b) -> OLMap a -> OLMap b
Functor)

emptyOLMapWrapper :: OLMap a
emptyOLMapWrapper :: forall a. OLMap a
emptyOLMapWrapper = forall a.
BoolMap (Map Integer a) -> Map Rational a -> FSEnv a -> OLMap a
OLM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap OLMap where
  type Key OLMap = OverLitVal

  mEmpty :: OLMap a
  mEmpty :: forall a. OLMap a
mEmpty = forall a. OLMap a
OLMEmpty

  mUnion :: OLMap a -> OLMap a -> OLMap a
  mUnion :: forall a. OLMap a -> OLMap a -> OLMap a
mUnion OLMap a
OLMEmpty OLMap a
m = OLMap a
m
  mUnion OLMap a
m OLMap a
OLMEmpty = OLMap a
m
  mUnion OLMap a
m1 OLMap a
m2 = OLM
    { olmIntegral :: BoolMap (Map Integer a)
olmIntegral = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. OLMap a -> BoolMap (Map Integer a)
olmIntegral OLMap a
m1 OLMap a
m2
    , olmFractional :: Map Rational a
olmFractional = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. OLMap a -> Map Rational a
olmFractional OLMap a
m1 OLMap a
m2
    , olmIsString :: FSEnv a
olmIsString = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. OLMap a -> FSEnv a
olmIsString OLMap a
m1 OLMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key OLMap -> A a -> OLMap a -> OLMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key OLMap -> A a -> OLMap a -> OLMap a
mAlter AlphaEnv
env Quantifiers
vs Key OLMap
lv A a
f OLMap a
OLMEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key OLMap
lv A a
f forall a. OLMap a
emptyOLMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key OLMap
lv A a
f m :: OLMap a
m@OLM{}  = OverLitVal -> OLMap a
go Key OLMap
lv
    where
      go :: OverLitVal -> OLMap a
go (HsIntegral (IL SourceText
_ Bool
b Integer
i)) =
        OLMap a
m { olmIntegral :: BoolMap (Map Integer a)
olmIntegral = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Bool
b (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
i A a
f)) (forall a. OLMap a -> BoolMap (Map Integer a)
olmIntegral OLMap a
m) }
      go (HsFractional FractionalLit
fl) = OLMap a
m { olmFractional :: Map Rational a
olmFractional = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (FractionalLit -> Rational
fl_signi FractionalLit
fl) A a
f (forall a. OLMap a -> Map Rational a
olmFractional OLMap a
m) }
      go (HsIsString SourceText
_ FastString
fs) = OLMap a
m { olmIsString :: FSEnv a
olmIsString = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs FastString
fs A a
f (forall a. OLMap a -> FSEnv a
olmIsString OLMap a
m) }

  mMatch :: MatchEnv -> Key OLMap -> (Substitution, OLMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key OLMap -> (Substitution, OLMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key OLMap
_  (Substitution
_,OLMap a
OLMEmpty) = []
  mMatch MatchEnv
env Key OLMap
lv (Substitution
hs,m :: OLMap a
m@OLM{}) = OverLitVal -> (Substitution, OLMap a) -> [(Substitution, a)]
go Key OLMap
lv (Substitution
hs,OLMap a
m)
    where
      go :: OverLitVal -> (Substitution, OLMap a) -> [(Substitution, a)]
go (HsIntegral (IL SourceText
_ Bool
b Integer
i)) =
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. OLMap a -> BoolMap (Map Integer a)
olmIntegral forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Bool
b forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
i
      go (HsFractional FractionalLit
fl) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. OLMap a -> Map Rational a
olmFractional forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (FractionalLit -> Rational
fl_signi FractionalLit
fl)
      go (HsIsString SourceText
_ FastString
fs) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. OLMap a -> FSEnv a
olmIsString forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env FastString
fs

------------------------------------------------------------------------

-- Note [Holes]
-- Holes are distinguished variables which can match any expression. (The
-- universally quantified variables in an Equality.) Ideally, they would be
-- stored as a TyMap, so the type of the expression can be checked against the
-- type of the hole. Fixing this is a TODO. This wraps a map from RdrName to
-- result. We use a regular map instead of a OccEnv so we can get the RdrName
-- back, which allows us to assign it to the expression when building the
-- result.

-- Note [Lambdas]
-- This currently stores both HsLam and HsLamCase

-- Note [Stmt Lists]
-- Statement lists bind to the right, so we need to extend the environment
-- as we move down it. Thus we cannot simply store them as ListMap SMap a.

data EMap a
  = EMEmpty
  | EM { forall a. EMap a -> Map RdrName a
emHole  :: Map RdrName a -- See Note [Holes]
       , forall a. EMap a -> VMap a
emVar   :: VMap a
       , forall a. EMap a -> FSEnv a
emIPVar :: FSEnv a
       , forall a. EMap a -> OLMap a
emOverLit :: OLMap a
       , forall a. EMap a -> LMap a
emLit   :: LMap a
       , forall a. EMap a -> MGMap a
emLam   :: MGMap a -- See Note [Lambdas]
       , forall a. EMap a -> EMap (EMap a)
emApp   :: EMap (EMap a)
       , forall a. EMap a -> EMap (EMap (EMap a))
emOpApp :: EMap (EMap (EMap a)) -- op, lhs, rhs
       , forall a. EMap a -> EMap a
emNegApp :: EMap a
       , forall a. EMap a -> EMap a
emPar   :: EMap a
       , forall a. EMap a -> BoxityMap (ListMap TupArgMap a)
emExplicitTuple :: BoxityMap (ListMap TupArgMap a)
       , forall a. EMap a -> EMap (MGMap a)
emCase  :: EMap (MGMap a)
       , forall a. EMap a -> EMap (EMap a)
emSecL  :: EMap (EMap a) -- operator, operand (flipped)
       , forall a. EMap a -> EMap (EMap a)
emSecR  :: EMap (EMap a) -- operator, operand
       , forall a. EMap a -> EMap (EMap (EMap a))
emIf    :: EMap (EMap (EMap a)) -- cond, true, false
       , forall a. EMap a -> LBMap (EMap a)
emLet   :: LBMap (EMap a)
       , forall a. EMap a -> SCMap (SLMap a)
emDo    :: SCMap (SLMap a) -- See Note [Stmt Lists]
       , forall a. EMap a -> ListMap EMap a
emExplicitList :: ListMap EMap a
       , forall a. EMap a -> VMap (ListMap RFMap a)
emRecordCon :: VMap (ListMap RFMap a)
       , forall a. EMap a -> EMap (ListMap RFMap a)
emRecordUpd :: EMap (ListMap RFMap a)
       , forall a. EMap a -> EMap (TyMap a)
emExprWithTySig :: EMap (TyMap a)
       }
  deriving (forall a b. a -> EMap b -> EMap a
forall a b. (a -> b) -> EMap a -> EMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> EMap b -> EMap a
$c<$ :: forall a b. a -> EMap b -> EMap a
fmap :: forall a b. (a -> b) -> EMap a -> EMap b
$cfmap :: forall a b. (a -> b) -> EMap a -> EMap b
Functor)

emptyEMapWrapper :: EMap a
emptyEMapWrapper :: forall a. EMap a
emptyEMapWrapper =
  forall a.
Map RdrName a
-> VMap a
-> FSEnv a
-> OLMap a
-> LMap a
-> MGMap a
-> EMap (EMap a)
-> EMap (EMap (EMap a))
-> EMap a
-> EMap a
-> BoxityMap (ListMap TupArgMap a)
-> EMap (MGMap a)
-> EMap (EMap a)
-> EMap (EMap a)
-> EMap (EMap (EMap a))
-> LBMap (EMap a)
-> SCMap (SLMap a)
-> ListMap EMap a
-> VMap (ListMap RFMap a)
-> EMap (ListMap RFMap a)
-> EMap (TyMap a)
-> EMap a
EM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap EMap where
  type Key EMap = LocatedA (HsExpr GhcPs)

  mEmpty :: EMap a
  mEmpty :: forall a. EMap a
mEmpty = forall a. EMap a
EMEmpty

  mUnion :: EMap a -> EMap a -> EMap a
  mUnion :: forall a. EMap a -> EMap a -> EMap a
mUnion EMap a
EMEmpty EMap a
m = EMap a
m
  mUnion EMap a
m EMap a
EMEmpty = EMap a
m
  mUnion EMap a
m1 EMap a
m2 = EM
    { emHole :: Map RdrName a
emHole = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> Map RdrName a
emHole EMap a
m1 EMap a
m2
    , emVar :: VMap a
emVar = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> VMap a
emVar EMap a
m1 EMap a
m2
    , emIPVar :: FSEnv a
emIPVar = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> FSEnv a
emIPVar EMap a
m1 EMap a
m2
    , emOverLit :: OLMap a
emOverLit = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> OLMap a
emOverLit EMap a
m1 EMap a
m2
    , emLit :: LMap a
emLit = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> LMap a
emLit EMap a
m1 EMap a
m2
    , emLam :: MGMap a
emLam = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> MGMap a
emLam EMap a
m1 EMap a
m2
    , emApp :: EMap (EMap a)
emApp = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (EMap a)
emApp EMap a
m1 EMap a
m2
    , emOpApp :: EMap (EMap (EMap a))
emOpApp = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (EMap (EMap a))
emOpApp EMap a
m1 EMap a
m2
    , emNegApp :: EMap a
emNegApp = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap a
emNegApp EMap a
m1 EMap a
m2
    , emPar :: EMap a
emPar = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap a
emPar EMap a
m1 EMap a
m2
    , emExplicitTuple :: BoxityMap (ListMap TupArgMap a)
emExplicitTuple = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> BoxityMap (ListMap TupArgMap a)
emExplicitTuple EMap a
m1 EMap a
m2
    , emCase :: EMap (MGMap a)
emCase = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (MGMap a)
emCase EMap a
m1 EMap a
m2
    , emSecL :: EMap (EMap a)
emSecL = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (EMap a)
emSecL EMap a
m1 EMap a
m2
    , emSecR :: EMap (EMap a)
emSecR = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (EMap a)
emSecR EMap a
m1 EMap a
m2
    , emIf :: EMap (EMap (EMap a))
emIf = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (EMap (EMap a))
emIf EMap a
m1 EMap a
m2
    , emLet :: LBMap (EMap a)
emLet = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> LBMap (EMap a)
emLet EMap a
m1 EMap a
m2
    , emDo :: SCMap (SLMap a)
emDo = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> SCMap (SLMap a)
emDo EMap a
m1 EMap a
m2
    , emExplicitList :: ListMap EMap a
emExplicitList = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> ListMap EMap a
emExplicitList EMap a
m1 EMap a
m2
    , emRecordCon :: VMap (ListMap RFMap a)
emRecordCon = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> VMap (ListMap RFMap a)
emRecordCon EMap a
m1 EMap a
m2
    , emRecordUpd :: EMap (ListMap RFMap a)
emRecordUpd = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (ListMap RFMap a)
emRecordUpd EMap a
m1 EMap a
m2
    , emExprWithTySig :: EMap (TyMap a)
emExprWithTySig = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. EMap a -> EMap (TyMap a)
emExprWithTySig EMap a
m1 EMap a
m2
    }

  mAlter :: forall a. AlphaEnv -> Quantifiers -> Key EMap -> A a -> EMap a -> EMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key EMap -> A a -> EMap a -> EMap a
mAlter AlphaEnv
env Quantifiers
vs Key EMap
e A a
f EMap a
EMEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key EMap
e A a
f forall a. EMap a
emptyEMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key EMap
e A a
f m :: EMap a
m@EM{} = HsExpr GhcPs -> EMap a
go (forall l e. GenLocated l e -> e
unLoc Key EMap
e)
    where
      go :: HsExpr GhcPs -> EMap a
go (HsVar XVar GhcPs
_ LIdP GhcPs
v)
        | forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = EMap a
m { emHole :: Map RdrName a
emHole  = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
v) A a
f (forall a. EMap a -> Map RdrName a
emHole EMap a
m) }
        | Bool
otherwise        = EMap a
m { emVar :: VMap a
emVar   = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
v) A a
f (forall a. EMap a -> VMap a
emVar EMap a
m) }
      go (ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
as Boxity
b) =
        EMap a
m { emExplicitTuple :: BoxityMap (ListMap TupArgMap a)
emExplicitTuple = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Boxity
b (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [HsTupArg GhcPs]
as A a
f)) (forall a. EMap a -> BoxityMap (ListMap TupArgMap a)
emExplicitTuple EMap a
m) }
      go (HsApp XApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
r) =
        EMap a
m { emApp :: EMap (EMap a)
emApp = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
l (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
r A a
f)) (forall a. EMap a -> EMap (EMap a)
emApp EMap a
m) }
      go (HsCase XCase GhcPs
_ LHsExpr GhcPs
s MatchGroup GhcPs (LHsExpr GhcPs)
mg) =
        EMap a
m { emCase :: EMap (MGMap a)
emCase = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
s (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs MatchGroup GhcPs (LHsExpr GhcPs)
mg A a
f)) (forall a. EMap a -> EMap (MGMap a)
emCase EMap a
m) }
      go (HsDo XDo GhcPs
_ HsStmtContext (HsDoRn GhcPs)
sc XRec GhcPs [ExprLStmt GhcPs]
ss) =
        EMap a
m { emDo :: SCMap (SLMap a)
emDo = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsStmtContext (HsDoRn GhcPs)
sc (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall l e. GenLocated l e -> e
unLoc XRec GhcPs [ExprLStmt GhcPs]
ss) A a
f)) (forall a. EMap a -> SCMap (SLMap a)
emDo EMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go (HsIf _ _ c tr fl) =
#else
      go (HsIf XIf GhcPs
_ LHsExpr GhcPs
c LHsExpr GhcPs
tr LHsExpr GhcPs
fl) =
#endif
        EMap a
m { emIf :: EMap (EMap (EMap a))
emIf = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
c
                      (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
tr
                          (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
fl A a
f)))) (forall a. EMap a -> EMap (EMap (EMap a))
emIf EMap a
m) }
      go (HsIPVar XIPVar GhcPs
_ (HsIPName FastString
ip)) = EMap a
m { emIPVar :: FSEnv a
emIPVar = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs FastString
ip A a
f (forall a. EMap a -> FSEnv a
emIPVar EMap a
m) }
      go (HsLit XLitE GhcPs
_ HsLit GhcPs
l) = EMap a
m { emLit :: LMap a
emLit   = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsLit GhcPs
l A a
f (forall a. EMap a -> LMap a
emLit EMap a
m) }
      go (HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg) = EMap a
m { emLam :: MGMap a
emLam   = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs MatchGroup GhcPs (LHsExpr GhcPs)
mg A a
f (forall a. EMap a -> MGMap a
emLam EMap a
m) }
      go (HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
ol) = EMap a
m { emOverLit :: OLMap a
emOverLit = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
ol) A a
f (forall a. EMap a -> OLMap a
emOverLit EMap a
m) }
      go (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e' SyntaxExpr GhcPs
_) = EMap a
m { emNegApp :: EMap a
emNegApp = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
e' A a
f (forall a. EMap a -> EMap a
emNegApp EMap a
m) }
#if __GLASGOW_HASKELL__ < 904
      go (HsPar XPar GhcPs
_ LHsExpr GhcPs
e') = EMap a
m { emPar :: EMap a
emPar  = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
e' A a
f (forall a. EMap a -> EMap a
emPar EMap a
m) }
#else
      go (HsPar _ _ e' _) = m { emPar  = mAlter env vs e' f (emPar m) }
#endif
      go (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r) =
        EMap a
m { emOpApp :: EMap (EMap (EMap a))
emOpApp = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
o (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
l (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
r A a
f)))) (forall a. EMap a -> EMap (EMap (EMap a))
emOpApp EMap a
m) }
#if __GLASGOW_HASKELL__ < 904
      go (RecordCon XRecordCon GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
v HsRecordBinds GhcPs
fs) =
        EMap a
m { emRecordCon :: VMap (ListMap RFMap a)
emRecordCon = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (ConLikeP GhcPs)
v) (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall f arg.
RecordFieldToRdrName f =>
[LHsRecField' GhcPs f arg] -> [LHsRecField' GhcPs RdrName arg]
fieldsToRdrNames forall a b. (a -> b) -> a -> b
$ forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecordBinds GhcPs
fs) A a
f)) (forall a. EMap a -> VMap (ListMap RFMap a)
emRecordCon EMap a
m) }
#else
      go (RecordCon _ v fs) =
        m { emRecordCon = mAlter env vs (unLoc v :: RdrName) (toA (mAlter env vs (rec_flds fs) f)) (emRecordCon m) }
#endif
      go (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
e' Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fs) =
        EMap a
m { emRecordUpd :: EMap (ListMap RFMap a)
emRecordUpd = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
e' (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
-> [LHsRecField' GhcPs RdrName (LHsExpr GhcPs)]
fieldsToRdrNamesUpd Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fs) A a
f)) (forall a. EMap a -> EMap (ListMap RFMap a)
emRecordUpd EMap a
m) }
      go (SectionL XSectionL GhcPs
_ LHsExpr GhcPs
lhs LHsExpr GhcPs
o) =
        EMap a
m { emSecL :: EMap (EMap a)
emSecL = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
o (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
lhs A a
f)) (forall a. EMap a -> EMap (EMap a)
emSecL EMap a
m) }
      go (SectionR XSectionR GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
rhs) =
        EMap a
m { emSecR :: EMap (EMap a)
emSecR = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
o (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
rhs A a
f)) (forall a. EMap a -> EMap (EMap a)
emSecR EMap a
m) }
#if __GLASGOW_HASKELL__ < 904
      go (HsLet XLet GhcPs
_ HsLocalBinds GhcPs
lbs LHsExpr GhcPs
e') =
#else
      go (HsLet _ _ lbs _ e') =
#endif
        let
          bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
          env' :: AlphaEnv
env' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
bs
          vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
bs
        in EMap a
m { emLet :: LBMap (EMap a)
emLet = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsLocalBinds GhcPs
lbs (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' LHsExpr GhcPs
e' A a
f)) (forall a. EMap a -> LBMap (EMap a)
emLet EMap a
m) }
      go HsLamCase{} = forall a. String -> a
missingSyntax String
"HsLamCase"
      go HsMultiIf{} = forall a. String -> a
missingSyntax String
"HsMultiIf"
      go (ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
es) = EMap a
m { emExplicitList :: ListMap EMap a
emExplicitList = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LHsExpr GhcPs]
es A a
f (forall a. EMap a -> ListMap EMap a
emExplicitList EMap a
m) }
      go ArithSeq{} = forall a. String -> a
missingSyntax String
"ArithSeq"
      go (ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
e' (HsWC XHsWC (NoGhcTc GhcPs) (LHsSigType (NoGhcTc GhcPs))
_ (L SrcSpanAnnA
_ (HsSig XHsSig GhcPs
_ HsOuterSigTyVarBndrs GhcPs
_ LHsType GhcPs
ty)))) =
        EMap a
m { emExprWithTySig :: EMap (TyMap a)
emExprWithTySig = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
e' (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty A a
f)) (forall a. EMap a -> EMap (TyMap a)
emExprWithTySig EMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XExpr{} = missingSyntax "XExpr"
      go ExprWithTySig{} = missingSyntax "ExprWithTySig"
      go HsSCC{} = missingSyntax "HsSCC"
      go HsCoreAnn{} = missingSyntax "HsCoreAnn"
      go HsTickPragma{} = missingSyntax "HsTickPragma"
      go HsWrap{} = missingSyntax "HsWrap"
#else
      go HsPragE{} = forall a. String -> a
missingSyntax String
"HsPragE"
#endif
#if __GLASGOW_HASKELL__ < 904
      go HsBracket{} = forall a. String -> a
missingSyntax String
"HsBracket"
      go HsRnBracketOut{} = forall a. String -> a
missingSyntax String
"HsRnBracketOut"
      go HsTcBracketOut{} = forall a. String -> a
missingSyntax String
"HsTcBracketOut"
      go HsSpliceE{} = forall a. String -> a
missingSyntax String
"HsSpliceE"
      go HsProc{} = forall a. String -> a
missingSyntax String
"HsProc"
      go HsStatic{} = forall a. String -> a
missingSyntax String
"HsStatic"
#else
      go HsTypedBracket{} = missingSyntax "HsTypedBracket"
      go HsUntypedBracket{} = missingSyntax "HsUntypedBracket"
      go HsSpliceE{} = missingSyntax "HsSpliceE"
#endif
#if __GLASGOW_HASKELL__ < 810
      go HsArrApp{} = missingSyntax "HsArrApp"
      go HsArrForm{} = missingSyntax "HsArrForm"
      go EWildPat{} = missingSyntax "EWildPat"
      go EAsPat{} = missingSyntax "EAsPat"
      go EViewPat{} = missingSyntax "EViewPat"
      go ELazyPat{} = missingSyntax "ELazyPat"
#endif
#if __GLASGOW_HASKELL__ < 904
      go HsTick{} = forall a. String -> a
missingSyntax String
"HsTick"
      go HsBinTick{} = forall a. String -> a
missingSyntax String
"HsBinTick"
#endif
      go HsUnboundVar{} = forall a. String -> a
missingSyntax String
"HsUnboundVar"
#if __GLASGOW_HASKELL__ < 904
      go HsRecFld{} = forall a. String -> a
missingSyntax String
"HsRecFld"
#endif
      go HsOverLabel{} = forall a. String -> a
missingSyntax String
"HsOverLabel"
      go HsAppType{} = forall a. String -> a
missingSyntax String
"HsAppType"
#if __GLASGOW_HASKELL__ < 904
      go HsConLikeOut{} = forall a. String -> a
missingSyntax String
"HsConLikeOut"
#endif
      go ExplicitSum{} = forall a. String -> a
missingSyntax String
"ExplicitSum"

  mMatch :: MatchEnv -> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key EMap
_ (Substitution
_,EMap a
EMEmpty) = []
  mMatch MatchEnv
env Key EMap
e (Substitution
hs,m :: EMap a
m@EM{}) = [(Substitution, a)]
hss forall a. [a] -> [a] -> [a]
++ HsExpr GhcPs -> (Substitution, EMap a) -> [(Substitution, a)]
go (forall l e. GenLocated l e -> e
unLoc Key EMap
e) (Substitution
hs,EMap a
m)
    where
      hss :: [(Substitution, a)]
hss = forall a.
Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult (forall a. EMap a -> Map RdrName a
emHole EMap a
m) (AnnotatedHsExpr -> HoleVal
HoleExpr forall a b. (a -> b) -> a -> b
$ MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env Key EMap
e) Substitution
hs

      go :: HsExpr GhcPs -> (Substitution, EMap a) -> [(Substitution, a)]
go (ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
as Boxity
b) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> BoxityMap (ListMap TupArgMap a)
emExplicitTuple forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Boxity
b forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [HsTupArg GhcPs]
as
      go (HsApp XApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
r) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (EMap a)
emApp forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
l forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
r
      go (HsCase XCase GhcPs
_ LHsExpr GhcPs
s MatchGroup GhcPs (LHsExpr GhcPs)
mg) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (MGMap a)
emCase forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
s forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env MatchGroup GhcPs (LHsExpr GhcPs)
mg
      go (HsDo XDo GhcPs
_ HsStmtContext (HsDoRn GhcPs)
sc XRec GhcPs [ExprLStmt GhcPs]
ss) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> SCMap (SLMap a)
emDo forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsStmtContext (HsDoRn GhcPs)
sc forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall l e. GenLocated l e -> e
unLoc XRec GhcPs [ExprLStmt GhcPs]
ss)
#if __GLASGOW_HASKELL__ < 900
      go (HsIf _ _ c tr fl) =
#else
      go (HsIf XIf GhcPs
_ LHsExpr GhcPs
c LHsExpr GhcPs
tr LHsExpr GhcPs
fl) =
#endif
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (EMap (EMap a))
emIf forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
c forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
tr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
fl
      go (HsIPVar XIPVar GhcPs
_ (HsIPName FastString
ip)) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> FSEnv a
emIPVar forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env FastString
ip
      go (HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> MGMap a
emLam forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env MatchGroup GhcPs (LHsExpr GhcPs)
mg
      go (HsLit XLitE GhcPs
_ HsLit GhcPs
l) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> LMap a
emLit forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsLit GhcPs
l
      go (HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
ol) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> OLMap a
emOverLit forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
ol)
#if __GLASGOW_HASKELL__ < 904
      go (HsPar XPar GhcPs
_ LHsExpr GhcPs
e') = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap a
emPar forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
e'
#else
      go (HsPar _ _ e' _) = mapFor emPar >=> mMatch env e'
#endif
      go (HsVar XVar GhcPs
_ LIdP GhcPs
v) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> VMap a
emVar forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
v)
      go (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r) =
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (EMap (EMap a))
emOpApp forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
o forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
l forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
r
      go (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e' SyntaxExpr GhcPs
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap a
emNegApp forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
e'
#if __GLASGOW_HASKELL__ < 904
      go (RecordCon XRecordCon GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
v HsRecordBinds GhcPs
fs) =
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> VMap (ListMap RFMap a)
emRecordCon forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (ConLikeP GhcPs)
v) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall f arg.
RecordFieldToRdrName f =>
[LHsRecField' GhcPs f arg] -> [LHsRecField' GhcPs RdrName arg]
fieldsToRdrNames forall a b. (a -> b) -> a -> b
$ forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecordBinds GhcPs
fs)
#else
      go (RecordCon _ v fs) =
        mapFor emRecordCon >=> mMatch env (unLoc v) >=> mMatch env (rec_flds fs)
#endif
      go (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
e' Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fs) =
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (ListMap RFMap a)
emRecordUpd forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
e' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
-> [LHsRecField' GhcPs RdrName (LHsExpr GhcPs)]
fieldsToRdrNamesUpd Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fs)
      go (SectionL XSectionL GhcPs
_ LHsExpr GhcPs
lhs LHsExpr GhcPs
o) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (EMap a)
emSecL forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
o forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
lhs
      go (SectionR XSectionR GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
rhs) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (EMap a)
emSecR forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
o forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
rhs
#if __GLASGOW_HASKELL__ < 904
      go (HsLet XLet GhcPs
_ HsLocalBinds GhcPs
lbs LHsExpr GhcPs
e') =
#else
      go (HsLet _ _ lbs _ e') =
#endif
        let
          bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
          env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
bs
        in forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> LBMap (EMap a)
emLet forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsLocalBinds GhcPs
lbs forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' LHsExpr GhcPs
e'
      go (ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
es) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> ListMap EMap a
emExplicitList forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LHsExpr GhcPs]
es
      go (ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
e' (HsWC XHsWC (NoGhcTc GhcPs) (LHsSigType (NoGhcTc GhcPs))
_ (L SrcSpanAnnA
_ (HsSig XHsSig GhcPs
_ HsOuterSigTyVarBndrs GhcPs
_ LHsType GhcPs
ty)))) =
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. EMap a -> EMap (TyMap a)
emExprWithTySig forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
e' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty
      go HsExpr GhcPs
_ = forall a b. a -> b -> a
const [] -- TODO remove

-- Add the matched expression to the holes map, fails if expression differs from one already in hole.
extendResult :: Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult :: forall a.
Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult Map RdrName a
hm HoleVal
v Substitution
sub = forall a. [Maybe a] -> [a]
catMaybes
  [ case FastString -> Substitution -> Maybe HoleVal
lookupSubst FastString
n Substitution
sub of
      Maybe HoleVal
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Substitution -> FastString -> HoleVal -> Substitution
extendSubst Substitution
sub FastString
n HoleVal
v, a
x)
      Just HoleVal
v' -> HoleVal -> HoleVal -> Maybe ()
sameHoleValue HoleVal
v HoleVal
v' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Substitution
sub, a
x)
  | (RdrName
nm,a
x) <- forall k v. Map k v -> [(k, v)]
mapAssocs Map RdrName a
hm, let n :: FastString
n = RdrName -> FastString
rdrFS RdrName
nm ]

singleton :: [a] -> Maybe a
singleton :: forall a. [a] -> Maybe a
singleton [a
x] = forall a. a -> Maybe a
Just a
x
singleton [a]
_  = forall a. Maybe a
Nothing

-- | Determine if two expressions are alpha-equivalent.
sameHoleValue :: HoleVal -> HoleVal -> Maybe ()
sameHoleValue :: HoleVal -> HoleVal -> Maybe ()
sameHoleValue (HoleExpr AnnotatedHsExpr
e1)  (HoleExpr AnnotatedHsExpr
e2)  =
  forall (m :: * -> *).
PatternMap m =>
Key m -> Key m -> m () -> Maybe ()
alphaEquivalent (forall ast. Annotated ast -> ast
astA AnnotatedHsExpr
e1) (forall ast. Annotated ast -> ast
astA AnnotatedHsExpr
e2) forall a. EMap a
EMEmpty
sameHoleValue (HolePat AnnotatedPat
p1)   (HolePat AnnotatedPat
p2)   =
  forall (m :: * -> *).
PatternMap m =>
Key m -> Key m -> m () -> Maybe ()
alphaEquivalent (forall (p :: Pass). LPat (GhcPass p) -> LPat (GhcPass p)
cLPat forall a b. (a -> b) -> a -> b
$ forall ast. Annotated ast -> ast
astA AnnotatedPat
p1) (forall (p :: Pass). LPat (GhcPass p) -> LPat (GhcPass p)
cLPat forall a b. (a -> b) -> a -> b
$ forall ast. Annotated ast -> ast
astA AnnotatedPat
p2) forall a. PatMap a
PatEmpty
sameHoleValue (HoleType AnnotatedHsType
ty1) (HoleType AnnotatedHsType
ty2) =
  forall (m :: * -> *).
PatternMap m =>
Key m -> Key m -> m () -> Maybe ()
alphaEquivalent (forall ast. Annotated ast -> ast
astA AnnotatedHsType
ty1) (forall ast. Annotated ast -> ast
astA AnnotatedHsType
ty2) forall a. TyMap a
TyEmpty
sameHoleValue HoleVal
_              HoleVal
_              = forall a. Maybe a
Nothing

alphaEquivalent :: PatternMap m => Key m -> Key m -> m () -> Maybe ()
alphaEquivalent :: forall (m :: * -> *).
PatternMap m =>
Key m -> Key m -> m () -> Maybe ()
alphaEquivalent Key m
v1 Key m
v2 m ()
e = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
singleton (forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> m a -> [(Substitution, a)]
findMatch MatchEnv
env Key m
v2 m ()
m)
  where
    m :: m ()
m = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> a -> m a -> m a
insertMatch AlphaEnv
emptyAlphaEnv Quantifiers
emptyQs Key m
v1 () m ()
e
    env :: MatchEnv
env = AlphaEnv -> (forall a. a -> Annotated a) -> MatchEnv
ME AlphaEnv
emptyAlphaEnv forall {p} {a}. p -> a
err
    err :: p -> a
err p
_ = forall a. HasCallStack => String -> a
error String
"hole prune during alpha-equivalence check is impossible!"

------------------------------------------------------------------------

data SCMap a
  = SCEmpty
  | SCM { forall a. SCMap a -> MaybeMap a
scmListComp :: MaybeMap a
        , forall a. SCMap a -> MaybeMap a
scmMonadComp :: MaybeMap a
#if __GLASGOW_HASKELL__ < 900
        , scmDoExpr :: MaybeMap a
#else
        , forall a. SCMap a -> FSEnv a
scmDoExpr :: FSEnv a -- We use empty string when modulename is Nothing
#endif
        -- TODO: the rest
        }
  deriving (forall a b. a -> SCMap b -> SCMap a
forall a b. (a -> b) -> SCMap a -> SCMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SCMap b -> SCMap a
$c<$ :: forall a b. a -> SCMap b -> SCMap a
fmap :: forall a b. (a -> b) -> SCMap a -> SCMap b
$cfmap :: forall a b. (a -> b) -> SCMap a -> SCMap b
Functor)

emptySCMapWrapper :: SCMap a
emptySCMapWrapper :: forall a. SCMap a
emptySCMapWrapper = forall a. MaybeMap a -> MaybeMap a -> FSEnv a -> SCMap a
SCM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap SCMap where
#if __GLASGOW_HASKELL__ < 900
  type Key SCMap = HsStmtContext Name -- see comment on HsDo in GHC
#elif __GLASGOW_HASKELL__ < 902
  type Key SCMap = HsStmtContext GhcRn
#elif __GLASGOW_HASKELL__ < 904
  type Key SCMap = HsStmtContext (HsDoRn GhcPs)
#else
  type Key SCMap = HsDoFlavour
#endif

  mEmpty :: SCMap a
  mEmpty :: forall a. SCMap a
mEmpty = forall a. SCMap a
SCEmpty

  mUnion :: SCMap a -> SCMap a -> SCMap a
  mUnion :: forall a. SCMap a -> SCMap a -> SCMap a
mUnion SCMap a
SCEmpty SCMap a
m = SCMap a
m
  mUnion SCMap a
m SCMap a
SCEmpty = SCMap a
m
  mUnion SCMap a
m1 SCMap a
m2 = SCM
    { scmListComp :: MaybeMap a
scmListComp = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SCMap a -> MaybeMap a
scmListComp SCMap a
m1 SCMap a
m2
    , scmMonadComp :: MaybeMap a
scmMonadComp = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SCMap a -> MaybeMap a
scmMonadComp SCMap a
m1 SCMap a
m2
    , scmDoExpr :: FSEnv a
scmDoExpr = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SCMap a -> FSEnv a
scmDoExpr SCMap a
m1 SCMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key SCMap -> A a -> SCMap a -> SCMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key SCMap -> A a -> SCMap a -> SCMap a
mAlter AlphaEnv
env Quantifiers
vs Key SCMap
sc A a
f SCMap a
SCEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key SCMap
sc A a
f forall a. SCMap a
emptySCMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key SCMap
sc A a
f m :: SCMap a
m@SCM{} = HsStmtContext GhcRn -> SCMap a
go Key SCMap
sc
    where
      go :: HsStmtContext GhcRn -> SCMap a
go HsStmtContext GhcRn
ListComp = SCMap a
m { scmListComp :: MaybeMap a
scmListComp = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. SCMap a -> MaybeMap a
scmListComp SCMap a
m) }
      go HsStmtContext GhcRn
MonadComp = SCMap a
m { scmMonadComp :: MaybeMap a
scmMonadComp = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. SCMap a -> MaybeMap a
scmMonadComp SCMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go DoExpr = m { scmDoExpr = mAlter env vs () f (scmDoExpr m) }
#else
      go (DoExpr Maybe ModuleName
mname) = SCMap a
m { scmDoExpr :: FSEnv a
scmDoExpr = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall b a. b -> (a -> b) -> Maybe a -> b
maybe FastString
"" ModuleName -> FastString
moduleNameFS Maybe ModuleName
mname) A a
f (forall a. SCMap a -> FSEnv a
scmDoExpr SCMap a
m) }
#endif
      go MDoExpr{} = forall a. String -> a
missingSyntax String
"MDoExpr"
#if __GLASGOW_HASKELL__ < 904
      go HsStmtContext GhcRn
ArrowExpr = forall a. String -> a
missingSyntax String
"ArrowExpr"
      go (PatGuard HsMatchContext GhcRn
_) = forall a. String -> a
missingSyntax String
"PatGuard"
      go (ParStmtCtxt HsStmtContext GhcRn
_) = forall a. String -> a
missingSyntax String
"ParStmtCtxt"
      go (TransStmtCtxt HsStmtContext GhcRn
_) = forall a. String -> a
missingSyntax String
"TransStmtCtxt"
#endif
      go HsStmtContext GhcRn
GhciStmtCtxt = forall a. String -> a
missingSyntax String
"GhciStmtCtxt"

  mMatch :: MatchEnv -> Key SCMap -> (Substitution, SCMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key SCMap -> (Substitution, SCMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key SCMap
_  (Substitution
_,SCMap a
SCEmpty)  = []
  mMatch MatchEnv
env Key SCMap
sc (Substitution
hs,m :: SCMap a
m@SCM{}) = HsStmtContext GhcRn
-> (Substitution, SCMap a) -> [(Substitution, a)]
go Key SCMap
sc (Substitution
hs,SCMap a
m)
    where
      go :: HsStmtContext GhcRn
-> (Substitution, SCMap a) -> [(Substitution, a)]
go HsStmtContext GhcRn
ListComp = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SCMap a -> MaybeMap a
scmListComp forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go HsStmtContext GhcRn
MonadComp = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SCMap a -> MaybeMap a
scmMonadComp forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
#if __GLASGOW_HASKELL__ < 900
      go DoExpr = mapFor scmDoExpr >=> mMatch env ()
#else
      go (DoExpr Maybe ModuleName
mname) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SCMap a -> FSEnv a
scmDoExpr forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall b a. b -> (a -> b) -> Maybe a -> b
maybe FastString
"" ModuleName -> FastString
moduleNameFS Maybe ModuleName
mname)
#endif
      go HsStmtContext GhcRn
_ = forall a b. a -> b -> a
const [] -- TODO

------------------------------------------------------------------------

-- Note [MatchGroup]
-- A MatchGroup contains a list of argument types and a result type, but
-- these aren't available until after typechecking, so they are all placeholders
-- at this point. Also, don't care about the origin.
newtype MGMap a = MGMap { forall a. MGMap a -> ListMap MMap a
unMGMap :: ListMap MMap a }
  deriving (forall a b. a -> MGMap b -> MGMap a
forall a b. (a -> b) -> MGMap a -> MGMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MGMap b -> MGMap a
$c<$ :: forall a b. a -> MGMap b -> MGMap a
fmap :: forall a b. (a -> b) -> MGMap a -> MGMap b
$cfmap :: forall a b. (a -> b) -> MGMap a -> MGMap b
Functor)

instance PatternMap MGMap where
  type Key MGMap = MatchGroup GhcPs (LocatedA (HsExpr GhcPs))

  mEmpty :: MGMap a
  mEmpty :: forall a. MGMap a
mEmpty = forall a. ListMap MMap a -> MGMap a
MGMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: MGMap a -> MGMap a -> MGMap a
  mUnion :: forall a. MGMap a -> MGMap a -> MGMap a
mUnion (MGMap ListMap MMap a
m1) (MGMap ListMap MMap a
m2) = forall a. ListMap MMap a -> MGMap a
MGMap (forall (m :: * -> *) a. PatternMap m => m a -> m a -> m a
mUnion ListMap MMap a
m1 ListMap MMap a
m2)

  mAlter :: AlphaEnv -> Quantifiers -> Key MGMap -> A a -> MGMap a -> MGMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key MGMap -> A a -> MGMap a -> MGMap a
mAlter AlphaEnv
env Quantifiers
vs Key MGMap
mg A a
f (MGMap ListMap MMap a
m) = forall a. ListMap MMap a -> MGMap a
MGMap (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [Match GhcPs (LocatedA (HsExpr GhcPs))]
alts A a
f ListMap MMap a
m)
    where alts :: [Match GhcPs (LocatedA (HsExpr GhcPs))]
alts = forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc (forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts Key MGMap
mg)

  mMatch :: MatchEnv -> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
mMatch MatchEnv
env Key MGMap
mg = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. MGMap a -> ListMap MMap a
unMGMap forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [Match GhcPs (LocatedA (HsExpr GhcPs))]
alts
    where alts :: [Match GhcPs (LocatedA (HsExpr GhcPs))]
alts = forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc (forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts Key MGMap
mg)

------------------------------------------------------------------------

newtype MMap a = MMap { forall a. MMap a -> ListMap PatMap (GRHSSMap a)
unMMap :: ListMap PatMap (GRHSSMap a) }
  deriving (forall a b. a -> MMap b -> MMap a
forall a b. (a -> b) -> MMap a -> MMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MMap b -> MMap a
$c<$ :: forall a b. a -> MMap b -> MMap a
fmap :: forall a b. (a -> b) -> MMap a -> MMap b
$cfmap :: forall a b. (a -> b) -> MMap a -> MMap b
Functor)

instance PatternMap MMap where
  type Key MMap = Match GhcPs (LocatedA (HsExpr GhcPs))

  mEmpty :: MMap a
  mEmpty :: forall a. MMap a
mEmpty = forall a. ListMap PatMap (GRHSSMap a) -> MMap a
MMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: MMap a -> MMap a -> MMap a
  mUnion :: forall a. MMap a -> MMap a -> MMap a
mUnion (MMap ListMap PatMap (GRHSSMap a)
m1) (MMap ListMap PatMap (GRHSSMap a)
m2) = forall a. ListMap PatMap (GRHSSMap a) -> MMap a
MMap (forall (m :: * -> *) a. PatternMap m => m a -> m a -> m a
mUnion ListMap PatMap (GRHSSMap a)
m1 ListMap PatMap (GRHSSMap a)
m2)

  mAlter :: AlphaEnv -> Quantifiers -> Key MMap -> A a -> MMap a -> MMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key MMap -> A a -> MMap a -> MMap a
mAlter AlphaEnv
env Quantifiers
vs Key MMap
match A a
f (MMap ListMap PatMap (GRHSSMap a)
m) =
    let lpats :: [LPat GhcPs]
lpats = forall p body. Match p body -> [LPat p]
m_pats Key MMap
match
        pbs :: [IdP GhcPs]
pbs = forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders forall p. CollectFlag p
CollNoDictBinders [LPat GhcPs]
lpats
        env' :: AlphaEnv
env' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
pbs
        vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
pbs
    in forall a. ListMap PatMap (GRHSSMap a) -> MMap a
MMap (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LPat GhcPs]
lpats
              (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' (forall p body. Match p body -> GRHSs p body
m_grhss Key MMap
match) A a
f)) ListMap PatMap (GRHSSMap a)
m)

  mMatch :: MatchEnv -> Key MMap -> (Substitution, MMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key MMap -> (Substitution, MMap a) -> [(Substitution, a)]
mMatch MatchEnv
env Key MMap
match = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. MMap a -> ListMap PatMap (GRHSSMap a)
unMMap forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LPat GhcPs]
lpats forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' (forall p body. Match p body -> GRHSs p body
m_grhss Key MMap
match)
    where
      lpats :: [LPat GhcPs]
lpats = forall p body. Match p body -> [LPat p]
m_pats Key MMap
match
      pbs :: [IdP GhcPs]
pbs = forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders forall p. CollectFlag p
CollNoDictBinders [LPat GhcPs]
lpats
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
pbs

------------------------------------------------------------------------

data CDMap a
  = CDEmpty
  | CDMap { forall a. CDMap a -> ListMap PatMap a
cdPrefixCon :: ListMap PatMap a
          -- TODO , cdRecCon    :: MaybeMap a
          , forall a. CDMap a -> PatMap (PatMap a)
cdInfixCon  :: PatMap (PatMap a)
          }
  deriving (forall a b. a -> CDMap b -> CDMap a
forall a b. (a -> b) -> CDMap a -> CDMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CDMap b -> CDMap a
$c<$ :: forall a b. a -> CDMap b -> CDMap a
fmap :: forall a b. (a -> b) -> CDMap a -> CDMap b
$cfmap :: forall a b. (a -> b) -> CDMap a -> CDMap b
Functor)

emptyCDMapWrapper :: CDMap a
emptyCDMapWrapper :: forall a. CDMap a
emptyCDMapWrapper = forall a. ListMap PatMap a -> PatMap (PatMap a) -> CDMap a
CDMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap CDMap where
#if __GLASGOW_HASKELL__ < 810
  type Key CDMap = HsConDetails (LPat GhcPs) (HsRecFields GhcPs (LPat GhcPs))
#else
  -- We must manually expand 'LPat' to avoid UndecidableInstances in GHC 8.10+
  type Key CDMap = HsConDetails (HsPatSigType GhcPs) (LocatedA (Pat GhcPs)) (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
  -- type HsConPatDetails p = HsConDetails (HsPatSigType (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))

#endif

  mEmpty :: CDMap a
  mEmpty :: forall a. CDMap a
mEmpty = forall a. CDMap a
CDEmpty

  mUnion :: CDMap a -> CDMap a -> CDMap a
  mUnion :: forall a. CDMap a -> CDMap a -> CDMap a
mUnion CDMap a
CDEmpty CDMap a
m = CDMap a
m
  mUnion CDMap a
m CDMap a
CDEmpty = CDMap a
m
  mUnion CDMap a
m1 CDMap a
m2 = CDMap
    { cdPrefixCon :: ListMap PatMap a
cdPrefixCon = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. CDMap a -> ListMap PatMap a
cdPrefixCon CDMap a
m1 CDMap a
m2
    , cdInfixCon :: PatMap (PatMap a)
cdInfixCon = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. CDMap a -> PatMap (PatMap a)
cdInfixCon CDMap a
m1 CDMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key CDMap -> A a -> CDMap a -> CDMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key CDMap -> A a -> CDMap a -> CDMap a
mAlter AlphaEnv
env Quantifiers
vs Key CDMap
d A a
f CDMap a
CDEmpty   = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key CDMap
d A a
f forall a. CDMap a
emptyCDMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key CDMap
d A a
f m :: CDMap a
m@CDMap{} = HsConDetails
  (HsPatSigType GhcPs)
  (LocatedA (Pat GhcPs))
  (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
-> CDMap a
go Key CDMap
d
    where
      go :: HsConDetails
  (HsPatSigType GhcPs)
  (LocatedA (Pat GhcPs))
  (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
-> CDMap a
go (PrefixCon [HsPatSigType GhcPs]
tyargs [LocatedA (Pat GhcPs)]
ps) = CDMap a
m { cdPrefixCon :: ListMap PatMap a
cdPrefixCon = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LocatedA (Pat GhcPs)]
ps A a
f (forall a. CDMap a -> ListMap PatMap a
cdPrefixCon CDMap a
m) }
      go (RecCon HsRecFields GhcPs (LocatedA (Pat GhcPs))
_) = forall a. String -> a
missingSyntax String
"RecCon"
      go (InfixCon LocatedA (Pat GhcPs)
p1 LocatedA (Pat GhcPs)
p2) = CDMap a
m { cdInfixCon :: PatMap (PatMap a)
cdInfixCon = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LocatedA (Pat GhcPs)
p1
                                              (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LocatedA (Pat GhcPs)
p2 A a
f))
                                              (forall a. CDMap a -> PatMap (PatMap a)
cdInfixCon CDMap a
m) }

  mMatch :: MatchEnv -> Key CDMap -> (Substitution, CDMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key CDMap -> (Substitution, CDMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key CDMap
_ (Substitution
_ ,CDMap a
CDEmpty)   = []
  mMatch MatchEnv
env Key CDMap
d (Substitution
hs,m :: CDMap a
m@CDMap{}) = HsConDetails
  (HsPatSigType GhcPs)
  (LocatedA (Pat GhcPs))
  (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
-> (Substitution, CDMap a) -> [(Substitution, a)]
go Key CDMap
d (Substitution
hs,CDMap a
m)
    where
      go :: HsConDetails
  (HsPatSigType GhcPs)
  (LocatedA (Pat GhcPs))
  (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
-> (Substitution, CDMap a) -> [(Substitution, a)]
go (PrefixCon [HsPatSigType GhcPs]
tyargs [LocatedA (Pat GhcPs)]
ps) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. CDMap a -> ListMap PatMap a
cdPrefixCon forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LocatedA (Pat GhcPs)]
ps
      go (InfixCon LocatedA (Pat GhcPs)
p1 LocatedA (Pat GhcPs)
p2) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. CDMap a -> PatMap (PatMap a)
cdInfixCon forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LocatedA (Pat GhcPs)
p1 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LocatedA (Pat GhcPs)
p2
      go HsConDetails
  (HsPatSigType GhcPs)
  (LocatedA (Pat GhcPs))
  (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
_ = forall a b. a -> b -> a
const [] -- TODO

------------------------------------------------------------------------

-- Note [Variable Binders]
-- We don't actually care about the variable name, since we are checking for
-- alpha-equivalence.

data PatMap a
  = PatEmpty
  | PatMap { forall a. PatMap a -> Map RdrName a
pmHole :: Map RdrName a -- See Note [Holes]
           , forall a. PatMap a -> MaybeMap a
pmWild :: MaybeMap a
           , forall a. PatMap a -> MaybeMap a
pmVar  :: MaybeMap a -- See Note [Variable Binders]
           , forall a. PatMap a -> PatMap a
pmParPat :: PatMap a
           , forall a. PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat :: BoxityMap (ListMap PatMap a)
           , forall a. PatMap a -> FSEnv (CDMap a)
pmConPatIn :: FSEnv (CDMap a)
           -- TODO: the rest
           }
  deriving (forall a b. a -> PatMap b -> PatMap a
forall a b. (a -> b) -> PatMap a -> PatMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PatMap b -> PatMap a
$c<$ :: forall a b. a -> PatMap b -> PatMap a
fmap :: forall a b. (a -> b) -> PatMap a -> PatMap b
$cfmap :: forall a b. (a -> b) -> PatMap a -> PatMap b
Functor)

emptyPatMapWrapper :: PatMap a
emptyPatMapWrapper :: forall a. PatMap a
emptyPatMapWrapper = forall a.
Map RdrName a
-> MaybeMap a
-> MaybeMap a
-> PatMap a
-> BoxityMap (ListMap PatMap a)
-> FSEnv (CDMap a)
-> PatMap a
PatMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap PatMap where
#if __GLASGOW_HASKELL__ < 810
  type Key PatMap = LPat GhcPs
#else
  -- We must manually expand 'LPat' to avoid UndecidableInstances in GHC 8.10+
  type Key PatMap = LocatedA (Pat GhcPs)
#endif

  mEmpty :: PatMap a
  mEmpty :: forall a. PatMap a
mEmpty = forall a. PatMap a
PatEmpty

  mUnion :: PatMap a -> PatMap a -> PatMap a
  mUnion :: forall a. PatMap a -> PatMap a -> PatMap a
mUnion PatMap a
PatEmpty PatMap a
m = PatMap a
m
  mUnion PatMap a
m PatMap a
PatEmpty = PatMap a
m
  mUnion PatMap a
m1 PatMap a
m2 = PatMap
    { pmHole :: Map RdrName a
pmHole = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. PatMap a -> Map RdrName a
pmHole PatMap a
m1 PatMap a
m2
    , pmWild :: MaybeMap a
pmWild = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. PatMap a -> MaybeMap a
pmWild PatMap a
m1 PatMap a
m2
    , pmVar :: MaybeMap a
pmVar = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. PatMap a -> MaybeMap a
pmVar PatMap a
m1 PatMap a
m2
    , pmParPat :: PatMap a
pmParPat = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. PatMap a -> PatMap a
pmParPat PatMap a
m1 PatMap a
m2
    , pmTuplePat :: BoxityMap (ListMap PatMap a)
pmTuplePat = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat PatMap a
m1 PatMap a
m2
    , pmConPatIn :: FSEnv (CDMap a)
pmConPatIn = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. PatMap a -> FSEnv (CDMap a)
pmConPatIn PatMap a
m1 PatMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key PatMap -> A a -> PatMap a -> PatMap a
  mAlter :: forall a.
AlphaEnv
-> Quantifiers -> Key PatMap -> A a -> PatMap a -> PatMap a
mAlter AlphaEnv
env Quantifiers
vs Key PatMap
pat A a
f PatMap a
PatEmpty   = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key PatMap
pat A a
f forall a. PatMap a
emptyPatMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key PatMap
pat A a
f m :: PatMap a
m@PatMap{} = Pat GhcPs -> PatMap a
go (forall l e. GenLocated l e -> e
unLoc Key PatMap
pat)
    where
      go :: Pat GhcPs -> PatMap a
go (WildPat XWildPat GhcPs
_) = PatMap a
m { pmWild :: MaybeMap a
pmWild = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. PatMap a -> MaybeMap a
pmWild PatMap a
m) }
      go (VarPat XVarPat GhcPs
_ LIdP GhcPs
v)
        | forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = PatMap a
m { pmHole :: Map RdrName a
pmHole  = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
v) A a
f (forall a. PatMap a -> Map RdrName a
pmHole PatMap a
m) }
        | Bool
otherwise        = PatMap a
m { pmVar :: MaybeMap a
pmVar   = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. PatMap a -> MaybeMap a
pmVar PatMap a
m) } -- See Note [Variable Binders]
      go LazyPat{} = forall a. String -> a
missingSyntax String
"LazyPat"
      go AsPat{} = forall a. String -> a
missingSyntax String
"AsPat"
      go BangPat{} = forall a. String -> a
missingSyntax String
"BangPat"
      go ListPat{} = forall a. String -> a
missingSyntax String
"ListPat"
#if __GLASGOW_HASKELL__ < 900
      go XPat{} = missingSyntax "XPat"
      go CoPat{} = missingSyntax "CoPat"
      go ConPatOut{} = missingSyntax "ConPatOut"
      go (ConPatIn c d) =
#else
      go (ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
c HsConPatDetails GhcPs
d) =
#endif
        PatMap a
m { pmConPatIn :: FSEnv (CDMap a)
pmConPatIn = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (RdrName -> FastString
rdrFS (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (ConLikeP GhcPs)
c)) (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsConPatDetails GhcPs
d A a
f)) (forall a. PatMap a -> FSEnv (CDMap a)
pmConPatIn PatMap a
m) }
      go ViewPat{} = forall a. String -> a
missingSyntax String
"ViewPat"
      go SplicePat{} = forall a. String -> a
missingSyntax String
"SplicePat"
      go LitPat{} = forall a. String -> a
missingSyntax String
"LitPat"
      go NPat{} = forall a. String -> a
missingSyntax String
"NPat"
      go NPlusKPat{} = forall a. String -> a
missingSyntax String
"NPlusKPat"
#if __GLASGOW_HASKELL__ < 904
      go (ParPat XParPat GhcPs
_ LPat GhcPs
p) = PatMap a
m { pmParPat :: PatMap a
pmParPat = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LPat GhcPs
p A a
f (forall a. PatMap a -> PatMap a
pmParPat PatMap a
m) }
#else
      go (ParPat _ _ p _) = m { pmParPat = mAlter env vs p f (pmParPat m) }
#endif
      go (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
ps Boxity
b) =
        PatMap a
m { pmTuplePat :: BoxityMap (ListMap PatMap a)
pmTuplePat = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Boxity
b (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LPat GhcPs]
ps A a
f)) (forall a. PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat PatMap a
m) }
      go SigPat{} = forall a. String -> a
missingSyntax String
"SigPat"
      go SumPat{} = forall a. String -> a
missingSyntax String
"SumPat"

  mMatch :: MatchEnv -> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key PatMap
_   (Substitution
_, PatMap a
PatEmpty)   = []
  mMatch MatchEnv
env Key PatMap
pat (Substitution
hs,m :: PatMap a
m@PatMap{})
    | Just lp :: LPat GhcPs
lp@(L SrcSpanAnnA
_ Pat GhcPs
p) <- forall (p :: Pass). LPat (GhcPass p) -> Maybe (LPat (GhcPass p))
dLPat Key PatMap
pat = LocatedA (Pat GhcPs) -> [(Substitution, a)]
hss LPat GhcPs
lp forall a. [a] -> [a] -> [a]
++ Pat GhcPs -> (Substitution, PatMap a) -> [(Substitution, a)]
go Pat GhcPs
p (Substitution
hs,PatMap a
m)
    | Bool
otherwise = []
    where
      hss :: LocatedA (Pat GhcPs) -> [(Substitution, a)]
hss LocatedA (Pat GhcPs)
lp = forall a.
Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult (forall a. PatMap a -> Map RdrName a
pmHole PatMap a
m) (AnnotatedPat -> HoleVal
HolePat forall a b. (a -> b) -> a -> b
$ MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env LocatedA (Pat GhcPs)
lp) Substitution
hs

      go :: Pat GhcPs -> (Substitution, PatMap a) -> [(Substitution, a)]
go (WildPat XWildPat GhcPs
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. PatMap a -> MaybeMap a
pmWild forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
#if __GLASGOW_HASKELL__ < 904
      go (ParPat XParPat GhcPs
_ LPat GhcPs
p) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. PatMap a -> PatMap a
pmParPat forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LPat GhcPs
p
#else
      go (ParPat _ _ p _) = mapFor pmParPat >=> mMatch env p
#endif
      go (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
ps Boxity
b) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Boxity
b forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LPat GhcPs]
ps
      go (VarPat XVarPat GhcPs
_ LIdP GhcPs
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. PatMap a -> MaybeMap a
pmVar forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
#if __GLASGOW_HASKELL__ < 900
      go (ConPatIn c d) =
#else
      go (ConPat XConPat GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
c HsConPatDetails GhcPs
d) =
#endif
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. PatMap a -> FSEnv (CDMap a)
pmConPatIn forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (RdrName -> FastString
rdrFS (forall l e. GenLocated l e -> e
unLoc XRec GhcPs (ConLikeP GhcPs)
c)) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsConPatDetails GhcPs
d
      go Pat GhcPs
_ = forall a b. a -> b -> a
const [] -- TODO

------------------------------------------------------------------------

newtype GRHSSMap a = GRHSSMap { forall a. GRHSSMap a -> LBMap (ListMap GRHSMap a)
unGRHSSMap :: LBMap (ListMap GRHSMap a) }
  deriving (forall a b. a -> GRHSSMap b -> GRHSSMap a
forall a b. (a -> b) -> GRHSSMap a -> GRHSSMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GRHSSMap b -> GRHSSMap a
$c<$ :: forall a b. a -> GRHSSMap b -> GRHSSMap a
fmap :: forall a b. (a -> b) -> GRHSSMap a -> GRHSSMap b
$cfmap :: forall a b. (a -> b) -> GRHSSMap a -> GRHSSMap b
Functor)

instance PatternMap GRHSSMap where
  type Key GRHSSMap = GRHSs GhcPs (LocatedA (HsExpr GhcPs))

  mEmpty :: GRHSSMap a
  mEmpty :: forall a. GRHSSMap a
mEmpty = forall a. LBMap (ListMap GRHSMap a) -> GRHSSMap a
GRHSSMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: GRHSSMap a -> GRHSSMap a -> GRHSSMap a
  mUnion :: forall a. GRHSSMap a -> GRHSSMap a -> GRHSSMap a
mUnion (GRHSSMap LBMap (ListMap GRHSMap a)
m1) (GRHSSMap LBMap (ListMap GRHSMap a)
m2) = forall a. LBMap (ListMap GRHSMap a) -> GRHSSMap a
GRHSSMap (forall (m :: * -> *) a. PatternMap m => m a -> m a -> m a
mUnion LBMap (ListMap GRHSMap a)
m1 LBMap (ListMap GRHSMap a)
m2)

  mAlter :: AlphaEnv -> Quantifiers -> Key GRHSSMap -> A a -> GRHSSMap a -> GRHSSMap a
  mAlter :: forall a.
AlphaEnv
-> Quantifiers -> Key GRHSSMap -> A a -> GRHSSMap a -> GRHSSMap a
mAlter AlphaEnv
env Quantifiers
vs Key GRHSSMap
grhss A a
f (GRHSSMap LBMap (ListMap GRHSMap a)
m) =
    let lbs :: HsLocalBinds GhcPs
lbs = forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds Key GRHSSMap
grhss
        bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
        env' :: AlphaEnv
env' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
bs
        vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
bs
    in forall a. LBMap (ListMap GRHSMap a) -> GRHSSMap a
GRHSSMap (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsLocalBinds GhcPs
lbs
                  (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs Key GRHSSMap
grhss) A a
f)) LBMap (ListMap GRHSMap a)
m)

  mMatch :: MatchEnv -> Key GRHSSMap -> (Substitution, GRHSSMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key GRHSSMap
-> (Substitution, GRHSSMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env Key GRHSSMap
grhss = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. GRHSSMap a -> LBMap (ListMap GRHSMap a)
unGRHSSMap forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsLocalBinds GhcPs
lbs
                      forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc forall a b. (a -> b) -> a -> b
$ forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs Key GRHSSMap
grhss)
    where
      lbs :: HsLocalBinds GhcPs
lbs = forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds  Key GRHSSMap
grhss
      bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
bs

------------------------------------------------------------------------

newtype GRHSMap a = GRHSMap { forall a. GRHSMap a -> SLMap (EMap a)
unGRHSMap :: SLMap (EMap a) }
  deriving (forall a b. a -> GRHSMap b -> GRHSMap a
forall a b. (a -> b) -> GRHSMap a -> GRHSMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GRHSMap b -> GRHSMap a
$c<$ :: forall a b. a -> GRHSMap b -> GRHSMap a
fmap :: forall a b. (a -> b) -> GRHSMap a -> GRHSMap b
$cfmap :: forall a b. (a -> b) -> GRHSMap a -> GRHSMap b
Functor)

instance PatternMap GRHSMap where
  type Key GRHSMap = GRHS GhcPs (LocatedA (HsExpr GhcPs))

  mEmpty :: GRHSMap a
  mEmpty :: forall a. GRHSMap a
mEmpty = forall a. SLMap (EMap a) -> GRHSMap a
GRHSMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: GRHSMap a -> GRHSMap a -> GRHSMap a
  mUnion :: forall a. GRHSMap a -> GRHSMap a -> GRHSMap a
mUnion (GRHSMap SLMap (EMap a)
m1) (GRHSMap SLMap (EMap a)
m2) = forall a. SLMap (EMap a) -> GRHSMap a
GRHSMap (forall (m :: * -> *) a. PatternMap m => m a -> m a -> m a
mUnion SLMap (EMap a)
m1 SLMap (EMap a)
m2)

  mAlter :: AlphaEnv -> Quantifiers -> Key GRHSMap -> A a -> GRHSMap a -> GRHSMap a
#if __GLASGOW_HASKELL__ < 900
  mAlter _ _ XGRHS{} _ _ = missingSyntax "XGRHS"
#endif
  mAlter :: forall a.
AlphaEnv
-> Quantifiers -> Key GRHSMap -> A a -> GRHSMap a -> GRHSMap a
mAlter AlphaEnv
env Quantifiers
vs (GRHS XCGRHS GhcPs (LocatedA (HsExpr GhcPs))
_ [ExprLStmt GhcPs]
gs LocatedA (HsExpr GhcPs)
b) A a
f (GRHSMap SLMap (EMap a)
m) =
    let bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders forall p. CollectFlag p
CollNoDictBinders [ExprLStmt GhcPs]
gs
        env' :: AlphaEnv
env' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
bs
        vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
bs
    in forall a. SLMap (EMap a) -> GRHSMap a
GRHSMap (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [ExprLStmt GhcPs]
gs (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' LocatedA (HsExpr GhcPs)
b A a
f)) SLMap (EMap a)
m)

  mMatch :: MatchEnv -> Key GRHSMap -> (Substitution, GRHSMap a) -> [(Substitution, a)]
#if __GLASGOW_HASKELL__ < 900
  mMatch _ XGRHS{} = const []
#endif
  mMatch :: forall a.
MatchEnv
-> Key GRHSMap -> (Substitution, GRHSMap a) -> [(Substitution, a)]
mMatch MatchEnv
env (GRHS XCGRHS GhcPs (LocatedA (HsExpr GhcPs))
_ [ExprLStmt GhcPs]
gs LocatedA (HsExpr GhcPs)
b) =
    forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. GRHSMap a -> SLMap (EMap a)
unGRHSMap forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [ExprLStmt GhcPs]
gs forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' LocatedA (HsExpr GhcPs)
b
    where
      bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders forall p. CollectFlag p
CollNoDictBinders [ExprLStmt GhcPs]
gs
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
bs

------------------------------------------------------------------------

data SLMap a
  = SLEmpty
  | SLM { forall a. SLMap a -> MaybeMap a
slmNil :: MaybeMap a
        , forall a. SLMap a -> SMap (SLMap a)
slmCons :: SMap (SLMap a)
        }
  deriving (forall a b. a -> SLMap b -> SLMap a
forall a b. (a -> b) -> SLMap a -> SLMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SLMap b -> SLMap a
$c<$ :: forall a b. a -> SLMap b -> SLMap a
fmap :: forall a b. (a -> b) -> SLMap a -> SLMap b
$cfmap :: forall a b. (a -> b) -> SLMap a -> SLMap b
Functor)

emptySLMapWrapper :: SLMap a
emptySLMapWrapper :: forall a. SLMap a
emptySLMapWrapper = forall a. MaybeMap a -> SMap (SLMap a) -> SLMap a
SLM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap SLMap where
  type Key SLMap = [LocatedA (Stmt GhcPs (LocatedA (HsExpr GhcPs)))]

  mEmpty :: SLMap a
  mEmpty :: forall a. SLMap a
mEmpty = forall a. SLMap a
SLEmpty

  mUnion :: SLMap a -> SLMap a -> SLMap a
  mUnion :: forall a. SLMap a -> SLMap a -> SLMap a
mUnion SLMap a
SLEmpty SLMap a
m = SLMap a
m
  mUnion SLMap a
m SLMap a
SLEmpty = SLMap a
m
  mUnion SLMap a
m1 SLMap a
m2 = SLM
    { slmNil :: MaybeMap a
slmNil = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SLMap a -> MaybeMap a
slmNil SLMap a
m1 SLMap a
m2
    , slmCons :: SMap (SLMap a)
slmCons = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SLMap a -> SMap (SLMap a)
slmCons SLMap a
m1 SLMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key SLMap -> A a -> SLMap a -> SLMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key SLMap -> A a -> SLMap a -> SLMap a
mAlter AlphaEnv
env Quantifiers
vs Key SLMap
ss A a
f SLMap a
SLEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key SLMap
ss A a
f forall a. SLMap a
emptySLMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key SLMap
ss A a
f m :: SLMap a
m@SLM{} = [GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> SLMap a
go Key SLMap
ss
    where
      go :: [GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> SLMap a
go []      = SLMap a
m { slmNil :: MaybeMap a
slmNil = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. SLMap a -> MaybeMap a
slmNil SLMap a
m) }
      go (GenLocated
  (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
  (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
s:[GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
ss') =
        let
          bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders forall p. CollectFlag p
CollNoDictBinders GenLocated
  (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
  (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
s
          env' :: AlphaEnv
env' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
bs
          vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
bs
        in SLMap a
m { slmCons :: SMap (SLMap a)
slmCons = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs GenLocated
  (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
  (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
s (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' [GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
ss' A a
f)) (forall a. SLMap a -> SMap (SLMap a)
slmCons SLMap a
m) }

  mMatch :: MatchEnv -> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key SLMap
_  (Substitution
_,SLMap a
SLEmpty)  = []
  mMatch MatchEnv
env Key SLMap
ss (Substitution
hs,m :: SLMap a
m@SLM{}) = [GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> (Substitution, SLMap a) -> [(Substitution, a)]
go Key SLMap
ss (Substitution
hs,SLMap a
m)
    where
      go :: [GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
-> (Substitution, SLMap a) -> [(Substitution, a)]
go [] = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SLMap a -> MaybeMap a
slmNil forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go (GenLocated
  (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
  (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
s:[GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
ss') =
        let
          bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders forall p. CollectFlag p
CollNoDictBinders GenLocated
  (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
  (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
s
          env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
bs
        in forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SLMap a -> SMap (SLMap a)
slmCons forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated
  (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
  (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))
s forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' [GenLocated
   (Anno (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))))
   (StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)))]
ss'

------------------------------------------------------------------------

-- Note [Local Binds]
-- We simplify this a bit here, assuming always ValBindsIn (because ValBindsOut
-- only shows up after renaming. Also we ignore the [LSig] for now.

data LBMap a
  = LBEmpty
  | LB { forall a. LBMap a -> ListMap BMap a
lbValBinds :: ListMap BMap a -- see Note [Local Binds]
       -- TODO: , lbIPBinds ::
       , forall a. LBMap a -> MaybeMap a
lbEmpty :: MaybeMap a
       }
  deriving (forall a b. a -> LBMap b -> LBMap a
forall a b. (a -> b) -> LBMap a -> LBMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LBMap b -> LBMap a
$c<$ :: forall a b. a -> LBMap b -> LBMap a
fmap :: forall a b. (a -> b) -> LBMap a -> LBMap b
$cfmap :: forall a b. (a -> b) -> LBMap a -> LBMap b
Functor)

emptyLBMapWrapper :: LBMap a
emptyLBMapWrapper :: forall a. LBMap a
emptyLBMapWrapper = forall a. ListMap BMap a -> MaybeMap a -> LBMap a
LB forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap LBMap where
  type Key LBMap = HsLocalBinds GhcPs

  mEmpty :: LBMap a
  mEmpty :: forall a. LBMap a
mEmpty = forall a. LBMap a
LBEmpty

  mUnion :: LBMap a -> LBMap a -> LBMap a
  mUnion :: forall a. LBMap a -> LBMap a -> LBMap a
mUnion LBMap a
LBEmpty LBMap a
m = LBMap a
m
  mUnion LBMap a
m LBMap a
LBEmpty = LBMap a
m
  mUnion LBMap a
m1 LBMap a
m2 = LB
    { lbValBinds :: ListMap BMap a
lbValBinds = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LBMap a -> ListMap BMap a
lbValBinds LBMap a
m1 LBMap a
m2
    , lbEmpty :: MaybeMap a
lbEmpty = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. LBMap a -> MaybeMap a
lbEmpty LBMap a
m1 LBMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key LBMap -> A a -> LBMap a -> LBMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key LBMap -> A a -> LBMap a -> LBMap a
mAlter AlphaEnv
env Quantifiers
vs Key LBMap
lbs A a
f LBMap a
LBEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key LBMap
lbs A a
f forall a. LBMap a
emptyLBMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key LBMap
lbs A a
f m :: LBMap a
m@LB{}  = HsLocalBinds GhcPs -> LBMap a
go Key LBMap
lbs
    where
      go :: HsLocalBinds GhcPs -> LBMap a
go (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = LBMap a
m { lbEmpty :: MaybeMap a
lbEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. LBMap a -> MaybeMap a
lbEmpty LBMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XHsLocalBindsLR{} = missingSyntax "XHsLocalBindsLR"
#endif
      go (HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
vbs) =
        let
          bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsValBinders forall p. CollectFlag p
CollNoDictBinders HsValBindsLR GhcPs GhcPs
vbs
          env' :: AlphaEnv
env' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
bs
          vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
bs
        in LBMap a
m { lbValBinds :: ListMap BMap a
lbValBinds = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' (HsValBindsLR GhcPs GhcPs -> [HsBind GhcPs]
deValBinds HsValBindsLR GhcPs GhcPs
vbs) A a
f (forall a. LBMap a -> ListMap BMap a
lbValBinds LBMap a
m) }
      go HsIPBinds{} = forall a. String -> a
missingSyntax String
"HsIPBinds"

  mMatch :: MatchEnv -> Key LBMap -> (Substitution, LBMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key LBMap -> (Substitution, LBMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key LBMap
_   (Substitution
_,LBMap a
LBEmpty) = []
  mMatch MatchEnv
env Key LBMap
lbs (Substitution
hs,m :: LBMap a
m@LB{}) = HsLocalBinds GhcPs
-> (Substitution, LBMap a) -> [(Substitution, a)]
go Key LBMap
lbs (Substitution
hs,LBMap a
m)
    where
      go :: HsLocalBinds GhcPs
-> (Substitution, LBMap a) -> [(Substitution, a)]
go (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LBMap a -> MaybeMap a
lbEmpty forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go (HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
vbs) =
        let
          bs :: [IdP GhcPs]
bs = forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsValBinders forall p. CollectFlag p
CollNoDictBinders HsValBindsLR GhcPs GhcPs
vbs
          env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
bs
        in forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. LBMap a -> ListMap BMap a
lbValBinds forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' (HsValBindsLR GhcPs GhcPs -> [HsBind GhcPs]
deValBinds HsValBindsLR GhcPs GhcPs
vbs)
      go HsLocalBinds GhcPs
_ = forall a b. a -> b -> a
const [] -- TODO

deValBinds :: HsValBinds GhcPs -> [HsBind GhcPs]
deValBinds :: HsValBindsLR GhcPs GhcPs -> [HsBind GhcPs]
deValBinds (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
lbs [LSig GhcPs]
_) = forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc (forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
lbs)
deValBinds HsValBindsLR GhcPs GhcPs
_ = forall a. HasCallStack => String -> a
error String
"deValBinds ValBindsOut"

------------------------------------------------------------------------

-- Note [Bind env]
-- We don't extend the env because it was already done at the LBMap level
-- (because all bindings are available to the recursive group).

data BMap a
  = BMEmpty
  | BM { forall a. BMap a -> MGMap a
bmFunBind :: MGMap a
       , forall a. BMap a -> EMap a
bmVarBind :: EMap a
       , forall a. BMap a -> PatMap (GRHSSMap a)
bmPatBind :: PatMap (GRHSSMap a)
       -- TODO: rest
       }
  deriving (forall a b. a -> BMap b -> BMap a
forall a b. (a -> b) -> BMap a -> BMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BMap b -> BMap a
$c<$ :: forall a b. a -> BMap b -> BMap a
fmap :: forall a b. (a -> b) -> BMap a -> BMap b
$cfmap :: forall a b. (a -> b) -> BMap a -> BMap b
Functor)

emptyBMapWrapper :: BMap a
emptyBMapWrapper :: forall a. BMap a
emptyBMapWrapper = forall a. MGMap a -> EMap a -> PatMap (GRHSSMap a) -> BMap a
BM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap BMap where
  type Key BMap = HsBind GhcPs

  mEmpty :: BMap a
  mEmpty :: forall a. BMap a
mEmpty = forall a. BMap a
BMEmpty

  mUnion :: BMap a -> BMap a -> BMap a
  mUnion :: forall a. BMap a -> BMap a -> BMap a
mUnion BMap a
BMEmpty BMap a
m = BMap a
m
  mUnion BMap a
m BMap a
BMEmpty = BMap a
m
  mUnion BMap a
m1 BMap a
m2 = BM
    { bmFunBind :: MGMap a
bmFunBind = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. BMap a -> MGMap a
bmFunBind BMap a
m1 BMap a
m2
    , bmVarBind :: EMap a
bmVarBind = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. BMap a -> EMap a
bmVarBind BMap a
m1 BMap a
m2
    , bmPatBind :: PatMap (GRHSSMap a)
bmPatBind = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. BMap a -> PatMap (GRHSSMap a)
bmPatBind BMap a
m1 BMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key BMap -> A a -> BMap a -> BMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key BMap -> A a -> BMap a -> BMap a
mAlter AlphaEnv
env Quantifiers
vs Key BMap
b A a
f BMap a
BMEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key BMap
b A a
f forall a. BMap a
emptyBMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key BMap
b A a
f m :: BMap a
m@BM{}  = HsBind GhcPs -> BMap a
go Key BMap
b
    where -- see Note [Bind env]
#if __GLASGOW_HASKELL__ < 900
      go XHsBindsLR{} = missingSyntax "XHsBindsLR"
      go (FunBind _ _ mg _ _) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
      go (VarBind _ _ e _) = m { bmVarBind = mAlter env vs e f (bmVarBind m) }
#else
      go :: HsBind GhcPs -> BMap a
go (FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg [CoreTickish]
_) = BMap a
m { bmFunBind :: MGMap a
bmFunBind = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs MatchGroup GhcPs (LHsExpr GhcPs)
mg A a
f (forall a. BMap a -> MGMap a
bmFunBind BMap a
m) }
      go (VarBind XVarBind GhcPs GhcPs
_ IdP GhcPs
_ LHsExpr GhcPs
e) = BMap a
m { bmVarBind :: EMap a
bmVarBind = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
e A a
f (forall a. BMap a -> EMap a
bmVarBind BMap a
m) }
#endif
      go (PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
lhs GRHSs GhcPs (LHsExpr GhcPs)
rhs ([CoreTickish], [[CoreTickish]])
_) =
        BMap a
m { bmPatBind :: PatMap (GRHSSMap a)
bmPatBind = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LPat GhcPs
lhs
              (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs GRHSs GhcPs (LHsExpr GhcPs)
rhs A a
f) (forall a. BMap a -> PatMap (GRHSSMap a)
bmPatBind BMap a
m) }
#if __GLASGOW_HASKELL__ < 904
      go AbsBinds{} = forall a. String -> a
missingSyntax String
"AbsBinds"
#endif
      go PatSynBind{} = forall a. String -> a
missingSyntax String
"PatSynBind"

  mMatch :: MatchEnv -> Key BMap -> (Substitution, BMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key BMap -> (Substitution, BMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key BMap
_ (Substitution
_,BMap a
BMEmpty) = []
  mMatch MatchEnv
env Key BMap
b (Substitution
hs,m :: BMap a
m@BM{}) = HsBind GhcPs -> (Substitution, BMap a) -> [(Substitution, a)]
go Key BMap
b (Substitution
hs,BMap a
m)
    where
#if __GLASGOW_HASKELL__ < 900
      go (FunBind _ _ mg _ _) = mapFor bmFunBind >=> mMatch env mg
      go (VarBind _ _ e _) = mapFor bmVarBind >=> mMatch env e
#else
      go :: HsBind GhcPs -> (Substitution, BMap a) -> [(Substitution, a)]
go (FunBind XFunBind GhcPs GhcPs
_ LIdP GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg [CoreTickish]
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. BMap a -> MGMap a
bmFunBind forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env MatchGroup GhcPs (LHsExpr GhcPs)
mg
      go (VarBind XVarBind GhcPs GhcPs
_ IdP GhcPs
_ LHsExpr GhcPs
e) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. BMap a -> EMap a
bmVarBind forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
e
#endif
      go (PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
lhs GRHSs GhcPs (LHsExpr GhcPs)
rhs ([CoreTickish], [[CoreTickish]])
_)
        = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. BMap a -> PatMap (GRHSSMap a)
bmPatBind forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LPat GhcPs
lhs forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GRHSs GhcPs (LHsExpr GhcPs)
rhs
      go HsBind GhcPs
_ = forall a b. a -> b -> a
const [] -- TODO

------------------------------------------------------------------------

data SMap a
  = SMEmpty
  | SM { forall a. SMap a -> EMap a
smLastStmt :: EMap a
       , forall a. SMap a -> PatMap (EMap a)
smBindStmt :: PatMap (EMap a)
       , forall a. SMap a -> EMap a
smBodyStmt :: EMap a
         -- TODO: the rest
       }
  deriving (forall a b. a -> SMap b -> SMap a
forall a b. (a -> b) -> SMap a -> SMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SMap b -> SMap a
$c<$ :: forall a b. a -> SMap b -> SMap a
fmap :: forall a b. (a -> b) -> SMap a -> SMap b
$cfmap :: forall a b. (a -> b) -> SMap a -> SMap b
Functor)

emptySMapWrapper :: SMap a
emptySMapWrapper :: forall a. SMap a
emptySMapWrapper = forall a. EMap a -> PatMap (EMap a) -> EMap a -> SMap a
SM forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap SMap where
  type Key SMap = LocatedA (Stmt GhcPs (LocatedA (HsExpr GhcPs)))

  mEmpty :: SMap a
  mEmpty :: forall a. SMap a
mEmpty = forall a. SMap a
SMEmpty

  mUnion :: SMap a -> SMap a -> SMap a
  mUnion :: forall a. SMap a -> SMap a -> SMap a
mUnion SMap a
SMEmpty SMap a
m = SMap a
m
  mUnion SMap a
m SMap a
SMEmpty = SMap a
m
  mUnion SMap a
m1 SMap a
m2 = SM
    { smLastStmt :: EMap a
smLastStmt = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SMap a -> EMap a
smLastStmt SMap a
m1 SMap a
m2
    , smBindStmt :: PatMap (EMap a)
smBindStmt = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SMap a -> PatMap (EMap a)
smBindStmt SMap a
m1 SMap a
m2
    , smBodyStmt :: EMap a
smBodyStmt = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. SMap a -> EMap a
smBodyStmt SMap a
m1 SMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key SMap -> A a -> SMap a -> SMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key SMap -> A a -> SMap a -> SMap a
mAlter AlphaEnv
env Quantifiers
vs Key SMap
s A a
f SMap a
SMEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key SMap
s A a
f forall a. SMap a
emptySMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key SMap
s A a
f m :: SMap a
m@(SM {}) = StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> SMap a
go (forall l e. GenLocated l e -> e
unLoc Key SMap
s)
    where
      go :: StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs)) -> SMap a
go (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LocatedA (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = SMap a
m { smBodyStmt :: EMap a
smBodyStmt = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LocatedA (HsExpr GhcPs)
e A a
f (forall a. SMap a -> EMap a
smBodyStmt SMap a
m) }
      go (LastStmt XLastStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LocatedA (HsExpr GhcPs)
e Maybe Bool
_ SyntaxExpr GhcPs
_)   = SMap a
m { smLastStmt :: EMap a
smLastStmt = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LocatedA (HsExpr GhcPs)
e A a
f (forall a. SMap a -> EMap a
smLastStmt SMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XStmtLR{} = missingSyntax "XStmtLR"
      go (BindStmt _ p e _ _) =
#else
      go (BindStmt XBindStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LPat GhcPs
p LocatedA (HsExpr GhcPs)
e) =
#endif
        let bs :: [IdP GhcPs]
bs = forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders forall p. CollectFlag p
CollNoDictBinders LPat GhcPs
p
            env' :: AlphaEnv
env' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
bs
            vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
bs
        in SMap a
m { smBindStmt :: PatMap (EMap a)
smBindStmt = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LPat GhcPs
p
                              (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' LocatedA (HsExpr GhcPs)
e A a
f)) (forall a. SMap a -> PatMap (EMap a)
smBindStmt SMap a
m) }
      go LetStmt{} = forall a. String -> a
missingSyntax String
"LetStmt"
      go ParStmt{} = forall a. String -> a
missingSyntax String
"ParStmt"
      go TransStmt{} = forall a. String -> a
missingSyntax String
"TransStmt"
      go RecStmt{} = forall a. String -> a
missingSyntax String
"RecStmt"
      go ApplicativeStmt{} = forall a. String -> a
missingSyntax String
"ApplicativeStmt"

  mMatch :: MatchEnv -> Key SMap -> (Substitution, SMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key SMap -> (Substitution, SMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key SMap
_   (Substitution
_,SMap a
SMEmpty) = []
  mMatch MatchEnv
env Key SMap
s   (Substitution
hs,SMap a
m) = StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> (Substitution, SMap a) -> [(Substitution, a)]
go (forall l e. GenLocated l e -> e
unLoc Key SMap
s) (Substitution
hs,SMap a
m)
    where
      go :: StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
-> (Substitution, SMap a) -> [(Substitution, a)]
go (BodyStmt XBodyStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LocatedA (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SMap a -> EMap a
smBodyStmt forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LocatedA (HsExpr GhcPs)
e
      go (LastStmt XLastStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LocatedA (HsExpr GhcPs)
e Maybe Bool
_ SyntaxExpr GhcPs
_) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SMap a -> EMap a
smLastStmt forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LocatedA (HsExpr GhcPs)
e
#if __GLASGOW_HASKELL__ < 900
      go (BindStmt _ p e _ _) =
#else
      go (BindStmt XBindStmt GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ LPat GhcPs
p LocatedA (HsExpr GhcPs)
e) =
#endif
        let bs :: [IdP GhcPs]
bs = forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders forall p. CollectFlag p
CollNoDictBinders LPat GhcPs
p
            env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
bs
        in forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. SMap a -> PatMap (EMap a)
smBindStmt forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LPat GhcPs
p forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' LocatedA (HsExpr GhcPs)
e
      go StmtLR GhcPs GhcPs (LocatedA (HsExpr GhcPs))
_ = forall a b. a -> b -> a
const [] -- TODO

------------------------------------------------------------------------

data TyMap a
  = TyEmpty
  | TM { forall a. TyMap a -> Map RdrName a
tyHole    :: Map RdrName a -- See Note [Holes]
       , forall a. TyMap a -> VMap a
tyHsTyVar :: VMap a
       , forall a. TyMap a -> TyMap (TyMap a)
tyHsAppTy :: TyMap (TyMap a)
#if __GLASGOW_HASKELL__ < 810
       , tyHsForAllTy :: ForAllTyMap a -- See Note [Telescope]
#else
       , forall a. TyMap a -> ForallVisMap (ForAllTyMap a)
tyHsForAllTy :: ForallVisMap (ForAllTyMap a) -- See Note [Telescope]
#endif
       , forall a. TyMap a -> TyMap (TyMap a)
tyHsFunTy :: TyMap (TyMap a)
       , forall a. TyMap a -> TyMap a
tyHsListTy :: TyMap a
       , forall a. TyMap a -> TyMap a
tyHsParTy :: TyMap a
       , forall a. TyMap a -> TyMap (ListMap TyMap a)
tyHsQualTy :: TyMap (ListMap TyMap a)
       , forall a. TyMap a -> ListMap TyMap a
tyHsSumTy :: ListMap TyMap a
       , forall a. TyMap a -> TupleSortMap (ListMap TyMap a)
tyHsTupleTy :: TupleSortMap (ListMap TyMap a)
         -- TODO: the rest
       }
  deriving (forall a b. a -> TyMap b -> TyMap a
forall a b. (a -> b) -> TyMap a -> TyMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TyMap b -> TyMap a
$c<$ :: forall a b. a -> TyMap b -> TyMap a
fmap :: forall a b. (a -> b) -> TyMap a -> TyMap b
$cfmap :: forall a b. (a -> b) -> TyMap a -> TyMap b
Functor)

emptyTyMapWrapper :: TyMap a
emptyTyMapWrapper :: forall a. TyMap a
emptyTyMapWrapper = forall a.
Map RdrName a
-> VMap a
-> TyMap (TyMap a)
-> ForallVisMap (ForAllTyMap a)
-> TyMap (TyMap a)
-> TyMap a
-> TyMap a
-> TyMap (ListMap TyMap a)
-> ListMap TyMap a
-> TupleSortMap (ListMap TyMap a)
-> TyMap a
TM
  forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty
  forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap TyMap where
  type Key TyMap = LocatedA (HsType GhcPs)

  mEmpty :: TyMap a
  mEmpty :: forall a. TyMap a
mEmpty = forall a. TyMap a
TyEmpty

  mUnion :: TyMap a -> TyMap a -> TyMap a
  mUnion :: forall a. TyMap a -> TyMap a -> TyMap a
mUnion TyMap a
TyEmpty TyMap a
m = TyMap a
m
  mUnion TyMap a
m TyMap a
TyEmpty = TyMap a
m
  mUnion TyMap a
m1 TyMap a
m2 = TM
    { tyHole :: Map RdrName a
tyHole = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> Map RdrName a
tyHole TyMap a
m1 TyMap a
m2
    , tyHsTyVar :: VMap a
tyHsTyVar = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> VMap a
tyHsTyVar TyMap a
m1 TyMap a
m2
    , tyHsAppTy :: TyMap (TyMap a)
tyHsAppTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> TyMap (TyMap a)
tyHsAppTy TyMap a
m1 TyMap a
m2
    , tyHsForAllTy :: ForallVisMap (ForAllTyMap a)
tyHsForAllTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> ForallVisMap (ForAllTyMap a)
tyHsForAllTy TyMap a
m1 TyMap a
m2
    , tyHsFunTy :: TyMap (TyMap a)
tyHsFunTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> TyMap (TyMap a)
tyHsFunTy TyMap a
m1 TyMap a
m2
    , tyHsListTy :: TyMap a
tyHsListTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> TyMap a
tyHsListTy TyMap a
m1 TyMap a
m2
    , tyHsParTy :: TyMap a
tyHsParTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> TyMap a
tyHsParTy TyMap a
m1 TyMap a
m2
    , tyHsQualTy :: TyMap (ListMap TyMap a)
tyHsQualTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> TyMap (ListMap TyMap a)
tyHsQualTy TyMap a
m1 TyMap a
m2
    , tyHsSumTy :: ListMap TyMap a
tyHsSumTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> ListMap TyMap a
tyHsSumTy TyMap a
m1 TyMap a
m2
    , tyHsTupleTy :: TupleSortMap (ListMap TyMap a)
tyHsTupleTy = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TyMap a -> TupleSortMap (ListMap TyMap a)
tyHsTupleTy TyMap a
m1 TyMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key TyMap -> A a -> TyMap a -> TyMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key TyMap -> A a -> TyMap a -> TyMap a
mAlter AlphaEnv
env Quantifiers
vs Key TyMap
ty A a
f TyMap a
TyEmpty = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key TyMap
ty A a
f forall a. TyMap a
emptyTyMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key TyMap
ty A a
f m :: TyMap a
m@(TM {}) =
    HsType GhcPs -> TyMap a
go (forall l e. GenLocated l e -> e
unLoc Key TyMap
ty) -- See Note [TyVar Quantifiers]
    where
      go :: HsType GhcPs -> TyMap a
go (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ (L SrcSpanAnnN
_ RdrName
v))
        | RdrName
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = TyMap a
m { tyHole :: Map RdrName a
tyHole    = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs RdrName
v A a
f (forall a. TyMap a -> Map RdrName a
tyHole TyMap a
m) }
        | Bool
otherwise  = TyMap a
m { tyHsTyVar :: VMap a
tyHsTyVar = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs RdrName
v A a
f (forall a. TyMap a -> VMap a
tyHsTyVar TyMap a
m) }
      go HsOpTy{} = forall a. String -> a
missingSyntax String
"HsOpTy"
      go HsIParamTy{} = forall a. String -> a
missingSyntax String
"HsIParamTy"
      go HsKindSig{} = forall a. String -> a
missingSyntax String
"HsKindSig"
      go HsSpliceTy{} = forall a. String -> a
missingSyntax String
"HsSpliceTy"
      go HsDocTy{} = forall a. String -> a
missingSyntax String
"HsDocTy"
      go HsBangTy{} = forall a. String -> a
missingSyntax String
"HsBangTy"
      go HsRecTy{} = forall a. String -> a
missingSyntax String
"HsRecTy"
      go (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2) = TyMap a
m { tyHsAppTy :: TyMap (TyMap a)
tyHsAppTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty1 (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty2 A a
f)) (forall a. TyMap a -> TyMap (TyMap a)
tyHsAppTy TyMap a
m) }
#if __GLASGOW_HASKELL__ < 810
      go (HsForAllTy _ bndrs ty') = m { tyHsForAllTy = mAlter env vs (map extractBinderInfo bndrs, ty') f (tyHsForAllTy m) }
#elif __GLASGOW_HASKELL__ < 900
      go (HsForAllTy _ vis bndrs ty') =
        m { tyHsForAllTy = mAlter env vs (vis == ForallVis) (toA (mAlter env vs (map extractBinderInfo bndrs, ty') f)) (tyHsForAllTy m) }
#else
      go (HsForAllTy XForAllTy GhcPs
_ HsForAllTelescope GhcPs
vis LHsType GhcPs
ty') | (Bool
isVisible, [(RdrName, Maybe (LHsType GhcPs))]
bndrs) <- HsForAllTelescope GhcPs
-> (Bool, [(RdrName, Maybe (LHsType GhcPs))])
splitVisBinders HsForAllTelescope GhcPs
vis =
        TyMap a
m { tyHsForAllTy :: ForallVisMap (ForAllTyMap a)
tyHsForAllTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Bool
isVisible (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs ([(RdrName, Maybe (LHsType GhcPs))]
bndrs, LHsType GhcPs
ty') A a
f)) (forall a. TyMap a -> ForallVisMap (ForAllTyMap a)
tyHsForAllTy TyMap a
m) }
#endif
#if __GLASGOW_HASKELL__ < 900
      go (HsFunTy _ ty1 ty2) = m { tyHsFunTy = mAlter env vs ty1 (toA (mAlter env vs ty2 f)) (tyHsFunTy m) }
#else
      go (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2) = TyMap a
m { tyHsFunTy :: TyMap (TyMap a)
tyHsFunTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty1 (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty2 A a
f)) (forall a. TyMap a -> TyMap (TyMap a)
tyHsFunTy TyMap a
m) }
#endif
      go (HsListTy XListTy GhcPs
_ LHsType GhcPs
ty') = TyMap a
m { tyHsListTy :: TyMap a
tyHsListTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty' A a
f (forall a. TyMap a -> TyMap a
tyHsListTy TyMap a
m) }
      go (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty') = TyMap a
m { tyHsParTy :: TyMap a
tyHsParTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty' A a
f (forall a. TyMap a -> TyMap a
tyHsParTy TyMap a
m) }
      go (HsQualTy XQualTy GhcPs
_ Maybe (LHsContext GhcPs)
cons LHsType GhcPs
ty') =
#if __GLASGOW_HASKELL__ < 904
        TyMap a
m { tyHsQualTy :: TyMap (ListMap TyMap a)
tyHsQualTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
ty' (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall (p :: Pass).
Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext Maybe (LHsContext GhcPs)
cons) A a
f)) (forall a. TyMap a -> TyMap (ListMap TyMap a)
tyHsQualTy TyMap a
m) }
#else
        m { tyHsQualTy = mAlter env vs ty' (toA (mAlter env vs (fromMaybeContext (Just cons)) f)) (tyHsQualTy m) }
#endif
      go HsStarTy{} = forall a. String -> a
missingSyntax String
"HsStarTy"
      go (HsSumTy XSumTy GhcPs
_ [LHsType GhcPs]
tys) = TyMap a
m { tyHsSumTy :: ListMap TyMap a
tyHsSumTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LHsType GhcPs]
tys A a
f (forall a. TyMap a -> ListMap TyMap a
tyHsSumTy TyMap a
m) }
      go (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
ts [LHsType GhcPs]
tys) =
        TyMap a
m { tyHsTupleTy :: TupleSortMap (ListMap TyMap a)
tyHsTupleTy = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsTupleSort
ts (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LHsType GhcPs]
tys A a
f)) (forall a. TyMap a -> TupleSortMap (ListMap TyMap a)
tyHsTupleTy TyMap a
m) }
      go XHsType{} = forall a. String -> a
missingSyntax String
"XHsType"
      go HsExplicitListTy{} = forall a. String -> a
missingSyntax String
"HsExplicitListTy"
      go HsExplicitTupleTy{} = forall a. String -> a
missingSyntax String
"HsExplicitTupleTy"
      go HsTyLit{} = forall a. String -> a
missingSyntax String
"HsTyLit"
      go HsWildCardTy{} = forall a. String -> a
missingSyntax String
"HsWildCardTy"
      go HsAppKindTy{} = forall a. String -> a
missingSyntax String
"HsAppKindTy"

  mMatch :: MatchEnv -> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key TyMap
_  (Substitution
_,TyMap a
TyEmpty) = []
  mMatch MatchEnv
env Key TyMap
ty (Substitution
hs,m :: TyMap a
m@TM{}) =
    [(Substitution, a)]
hss forall a. [a] -> [a] -> [a]
++ HsType GhcPs -> (Substitution, TyMap a) -> [(Substitution, a)]
go (forall l e. GenLocated l e -> e
unLoc Key TyMap
ty) (Substitution
hs,TyMap a
m) -- See Note [TyVar Quantifiers]
    where
      hss :: [(Substitution, a)]
hss = forall a.
Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult (forall a. TyMap a -> Map RdrName a
tyHole TyMap a
m) (AnnotatedHsType -> HoleVal
HoleType forall a b. (a -> b) -> a -> b
$ MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env Key TyMap
ty) Substitution
hs

      go :: HsType GhcPs -> (Substitution, TyMap a) -> [(Substitution, a)]
go (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> TyMap (TyMap a)
tyHsAppTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty1 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty2
#if __GLASGOW_HASKELL__ < 810
      go (HsForAllTy _ bndrs ty') = mapFor tyHsForAllTy >=> mMatch env (map extractBinderInfo bndrs, ty')
#elif __GLASGOW_HASKELL__ < 900
      go (HsForAllTy _ vis bndrs ty') =
        mapFor tyHsForAllTy >=> mMatch env (vis == ForallVis) >=> mMatch env (map extractBinderInfo bndrs, ty')
#else
      go (HsForAllTy XForAllTy GhcPs
_ HsForAllTelescope GhcPs
telescope LHsType GhcPs
ty') | (Bool
isVisible, [(RdrName, Maybe (LHsType GhcPs))]
bndrs) <- HsForAllTelescope GhcPs
-> (Bool, [(RdrName, Maybe (LHsType GhcPs))])
splitVisBinders HsForAllTelescope GhcPs
telescope =
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> ForallVisMap (ForAllTyMap a)
tyHsForAllTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Bool
isVisible forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ([(RdrName, Maybe (LHsType GhcPs))]
bndrs, LHsType GhcPs
ty')
#endif
#if __GLASGOW_HASKELL__ < 900
      go (HsFunTy _ ty1 ty2) = mapFor tyHsFunTy >=> mMatch env ty1 >=> mMatch env ty2
#else
      go (HsFunTy XFunTy GhcPs
_ HsArrow GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> TyMap (TyMap a)
tyHsFunTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty1 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty2
#endif
      go (HsListTy XListTy GhcPs
_ LHsType GhcPs
ty') = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> TyMap a
tyHsListTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty'
      go (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty') = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> TyMap a
tyHsParTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty'
#if __GLASGOW_HASKELL__ < 904
      go (HsQualTy XQualTy GhcPs
_ Maybe (LHsContext GhcPs)
cons LHsType GhcPs
ty') = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> TyMap (ListMap TyMap a)
tyHsQualTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
ty' forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall (p :: Pass).
Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext Maybe (LHsContext GhcPs)
cons)
#else
      go (HsQualTy _ cons ty') = mapFor tyHsQualTy >=> mMatch env ty' >=> mMatch env (fromMaybeContext (Just cons))
#endif
      go (HsSumTy XSumTy GhcPs
_ [LHsType GhcPs]
tys) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> ListMap TyMap a
tyHsSumTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LHsType GhcPs]
tys
      go (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
ts [LHsType GhcPs]
tys) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> TupleSortMap (ListMap TyMap a)
tyHsTupleTy forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsTupleSort
ts forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LHsType GhcPs]
tys
      go (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ LIdP GhcPs
v) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TyMap a -> VMap a
tyHsTyVar forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
v)
      go HsType GhcPs
_                  = forall a b. a -> b -> a
const [] -- TODO

#if __GLASGOW_HASKELL__ < 900
extractBinderInfo :: LHsTyVarBndr GhcPs -> (RdrName, Maybe (LHsKind GhcPs))
extractBinderInfo = go . unLoc
  where
    go (UserTyVar _ v) = (unLoc v, Nothing)
    go (KindedTyVar _ v k) = (unLoc v, Just k)
    go XTyVarBndr{} = missingSyntax "XTyVarBndr"
#else
splitVisBinders :: HsForAllTelescope GhcPs -> (Bool, [(RdrName, Maybe (LHsKind GhcPs))])
splitVisBinders :: HsForAllTelescope GhcPs
-> (Bool, [(RdrName, Maybe (LHsType GhcPs))])
splitVisBinders HsForAllVis{[LHsTyVarBndr () GhcPs]
XHsForAllVis GhcPs
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_xvis :: forall pass. HsForAllTelescope pass -> XHsForAllVis pass
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_xvis :: XHsForAllVis GhcPs
..} = (Bool
True, forall a b. (a -> b) -> [a] -> [b]
map forall flag.
LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo [LHsTyVarBndr () GhcPs]
hsf_vis_bndrs)
splitVisBinders HsForAllInvis{[LHsTyVarBndr Specificity GhcPs]
XHsForAllInvis GhcPs
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_xinvis :: XHsForAllInvis GhcPs
..} = (Bool
False, forall a b. (a -> b) -> [a] -> [b]
map forall flag.
LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo [LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs)

extractBinderInfo :: LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsKind GhcPs))
extractBinderInfo :: forall flag.
LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo = forall {pass} {l} {flag}.
(XRec pass (IdP pass) ~ GenLocated l (IdP pass)) =>
HsTyVarBndr flag pass
-> (IdP pass, Maybe (XRec pass (HsKind pass)))
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc
  where
    go :: HsTyVarBndr flag pass
-> (IdP pass, Maybe (XRec pass (HsKind pass)))
go (UserTyVar XUserTyVar pass
_ flag
_ XRec pass (IdP pass)
v) = (forall l e. GenLocated l e -> e
unLoc XRec pass (IdP pass)
v, forall a. Maybe a
Nothing)
    go (KindedTyVar XKindedTyVar pass
_ flag
_ XRec pass (IdP pass)
v XRec pass (HsKind pass)
k) = (forall l e. GenLocated l e -> e
unLoc XRec pass (IdP pass)
v, forall a. a -> Maybe a
Just XRec pass (HsKind pass)
k)
    go XTyVarBndr{} = forall a. String -> a
missingSyntax String
"XTyVarBndr"
#endif

------------------------------------------------------------------------

newtype RFMap a = RFM { forall a. RFMap a -> VMap (EMap a)
rfmField :: VMap (EMap a) }
  deriving (forall a b. a -> RFMap b -> RFMap a
forall a b. (a -> b) -> RFMap a -> RFMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RFMap b -> RFMap a
$c<$ :: forall a b. a -> RFMap b -> RFMap a
fmap :: forall a b. (a -> b) -> RFMap a -> RFMap b
$cfmap :: forall a b. (a -> b) -> RFMap a -> RFMap b
Functor)

instance PatternMap RFMap where
#if __GLASGOW_HASKELL__ < 904
  type Key RFMap = LocatedA (HsRecField' RdrName (LocatedA (HsExpr GhcPs)))
#else
  type Key RFMap = LocatedA (HsRecField GhcPs (LocatedA (HsExpr GhcPs)))
#endif

  mEmpty :: RFMap a
  mEmpty :: forall a. RFMap a
mEmpty = forall a. VMap (EMap a) -> RFMap a
RFM forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: RFMap a -> RFMap a -> RFMap a
  mUnion :: forall a. RFMap a -> RFMap a -> RFMap a
mUnion (RFM VMap (EMap a)
m1) (RFM VMap (EMap a)
m2) = forall a. VMap (EMap a) -> RFMap a
RFM (forall (m :: * -> *) a. PatternMap m => m a -> m a -> m a
mUnion VMap (EMap a)
m1 VMap (EMap a)
m2)

  mAlter :: AlphaEnv -> Quantifiers -> Key RFMap -> A a -> RFMap a -> RFMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Key RFMap -> A a -> RFMap a -> RFMap a
mAlter AlphaEnv
env Quantifiers
vs Key RFMap
lf A a
f RFMap a
m = HsRecField' RdrName (LocatedA (HsExpr GhcPs)) -> RFMap a
go (forall l e. GenLocated l e -> e
unLoc Key RFMap
lf)
    where
#if __GLASGOW_HASKELL__ < 904
      go :: HsRecField' RdrName (LocatedA (HsExpr GhcPs)) -> RFMap a
go (HsRecField XHsRecField RdrName
_ Located RdrName
lbl LocatedA (HsExpr GhcPs)
arg Bool
_pun) =
        RFMap a
m { rfmField :: VMap (EMap a)
rfmField = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (forall l e. GenLocated l e -> e
unLoc Located RdrName
lbl) (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LocatedA (HsExpr GhcPs)
arg A a
f)) (forall a. RFMap a -> VMap (EMap a)
rfmField RFMap a
m) }
#else
      go (HsFieldBind _ lbl arg _pun) =
        m { rfmField = mAlter env vs (unLoc (foLabel (unLoc lbl))) (toA (mAlter env vs arg f)) (rfmField m) }
#endif

  mMatch :: MatchEnv -> Key RFMap -> (Substitution, RFMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key RFMap -> (Substitution, RFMap a) -> [(Substitution, a)]
mMatch MatchEnv
env Key RFMap
lf (Substitution
hs,RFMap a
m) = HsRecField' RdrName (LocatedA (HsExpr GhcPs))
-> (Substitution, RFMap a) -> [(Substitution, a)]
go (forall l e. GenLocated l e -> e
unLoc Key RFMap
lf) (Substitution
hs,RFMap a
m)
    where
#if __GLASGOW_HASKELL__ < 904
      go :: HsRecField' RdrName (LocatedA (HsExpr GhcPs))
-> (Substitution, RFMap a) -> [(Substitution, a)]
go (HsRecField XHsRecField RdrName
_ Located RdrName
lbl LocatedA (HsExpr GhcPs)
arg Bool
_pun) =
        forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. RFMap a -> VMap (EMap a)
rfmField forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (forall l e. GenLocated l e -> e
unLoc Located RdrName
lbl) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LocatedA (HsExpr GhcPs)
arg
#else
      go (HsFieldBind _ lbl arg _pun) =
        mapFor rfmField >=> mMatch env (unLoc (foLabel (unLoc lbl))) >=> mMatch env arg
#endif

-- Helper class to collapse the complex encoding of record fields into RdrNames.
-- (The complexity is to support punning/duplicate/overlapping fields, which
-- all happens well after parsing, so is not needed here.)
class RecordFieldToRdrName f where
  recordFieldToRdrName :: f -> RdrName

instance RecordFieldToRdrName (AmbiguousFieldOcc GhcPs) where
  recordFieldToRdrName :: AmbiguousFieldOcc GhcPs -> RdrName
recordFieldToRdrName = forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc

#if __GLASGOW_HASKELL__ < 904
instance RecordFieldToRdrName (FieldOcc p) where
  recordFieldToRdrName :: FieldOcc p -> RdrName
recordFieldToRdrName = forall l e. GenLocated l e -> e
unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. FieldOcc pass -> GenLocated SrcSpanAnnN RdrName
rdrNameFieldOcc
#else
instance RecordFieldToRdrName (FieldOcc GhcPs) where
  recordFieldToRdrName = unLoc . foLabel
#endif

instance RecordFieldToRdrName (FieldLabelStrings GhcPs) where
  recordFieldToRdrName :: FieldLabelStrings GhcPs -> RdrName
recordFieldToRdrName = forall a. HasCallStack => String -> a
error String
"TBD"

#if __GLASGOW_HASKELL__ < 904
-- Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fieldsToRdrNamesUpd
  :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
  -> [LHsRecField' GhcPs RdrName (LHsExpr GhcPs)]
fieldsToRdrNamesUpd :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
-> [LHsRecField' GhcPs RdrName (LHsExpr GhcPs)]
fieldsToRdrNamesUpd (Left [LHsRecUpdField GhcPs]
fs) = forall a b. (a -> b) -> [a] -> [b]
map forall {f} {l} {arg}.
RecordFieldToRdrName f =>
GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go [LHsRecUpdField GhcPs]
fs
  where
    go :: GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go (L l
l (HsRecField XHsRecField f
a (L SrcSpan
l2 f
f) arg
arg Bool
pun)) =
      forall l e. l -> e -> GenLocated l e
L l
l (forall id arg.
XHsRecField id -> Located id -> arg -> Bool -> HsRecField' id arg
HsRecField XHsRecField f
a (forall l e. l -> e -> GenLocated l e
L SrcSpan
l2 (forall f. RecordFieldToRdrName f => f -> RdrName
recordFieldToRdrName f
f)) arg
arg Bool
pun)
fieldsToRdrNamesUpd (Right [LHsRecUpdProj GhcPs]
fs) = forall a b. (a -> b) -> [a] -> [b]
map forall {f} {l} {arg}.
RecordFieldToRdrName f =>
GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go [LHsRecUpdProj GhcPs]
fs
  where
    go :: GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go (L l
l (HsRecField XHsRecField f
a (L SrcSpan
l2 f
f) arg
arg Bool
pun)) =
      forall l e. l -> e -> GenLocated l e
L l
l (forall id arg.
XHsRecField id -> Located id -> arg -> Bool -> HsRecField' id arg
HsRecField XHsRecField f
a (forall l e. l -> e -> GenLocated l e
L SrcSpan
l2 (forall f. RecordFieldToRdrName f => f -> RdrName
recordFieldToRdrName f
f)) arg
arg Bool
pun)
#else
fieldsToRdrNamesUpd :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
  -> [LHsRecField GhcPs (LHsExpr GhcPs)]
fieldsToRdrNamesUpd (Left xs) = map go xs
  where
    go (L l (HsFieldBind a (L l2 f) arg pun)) =
      let lrdrName = case f of
            Unambiguous _ n -> n
            Ambiguous _ n -> n
            XAmbiguousFieldOcc{} -> error "XAmbiguousFieldOcc"
          f' = FieldOcc NoExtField lrdrName
       in L l (HsFieldBind a (L l2 f') arg pun)
fieldsToRdrNamesUpd (Right xs) = map go xs
  where
    go (L l (HsFieldBind a (L l2 _f) arg pun)) =
      let lrdrName = error "TBD" -- same as GHC 9.2
          f' = FieldOcc NoExtField lrdrName
       in L l (HsFieldBind a (L l2 f') arg pun)
#endif

#if __GLASGOW_HASKELL__ < 904
fieldsToRdrNames
  :: RecordFieldToRdrName f
  => [LHsRecField' GhcPs f arg]
  -> [LHsRecField' GhcPs RdrName arg]
fieldsToRdrNames :: forall f arg.
RecordFieldToRdrName f =>
[LHsRecField' GhcPs f arg] -> [LHsRecField' GhcPs RdrName arg]
fieldsToRdrNames = forall a b. (a -> b) -> [a] -> [b]
map forall {f} {l} {arg}.
RecordFieldToRdrName f =>
GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go
  where
    go :: GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go (L l
l (HsRecField XHsRecField f
a (L SrcSpan
l2 f
f) arg
arg Bool
pun)) =
      forall l e. l -> e -> GenLocated l e
L l
l (forall id arg.
XHsRecField id -> Located id -> arg -> Bool -> HsRecField' id arg
HsRecField XHsRecField f
a (forall l e. l -> e -> GenLocated l e
L SrcSpan
l2 (forall f. RecordFieldToRdrName f => f -> RdrName
recordFieldToRdrName f
f)) arg
arg Bool
pun)
#endif

------------------------------------------------------------------------

data TupleSortMap a = TupleSortMap
  { forall a. TupleSortMap a -> MaybeMap a
tsUnboxed :: MaybeMap a
  , forall a. TupleSortMap a -> MaybeMap a
tsBoxed :: MaybeMap a
  , forall a. TupleSortMap a -> MaybeMap a
tsConstraint :: MaybeMap a
  , forall a. TupleSortMap a -> MaybeMap a
tsBoxedOrConstraint :: MaybeMap a
  }
  deriving (forall a b. a -> TupleSortMap b -> TupleSortMap a
forall a b. (a -> b) -> TupleSortMap a -> TupleSortMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TupleSortMap b -> TupleSortMap a
$c<$ :: forall a b. a -> TupleSortMap b -> TupleSortMap a
fmap :: forall a b. (a -> b) -> TupleSortMap a -> TupleSortMap b
$cfmap :: forall a b. (a -> b) -> TupleSortMap a -> TupleSortMap b
Functor)

instance PatternMap TupleSortMap where
  type Key TupleSortMap = HsTupleSort

  mEmpty :: TupleSortMap a
  mEmpty :: forall a. TupleSortMap a
mEmpty = forall a.
MaybeMap a
-> MaybeMap a -> MaybeMap a -> MaybeMap a -> TupleSortMap a
TupleSortMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: TupleSortMap a -> TupleSortMap a -> TupleSortMap a
  mUnion :: forall a. TupleSortMap a -> TupleSortMap a -> TupleSortMap a
mUnion TupleSortMap a
m1 TupleSortMap a
m2 = TupleSortMap
    { tsUnboxed :: MaybeMap a
tsUnboxed = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TupleSortMap a -> MaybeMap a
tsUnboxed TupleSortMap a
m1 TupleSortMap a
m2
    , tsBoxed :: MaybeMap a
tsBoxed = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TupleSortMap a -> MaybeMap a
tsBoxed TupleSortMap a
m1 TupleSortMap a
m2
    , tsConstraint :: MaybeMap a
tsConstraint = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TupleSortMap a -> MaybeMap a
tsConstraint TupleSortMap a
m1 TupleSortMap a
m2
    , tsBoxedOrConstraint :: MaybeMap a
tsBoxedOrConstraint = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. TupleSortMap a -> MaybeMap a
tsBoxedOrConstraint TupleSortMap a
m1 TupleSortMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key TupleSortMap -> A a -> TupleSortMap a -> TupleSortMap a
  mAlter :: forall a.
AlphaEnv
-> Quantifiers
-> Key TupleSortMap
-> A a
-> TupleSortMap a
-> TupleSortMap a
mAlter AlphaEnv
env Quantifiers
vs HsTupleSort
Key TupleSortMap
HsUnboxedTuple A a
f TupleSortMap a
m =
    TupleSortMap a
m { tsUnboxed :: MaybeMap a
tsUnboxed = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. TupleSortMap a -> MaybeMap a
tsUnboxed TupleSortMap a
m) }
  -- mAlter env vs HsBoxedOrConstraintTuple f m =
  --   m { tsBoxed = mAlter env vs () f (tsBoxed m) }
  -- mAlter env vs HsConstraintTuple f m =
  --   m { tsConstraint = mAlter env vs () f (tsConstraint m) }
  mAlter AlphaEnv
env Quantifiers
vs HsTupleSort
Key TupleSortMap
HsBoxedOrConstraintTuple A a
f TupleSortMap a
m =
    TupleSortMap a
m { tsBoxedOrConstraint :: MaybeMap a
tsBoxedOrConstraint = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (forall a. TupleSortMap a -> MaybeMap a
tsBoxedOrConstraint TupleSortMap a
m) }

  mMatch :: MatchEnv -> Key TupleSortMap -> (Substitution, TupleSortMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key TupleSortMap
-> (Substitution, TupleSortMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env HsTupleSort
Key TupleSortMap
HsUnboxedTuple = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TupleSortMap a -> MaybeMap a
tsUnboxed forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
  -- mMatch env HsBoxedTuple = mapFor tsBoxed >=> mMatch env ()
  -- mMatch env HsConstraintTuple = mapFor tsConstraint >=> mMatch env ()
  mMatch MatchEnv
env HsTupleSort
Key TupleSortMap
HsBoxedOrConstraintTuple = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. TupleSortMap a -> MaybeMap a
tsBoxedOrConstraint forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()

------------------------------------------------------------------------

-- Note [Telescope]
-- Haskell's forall quantification is a telescope (type binders are in-scope
-- to binders to the right. Example: forall r (a :: TYPE r). ...
--
-- To support this, we peel off the binders one at a time, extending the
-- environment at each layer.

data ForAllTyMap a = ForAllTyMap
  { forall a. ForAllTyMap a -> TyMap a
fatNil :: TyMap a
  , forall a. ForAllTyMap a -> ForAllTyMap a
fatUser :: ForAllTyMap a
  , forall a. ForAllTyMap a -> TyMap (ForAllTyMap a)
fatKinded :: TyMap (ForAllTyMap a)
  }
  deriving (forall a b. a -> ForAllTyMap b -> ForAllTyMap a
forall a b. (a -> b) -> ForAllTyMap a -> ForAllTyMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ForAllTyMap b -> ForAllTyMap a
$c<$ :: forall a b. a -> ForAllTyMap b -> ForAllTyMap a
fmap :: forall a b. (a -> b) -> ForAllTyMap a -> ForAllTyMap b
$cfmap :: forall a b. (a -> b) -> ForAllTyMap a -> ForAllTyMap b
Functor)

instance PatternMap ForAllTyMap where
  type Key ForAllTyMap = ([(RdrName, Maybe (LocatedA (HsKind GhcPs)))], LocatedA (HsType GhcPs))

  mEmpty :: ForAllTyMap a
  mEmpty :: forall a. ForAllTyMap a
mEmpty = forall a.
TyMap a -> ForAllTyMap a -> TyMap (ForAllTyMap a) -> ForAllTyMap a
ForAllTyMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: ForAllTyMap a -> ForAllTyMap a -> ForAllTyMap a
  mUnion :: forall a. ForAllTyMap a -> ForAllTyMap a -> ForAllTyMap a
mUnion ForAllTyMap a
m1 ForAllTyMap a
m2 = ForAllTyMap
    { fatNil :: TyMap a
fatNil = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. ForAllTyMap a -> TyMap a
fatNil ForAllTyMap a
m1 ForAllTyMap a
m2
    , fatUser :: ForAllTyMap a
fatUser = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. ForAllTyMap a -> ForAllTyMap a
fatUser ForAllTyMap a
m1 ForAllTyMap a
m2
    , fatKinded :: TyMap (ForAllTyMap a)
fatKinded = forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. ForAllTyMap a -> TyMap (ForAllTyMap a)
fatKinded ForAllTyMap a
m1 ForAllTyMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key ForAllTyMap -> A a -> ForAllTyMap a -> ForAllTyMap a
  mAlter :: forall a.
AlphaEnv
-> Quantifiers
-> Key ForAllTyMap
-> A a
-> ForAllTyMap a
-> ForAllTyMap a
mAlter AlphaEnv
env Quantifiers
vs ([], GenLocated SrcSpanAnnA (HsType GhcPs)
ty) A a
f ForAllTyMap a
m = ForAllTyMap a
m { fatNil :: TyMap a
fatNil = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs GenLocated SrcSpanAnnA (HsType GhcPs)
ty A a
f (forall a. ForAllTyMap a -> TyMap a
fatNil ForAllTyMap a
m) }
  mAlter AlphaEnv
env Quantifiers
vs ((RdrName
v,Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
mbK):[(RdrName, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))]
rest, GenLocated SrcSpanAnnA (HsType GhcPs)
ty) A a
f ForAllTyMap a
m
    | Just GenLocated SrcSpanAnnA (HsType GhcPs)
k <- Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
mbK = ForAllTyMap a
m { fatKinded :: TyMap (ForAllTyMap a)
fatKinded = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs GenLocated SrcSpanAnnA (HsType GhcPs)
k (forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' ([(RdrName, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))]
rest, GenLocated SrcSpanAnnA (HsType GhcPs)
ty) A a
f)) (forall a. ForAllTyMap a -> TyMap (ForAllTyMap a)
fatKinded ForAllTyMap a
m) }
    | Bool
otherwise = ForAllTyMap a
m { fatUser :: ForAllTyMap a
fatUser = forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' ([(RdrName, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))]
rest, GenLocated SrcSpanAnnA (HsType GhcPs)
ty) A a
f (forall a. ForAllTyMap a -> ForAllTyMap a
fatUser ForAllTyMap a
m) }
    where
      env' :: AlphaEnv
env' = RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal RdrName
v AlphaEnv
env
      vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [RdrName
v]

  mMatch :: MatchEnv -> Key ForAllTyMap -> (Substitution, ForAllTyMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env ([],GenLocated SrcSpanAnnA (HsType GhcPs)
ty) = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. ForAllTyMap a -> TyMap a
fatNil forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated SrcSpanAnnA (HsType GhcPs)
ty
  mMatch MatchEnv
env ((RdrName
v,Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
mbK):[(RdrName, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))]
rest, GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
    | Just GenLocated SrcSpanAnnA (HsType GhcPs)
k <- Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
mbK = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. ForAllTyMap a -> TyMap (ForAllTyMap a)
fatKinded forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated SrcSpanAnnA (HsType GhcPs)
k forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ([(RdrName, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))]
rest, GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
    | Bool
otherwise = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. ForAllTyMap a -> ForAllTyMap a
fatUser forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ([(RdrName, Maybe (GenLocated SrcSpanAnnA (HsType GhcPs)))]
rest, GenLocated SrcSpanAnnA (HsType GhcPs)
ty)
    where
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [RdrName
v]

#if __GLASGOW_HASKELL__ < 810
#else
newtype ForallVisMap a = ForallVisMap { forall a. ForallVisMap a -> BoolMap a
favBoolMap :: BoolMap a }
  deriving (forall a b. a -> ForallVisMap b -> ForallVisMap a
forall a b. (a -> b) -> ForallVisMap a -> ForallVisMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ForallVisMap b -> ForallVisMap a
$c<$ :: forall a b. a -> ForallVisMap b -> ForallVisMap a
fmap :: forall a b. (a -> b) -> ForallVisMap a -> ForallVisMap b
$cfmap :: forall a b. (a -> b) -> ForallVisMap a -> ForallVisMap b
Functor)

instance PatternMap ForallVisMap where
  type Key ForallVisMap = Bool

  mEmpty :: ForallVisMap a
  mEmpty :: forall a. ForallVisMap a
mEmpty = forall a. BoolMap a -> ForallVisMap a
ForallVisMap forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: ForallVisMap a -> ForallVisMap a -> ForallVisMap a
  mUnion :: forall a. ForallVisMap a -> ForallVisMap a -> ForallVisMap a
mUnion ForallVisMap a
m1 ForallVisMap a
m2 = forall a. BoolMap a -> ForallVisMap a
ForallVisMap (forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn forall a. ForallVisMap a -> BoolMap a
favBoolMap ForallVisMap a
m1 ForallVisMap a
m2)

  mAlter :: AlphaEnv -> Quantifiers -> Key ForallVisMap -> A a -> ForallVisMap a -> ForallVisMap a
  mAlter :: forall a.
AlphaEnv
-> Quantifiers
-> Key ForallVisMap
-> A a
-> ForallVisMap a
-> ForallVisMap a
mAlter AlphaEnv
env Quantifiers
vs Key ForallVisMap
k A a
f (ForallVisMap BoolMap a
m) = forall a. BoolMap a -> ForallVisMap a
ForallVisMap forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key ForallVisMap
k A a
f BoolMap a
m

  mMatch :: MatchEnv -> Key ForallVisMap -> (Substitution, ForallVisMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Key ForallVisMap
-> (Substitution, ForallVisMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env Key ForallVisMap
b = forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor forall a. ForallVisMap a -> BoolMap a
favBoolMap forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Key ForallVisMap
b
#endif