-- 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 -> b) -> TupArgMap a -> TupArgMap b)
-> (forall a b. a -> TupArgMap b -> TupArgMap a)
-> Functor TupArgMap
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
$cfmap :: forall a b. (a -> b) -> TupArgMap a -> TupArgMap b
fmap :: forall a b. (a -> b) -> TupArgMap a -> TupArgMap b
$c<$ :: forall a b. a -> TupArgMap b -> TupArgMap a
<$ :: forall a b. a -> TupArgMap b -> TupArgMap a
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 = EMap a -> MaybeMap a -> TupArgMap a
forall a. EMap a -> MaybeMap a -> TupArgMap a
TupArgMap EMap a
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
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 = (TupArgMap a -> EMap a) -> TupArgMap a -> TupArgMap a -> EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TupArgMap a -> EMap a
forall a. TupArgMap a -> EMap a
tamPresent TupArgMap a
m1 TupArgMap a
m2
    , tamMissing :: MaybeMap a
tamMissing = (TupArgMap a -> MaybeMap a)
-> TupArgMap a -> TupArgMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TupArgMap a -> MaybeMap a
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 HsTupArg GhcPs
Key TupArgMap
tupArg
    where
      go :: HsTupArg GhcPs -> TupArgMap a
go (Present XPresent GhcPs
_ LHsExpr GhcPs
e) = TupArgMap a
m { tamPresent = mAlter env vs e  f (tamPresent m) }
#if __GLASGOW_HASKELL__ < 900
      go XTupArg{} = missingSyntax "XTupArg"
#endif
      go (Missing XMissing GhcPs
_) = TupArgMap a
m { tamMissing = mAlter env vs () f (tamMissing 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)]
Key TupArgMap -> (Substitution, TupArgMap a) -> [(Substitution, a)]
go
    where
      go :: HsTupArg GhcPs
-> (Substitution, TupArgMap a) -> [(Substitution, a)]
go (Present XPresent GhcPs
_ LHsExpr GhcPs
e) = (TupArgMap a -> EMap a)
-> (Substitution, TupArgMap a) -> [(Substitution, EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TupArgMap a -> EMap a
forall a. TupArgMap a -> EMap a
tamPresent ((Substitution, TupArgMap a) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, TupArgMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e
#if __GLASGOW_HASKELL__ < 900
      go XTupArg{} = const []
#endif
      go (Missing XMissing GhcPs
_) = (TupArgMap a -> MaybeMap a)
-> (Substitution, TupArgMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TupArgMap a -> MaybeMap a
forall a. TupArgMap a -> MaybeMap a
tamMissing ((Substitution, TupArgMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, TupArgMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
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 -> b) -> BoxityMap a -> BoxityMap b)
-> (forall a b. a -> BoxityMap b -> BoxityMap a)
-> Functor BoxityMap
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
$cfmap :: forall a b. (a -> b) -> BoxityMap a -> BoxityMap b
fmap :: forall a b. (a -> b) -> BoxityMap a -> BoxityMap b
$c<$ :: forall a b. a -> BoxityMap b -> BoxityMap a
<$ :: forall a b. a -> BoxityMap b -> BoxityMap a
Functor)

instance PatternMap BoxityMap where
  type Key BoxityMap = Boxity

  mEmpty :: BoxityMap a
  mEmpty :: forall a. BoxityMap a
mEmpty = MaybeMap a -> MaybeMap a -> BoxityMap a
forall a. MaybeMap a -> MaybeMap a -> BoxityMap a
BoxityMap MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
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 = (BoxityMap a -> MaybeMap a)
-> BoxityMap a -> BoxityMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn BoxityMap a -> MaybeMap a
forall a. BoxityMap a -> MaybeMap a
boxBoxed BoxityMap a
m1 BoxityMap a
m2
    , boxUnboxed :: MaybeMap a
boxUnboxed = (BoxityMap a -> MaybeMap a)
-> BoxityMap a -> BoxityMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn BoxityMap a -> MaybeMap a
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   = mAlter env vs () f (boxBoxed m) }
  mAlter AlphaEnv
env Quantifiers
vs Boxity
Key BoxityMap
Unboxed A a
f BoxityMap a
m = BoxityMap a
m { boxUnboxed = mAlter env vs () f (boxUnboxed 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   = (BoxityMap a -> MaybeMap a)
-> (Substitution, BoxityMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor BoxityMap a -> MaybeMap a
forall a. BoxityMap a -> MaybeMap a
boxBoxed ((Substitution, BoxityMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, BoxityMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
  mMatch MatchEnv
env Boxity
Key BoxityMap
Unboxed = (BoxityMap a -> MaybeMap a)
-> (Substitution, BoxityMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor BoxityMap a -> MaybeMap a
forall a. BoxityMap a -> MaybeMap a
boxUnboxed ((Substitution, BoxityMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, BoxityMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
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 -> b) -> VMap a -> VMap b)
-> (forall a b. a -> VMap b -> VMap a) -> Functor VMap
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
$cfmap :: forall a b. (a -> b) -> VMap a -> VMap b
fmap :: forall a b. (a -> b) -> VMap a -> VMap b
$c<$ :: forall a b. a -> VMap b -> VMap a
<$ :: forall a b. a -> VMap b -> VMap a
Functor)

instance PatternMap VMap where
  type Key VMap = RdrName

  mEmpty :: VMap a
  mEmpty :: forall a. VMap a
mEmpty = VMap a
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 = (VMap a -> IntMap a) -> VMap a -> VMap a -> IntMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn VMap a -> IntMap a
forall a. VMap a -> IntMap a
bvmap VMap a
m1 VMap a
m2
    , fvmap :: FSEnv a
fvmap = (VMap a -> FSEnv a) -> VMap a -> VMap a -> FSEnv a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn VMap a -> FSEnv a
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 = AlphaEnv -> Quantifiers -> Key VMap -> A a -> VMap a -> VMap a
forall a.
AlphaEnv -> Quantifiers -> Key VMap -> A a -> VMap a -> VMap a
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 (IntMap a -> FSEnv a -> VMap a
forall a. IntMap a -> FSEnv a -> VMap a
VM IntMap a
forall a. IntMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall a. FSEnv a
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 RdrName
Key VMap
v AlphaEnv
env = VMap a
m { bvmap = mAlter env vs bv f (bvmap m) }
    | Bool
otherwise                       = VMap a
m { fvmap = mAlter env vs (rdrFS v) f (fvmap 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 RdrName
Key VMap
v (MatchEnv -> AlphaEnv
meAlphaEnv MatchEnv
env) = MatchEnv
-> Key IntMap -> (Substitution, IntMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key IntMap -> (Substitution, IntMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Int
Key IntMap
bv (Substitution
hs, VMap a -> IntMap a
forall a. VMap a -> IntMap a
bvmap VMap a
m)
    | Bool
otherwise = MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (RdrName -> FastString
rdrFS RdrName
Key VMap
v) (Substitution
hs, VMap a -> FSEnv a
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 -> b) -> LMap a -> LMap b)
-> (forall a b. a -> LMap b -> LMap a) -> Functor LMap
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
$cfmap :: forall a b. (a -> b) -> LMap a -> LMap b
fmap :: forall a b. (a -> b) -> LMap a -> LMap b
$c<$ :: forall a b. a -> LMap b -> LMap a
<$ :: forall a b. a -> LMap b -> LMap a
Functor)

emptyLMapWrapper :: LMap a
emptyLMapWrapper :: forall a. LMap a
emptyLMapWrapper
  = 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
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 Map Char a
forall a. Map Char a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Char a
forall a. Map Char a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall a. FSEnv a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map ByteString a
forall a. Map ByteString a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty BoolMap (Map Integer a)
forall a. BoolMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
       Map Integer a
forall a. Map Integer a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Integer a
forall a. Map Integer a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Integer a
forall a. Map Integer a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Integer a
forall a. Map Integer a
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 = LMap a
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 = (LMap a -> Map Char a) -> LMap a -> LMap a -> Map Char a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> Map Char a
forall a. LMap a -> Map Char a
lmChar LMap a
m1 LMap a
m2
    , lmCharPrim :: Map Char a
lmCharPrim = (LMap a -> Map Char a) -> LMap a -> LMap a -> Map Char a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> Map Char a
forall a. LMap a -> Map Char a
lmCharPrim LMap a
m1 LMap a
m2
    , lmString :: FSEnv a
lmString = (LMap a -> FSEnv a) -> LMap a -> LMap a -> FSEnv a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> FSEnv a
forall a. LMap a -> FSEnv a
lmString LMap a
m1 LMap a
m2
    , lmStringPrim :: Map ByteString a
lmStringPrim = (LMap a -> Map ByteString a)
-> LMap a -> LMap a -> Map ByteString a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> Map ByteString a
forall a. LMap a -> Map ByteString a
lmStringPrim LMap a
m1 LMap a
m2
    , lmInt :: BoolMap (Map Integer a)
lmInt = (LMap a -> BoolMap (Map Integer a))
-> LMap a -> LMap a -> BoolMap (Map Integer a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> BoolMap (Map Integer a)
forall a. LMap a -> BoolMap (Map Integer a)
lmInt LMap a
m1 LMap a
m2
    , lmIntPrim :: Map Integer a
lmIntPrim = (LMap a -> Map Integer a) -> LMap a -> LMap a -> Map Integer a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmIntPrim LMap a
m1 LMap a
m2
    , lmWordPrim :: Map Integer a
lmWordPrim = (LMap a -> Map Integer a) -> LMap a -> LMap a -> Map Integer a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmWordPrim LMap a
m1 LMap a
m2
    , lmInt64Prim :: Map Integer a
lmInt64Prim = (LMap a -> Map Integer a) -> LMap a -> LMap a -> Map Integer a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmInt64Prim LMap a
m1 LMap a
m2
    , lmWord64Prim :: Map Integer a
lmWord64Prim = (LMap a -> Map Integer a) -> LMap a -> LMap a -> Map Integer a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LMap a -> Map Integer a
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 = AlphaEnv -> Quantifiers -> Key LMap -> A a -> LMap a -> LMap a
forall a.
AlphaEnv -> Quantifiers -> Key LMap -> A a -> LMap a -> LMap a
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 LMap a
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 HsLit GhcPs
Key LMap
lit
    where
      go :: HsLit GhcPs -> LMap a
go (HsChar XHsChar GhcPs
_ Char
c)       = LMap a
m { lmChar = mAlter env vs c f (lmChar m) }
      go (HsCharPrim XHsCharPrim GhcPs
_ Char
c)   = LMap a
m { lmCharPrim = mAlter env vs c f (lmCharPrim m) }
      go (HsString XHsString GhcPs
_ FastString
fs)    = LMap a
m { lmString = mAlter env vs fs f (lmString m) }
      go (HsStringPrim XHsStringPrim GhcPs
_ ByteString
bs) = LMap a
m { lmStringPrim = mAlter env vs bs f (lmStringPrim m) }
      go (HsInt XHsInt GhcPs
_ (IL SourceText
_ Bool
b Integer
i)) =
        LMap a
m { lmInt = mAlter env vs b (toA (mAlter env vs i f)) (lmInt m) }
      go (HsIntPrim XHsIntPrim GhcPs
_ Integer
i)    = LMap a
m { lmIntPrim = mAlter env vs i f (lmIntPrim m) }
      go (HsWordPrim XHsWordPrim GhcPs
_ Integer
i)   = LMap a
m { lmWordPrim = mAlter env vs i f (lmWordPrim m) }
      go (HsInt64Prim XHsInt64Prim GhcPs
_ Integer
i)  = LMap a
m { lmInt64Prim = mAlter env vs i f (lmInt64Prim m) }
      go (HsWord64Prim XHsWord64Prim GhcPs
_ Integer
i) = LMap a
m { lmWord64Prim = mAlter env vs i f (lmWord64Prim m) }
      go (HsInteger XHsInteger GhcPs
_ Integer
_ Type
_) = String -> LMap a
forall a. String -> a
missingSyntax String
"HsInteger"
      go HsRat{} = String -> LMap a
forall a. String -> a
missingSyntax String
"HsRat"
      go HsFloatPrim{} = String -> LMap a
forall a. String -> a
missingSyntax String
"HsFloatPrim"
      go HsDoublePrim{} = String -> LMap a
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 HsLit GhcPs
Key LMap
lit (Substitution
hs,LMap a
m)
    where
      go :: HsLit GhcPs -> (Substitution, LMap a) -> [(Substitution, a)]
go (HsChar XHsChar GhcPs
_ Char
c)        = (LMap a -> Map Char a)
-> (Substitution, LMap a) -> [(Substitution, Map Char a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> Map Char a
forall a. LMap a -> Map Char a
lmChar ((Substitution, LMap a) -> [(Substitution, Map Char a)])
-> ((Substitution, Map Char a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Char)
-> (Substitution, Map Char a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Char)
-> (Substitution, Map Char a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Char
Key (Map Char)
c
      go (HsCharPrim XHsCharPrim GhcPs
_ Char
c)    = (LMap a -> Map Char a)
-> (Substitution, LMap a) -> [(Substitution, Map Char a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> Map Char a
forall a. LMap a -> Map Char a
lmCharPrim ((Substitution, LMap a) -> [(Substitution, Map Char a)])
-> ((Substitution, Map Char a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Char)
-> (Substitution, Map Char a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Char)
-> (Substitution, Map Char a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Char
Key (Map Char)
c
      go (HsString XHsString GhcPs
_ FastString
fs)     = (LMap a -> FSEnv a)
-> (Substitution, LMap a) -> [(Substitution, FSEnv a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> FSEnv a
forall a. LMap a -> FSEnv a
lmString ((Substitution, LMap a) -> [(Substitution, FSEnv a)])
-> ((Substitution, FSEnv a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env FastString
Key FSEnv
fs
      go (HsStringPrim XHsStringPrim GhcPs
_ ByteString
bs) = (LMap a -> Map ByteString a)
-> (Substitution, LMap a) -> [(Substitution, Map ByteString a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> Map ByteString a
forall a. LMap a -> Map ByteString a
lmStringPrim ((Substitution, LMap a) -> [(Substitution, Map ByteString a)])
-> ((Substitution, Map ByteString a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map ByteString)
-> (Substitution, Map ByteString a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map ByteString)
-> (Substitution, Map ByteString a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ByteString
Key (Map ByteString)
bs
      go (HsInt XHsInt GhcPs
_ (IL SourceText
_ Bool
b Integer
i)) = (LMap a -> BoolMap (Map Integer a))
-> (Substitution, LMap a)
-> [(Substitution, BoolMap (Map Integer a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> BoolMap (Map Integer a)
forall a. LMap a -> BoolMap (Map Integer a)
lmInt ((Substitution, LMap a)
 -> [(Substitution, BoolMap (Map Integer a))])
-> ((Substitution, BoolMap (Map Integer a)) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key BoolMap
-> (Substitution, BoolMap (Map Integer a))
-> [(Substitution, Map Integer a)]
forall a.
MatchEnv
-> Key BoolMap -> (Substitution, BoolMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Bool
Key BoolMap
b ((Substitution, BoolMap (Map Integer a))
 -> [(Substitution, Map Integer a)])
-> ((Substitution, Map Integer a) -> [(Substitution, a)])
-> (Substitution, BoolMap (Map Integer a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
Key (Map Integer)
i
      go (HsIntPrim XHsIntPrim GhcPs
_ Integer
i)     = (LMap a -> Map Integer a)
-> (Substitution, LMap a) -> [(Substitution, Map Integer a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmIntPrim ((Substitution, LMap a) -> [(Substitution, Map Integer a)])
-> ((Substitution, Map Integer a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
Key (Map Integer)
i
      go (HsWordPrim XHsWordPrim GhcPs
_ Integer
i)    = (LMap a -> Map Integer a)
-> (Substitution, LMap a) -> [(Substitution, Map Integer a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmWordPrim ((Substitution, LMap a) -> [(Substitution, Map Integer a)])
-> ((Substitution, Map Integer a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
Key (Map Integer)
i
      go (HsInt64Prim XHsInt64Prim GhcPs
_ Integer
i)   = (LMap a -> Map Integer a)
-> (Substitution, LMap a) -> [(Substitution, Map Integer a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmInt64Prim ((Substitution, LMap a) -> [(Substitution, Map Integer a)])
-> ((Substitution, Map Integer a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
Key (Map Integer)
i
      go (HsWord64Prim XHsWord64Prim GhcPs
_ Integer
i)  = (LMap a -> Map Integer a)
-> (Substitution, LMap a) -> [(Substitution, Map Integer a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmWord64Prim ((Substitution, LMap a) -> [(Substitution, Map Integer a)])
-> ((Substitution, Map Integer a) -> [(Substitution, a)])
-> (Substitution, LMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
Key (Map Integer)
i
      go HsLit GhcPs
_ = [(Substitution, a)]
-> (Substitution, LMap a) -> [(Substitution, a)]
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 -> b) -> OLMap a -> OLMap b)
-> (forall a b. a -> OLMap b -> OLMap a) -> Functor OLMap
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
$cfmap :: forall a b. (a -> b) -> OLMap a -> OLMap b
fmap :: forall a b. (a -> b) -> OLMap a -> OLMap b
$c<$ :: forall a b. a -> OLMap b -> OLMap a
<$ :: forall a b. a -> OLMap b -> OLMap a
Functor)

emptyOLMapWrapper :: OLMap a
emptyOLMapWrapper :: forall a. OLMap a
emptyOLMapWrapper = BoolMap (Map Integer a) -> Map Rational a -> FSEnv a -> OLMap a
forall a.
BoolMap (Map Integer a) -> Map Rational a -> FSEnv a -> OLMap a
OLM BoolMap (Map Integer a)
forall a. BoolMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Rational a
forall a. Map Rational a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall a. FSEnv a
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 = OLMap a
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 = (OLMap a -> BoolMap (Map Integer a))
-> OLMap a -> OLMap a -> BoolMap (Map Integer a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn OLMap a -> BoolMap (Map Integer a)
forall a. OLMap a -> BoolMap (Map Integer a)
olmIntegral OLMap a
m1 OLMap a
m2
    , olmFractional :: Map Rational a
olmFractional = (OLMap a -> Map Rational a) -> OLMap a -> OLMap a -> Map Rational a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn OLMap a -> Map Rational a
forall a. OLMap a -> Map Rational a
olmFractional OLMap a
m1 OLMap a
m2
    , olmIsString :: FSEnv a
olmIsString = (OLMap a -> FSEnv a) -> OLMap a -> OLMap a -> FSEnv a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn OLMap a -> FSEnv a
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 = AlphaEnv -> Quantifiers -> Key OLMap -> A a -> OLMap a -> OLMap a
forall a.
AlphaEnv -> Quantifiers -> Key OLMap -> A a -> OLMap a -> OLMap a
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 OLMap a
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 OverLitVal
Key OLMap
lv
    where
      go :: OverLitVal -> OLMap a
go (HsIntegral (IL SourceText
_ Bool
b Integer
i)) =
        OLMap a
m { olmIntegral = mAlter env vs b (toA (mAlter env vs i f)) (olmIntegral m) }
      go (HsFractional FractionalLit
fl) = OLMap a
m { olmFractional = mAlter env vs (fl_signi fl) f (olmFractional m) }
      go (HsIsString SourceText
_ FastString
fs) = OLMap a
m { olmIsString = mAlter env vs fs f (olmIsString 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 OverLitVal
Key OLMap
lv (Substitution
hs,OLMap a
m)
    where
      go :: OverLitVal -> (Substitution, OLMap a) -> [(Substitution, a)]
go (HsIntegral (IL SourceText
_ Bool
b Integer
i)) =
        (OLMap a -> BoolMap (Map Integer a))
-> (Substitution, OLMap a)
-> [(Substitution, BoolMap (Map Integer a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor OLMap a -> BoolMap (Map Integer a)
forall a. OLMap a -> BoolMap (Map Integer a)
olmIntegral ((Substitution, OLMap a)
 -> [(Substitution, BoolMap (Map Integer a))])
-> ((Substitution, BoolMap (Map Integer a)) -> [(Substitution, a)])
-> (Substitution, OLMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key BoolMap
-> (Substitution, BoolMap (Map Integer a))
-> [(Substitution, Map Integer a)]
forall a.
MatchEnv
-> Key BoolMap -> (Substitution, BoolMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Bool
Key BoolMap
b ((Substitution, BoolMap (Map Integer a))
 -> [(Substitution, Map Integer a)])
-> ((Substitution, Map Integer a) -> [(Substitution, a)])
-> (Substitution, BoolMap (Map Integer a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Integer)
-> (Substitution, Map Integer a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Integer
Key (Map Integer)
i
      go (HsFractional FractionalLit
fl) = (OLMap a -> Map Rational a)
-> (Substitution, OLMap a) -> [(Substitution, Map Rational a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor OLMap a -> Map Rational a
forall a. OLMap a -> Map Rational a
olmFractional ((Substitution, OLMap a) -> [(Substitution, Map Rational a)])
-> ((Substitution, Map Rational a) -> [(Substitution, a)])
-> (Substitution, OLMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (Map Rational)
-> (Substitution, Map Rational a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (Map Rational)
-> (Substitution, Map Rational a)
-> [(Substitution, a)]
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) = (OLMap a -> FSEnv a)
-> (Substitution, OLMap a) -> [(Substitution, FSEnv a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor OLMap a -> FSEnv a
forall a. OLMap a -> FSEnv a
olmIsString ((Substitution, OLMap a) -> [(Substitution, FSEnv a)])
-> ((Substitution, FSEnv a) -> [(Substitution, a)])
-> (Substitution, OLMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env FastString
Key FSEnv
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 -> b) -> EMap a -> EMap b)
-> (forall a b. a -> EMap b -> EMap a) -> Functor EMap
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
$cfmap :: forall a b. (a -> b) -> EMap a -> EMap b
fmap :: forall a b. (a -> b) -> EMap a -> EMap b
$c<$ :: forall a b. a -> EMap b -> EMap a
<$ :: forall a b. a -> EMap b -> EMap a
Functor)

emptyEMapWrapper :: EMap a
emptyEMapWrapper :: forall a. EMap a
emptyEMapWrapper =
  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
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 Map RdrName a
forall a. Map RdrName a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty VMap a
forall a. VMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall a. FSEnv a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty OLMap a
forall a. OLMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty LMap a
forall a. LMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     MGMap a
forall a. MGMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap a)
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap (EMap a))
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     BoxityMap (ListMap TupArgMap a)
forall a. BoxityMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (MGMap a)
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap a)
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap a)
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap (EMap a))
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     LBMap (EMap a)
forall a. LBMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty SCMap (SLMap a)
forall a. SCMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty ListMap EMap a
forall a. ListMap EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty VMap (ListMap RFMap a)
forall a. VMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (ListMap RFMap a)
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     EMap (TyMap a)
forall a. EMap a
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 = EMap a
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 = (EMap a -> Map RdrName a) -> EMap a -> EMap a -> Map RdrName a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> Map RdrName a
forall a. EMap a -> Map RdrName a
emHole EMap a
m1 EMap a
m2
    , emVar :: VMap a
emVar = (EMap a -> VMap a) -> EMap a -> EMap a -> VMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> VMap a
forall a. EMap a -> VMap a
emVar EMap a
m1 EMap a
m2
    , emIPVar :: FSEnv a
emIPVar = (EMap a -> FSEnv a) -> EMap a -> EMap a -> FSEnv a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> FSEnv a
forall a. EMap a -> FSEnv a
emIPVar EMap a
m1 EMap a
m2
    , emOverLit :: OLMap a
emOverLit = (EMap a -> OLMap a) -> EMap a -> EMap a -> OLMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> OLMap a
forall a. EMap a -> OLMap a
emOverLit EMap a
m1 EMap a
m2
    , emLit :: LMap a
emLit = (EMap a -> LMap a) -> EMap a -> EMap a -> LMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> LMap a
forall a. EMap a -> LMap a
emLit EMap a
m1 EMap a
m2
    , emLam :: MGMap a
emLam = (EMap a -> MGMap a) -> EMap a -> EMap a -> MGMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> MGMap a
forall a. EMap a -> MGMap a
emLam EMap a
m1 EMap a
m2
    , emApp :: EMap (EMap a)
emApp = (EMap a -> EMap (EMap a)) -> EMap a -> EMap a -> EMap (EMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emApp EMap a
m1 EMap a
m2
    , emOpApp :: EMap (EMap (EMap a))
emOpApp = (EMap a -> EMap (EMap (EMap a)))
-> EMap a -> EMap a -> EMap (EMap (EMap a))
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (EMap (EMap a))
forall a. EMap a -> EMap (EMap (EMap a))
emOpApp EMap a
m1 EMap a
m2
    , emNegApp :: EMap a
emNegApp = (EMap a -> EMap a) -> EMap a -> EMap a -> EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap a
forall a. EMap a -> EMap a
emNegApp EMap a
m1 EMap a
m2
    , emPar :: EMap a
emPar = (EMap a -> EMap a) -> EMap a -> EMap a -> EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap a
forall a. EMap a -> EMap a
emPar EMap a
m1 EMap a
m2
    , emExplicitTuple :: BoxityMap (ListMap TupArgMap a)
emExplicitTuple = (EMap a -> BoxityMap (ListMap TupArgMap a))
-> EMap a -> EMap a -> BoxityMap (ListMap TupArgMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> BoxityMap (ListMap TupArgMap a)
forall a. EMap a -> BoxityMap (ListMap TupArgMap a)
emExplicitTuple EMap a
m1 EMap a
m2
    , emCase :: EMap (MGMap a)
emCase = (EMap a -> EMap (MGMap a)) -> EMap a -> EMap a -> EMap (MGMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (MGMap a)
forall a. EMap a -> EMap (MGMap a)
emCase EMap a
m1 EMap a
m2
    , emSecL :: EMap (EMap a)
emSecL = (EMap a -> EMap (EMap a)) -> EMap a -> EMap a -> EMap (EMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emSecL EMap a
m1 EMap a
m2
    , emSecR :: EMap (EMap a)
emSecR = (EMap a -> EMap (EMap a)) -> EMap a -> EMap a -> EMap (EMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emSecR EMap a
m1 EMap a
m2
    , emIf :: EMap (EMap (EMap a))
emIf = (EMap a -> EMap (EMap (EMap a)))
-> EMap a -> EMap a -> EMap (EMap (EMap a))
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (EMap (EMap a))
forall a. EMap a -> EMap (EMap (EMap a))
emIf EMap a
m1 EMap a
m2
    , emLet :: LBMap (EMap a)
emLet = (EMap a -> LBMap (EMap a)) -> EMap a -> EMap a -> LBMap (EMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> LBMap (EMap a)
forall a. EMap a -> LBMap (EMap a)
emLet EMap a
m1 EMap a
m2
    , emDo :: SCMap (SLMap a)
emDo = (EMap a -> SCMap (SLMap a)) -> EMap a -> EMap a -> SCMap (SLMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> SCMap (SLMap a)
forall a. EMap a -> SCMap (SLMap a)
emDo EMap a
m1 EMap a
m2
    , emExplicitList :: ListMap EMap a
emExplicitList = (EMap a -> ListMap EMap a) -> EMap a -> EMap a -> ListMap EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> ListMap EMap a
forall a. EMap a -> ListMap EMap a
emExplicitList EMap a
m1 EMap a
m2
    , emRecordCon :: VMap (ListMap RFMap a)
emRecordCon = (EMap a -> VMap (ListMap RFMap a))
-> EMap a -> EMap a -> VMap (ListMap RFMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> VMap (ListMap RFMap a)
forall a. EMap a -> VMap (ListMap RFMap a)
emRecordCon EMap a
m1 EMap a
m2
    , emRecordUpd :: EMap (ListMap RFMap a)
emRecordUpd = (EMap a -> EMap (ListMap RFMap a))
-> EMap a -> EMap a -> EMap (ListMap RFMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (ListMap RFMap a)
forall a. EMap a -> EMap (ListMap RFMap a)
emRecordUpd EMap a
m1 EMap a
m2
    , emExprWithTySig :: EMap (TyMap a)
emExprWithTySig = (EMap a -> EMap (TyMap a)) -> EMap a -> EMap a -> EMap (TyMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn EMap a -> EMap (TyMap a)
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 = AlphaEnv -> Quantifiers -> Key EMap -> A a -> EMap a -> EMap a
forall a.
AlphaEnv -> Quantifiers -> Key EMap -> A a -> EMap a -> EMap a
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 EMap a
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 (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
e)
    where
      go :: HsExpr GhcPs -> EMap a
go (HsVar XVar GhcPs
_ LIdP GhcPs
v)
        | GenLocated (Anno (IdGhcP 'Parsed)) RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated (Anno (IdGhcP 'Parsed)) RdrName
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = EMap a
m { emHole  = mAlter env vs (unLoc v) f (emHole m) }
        | Bool
otherwise        = EMap a
m { emVar   = mAlter env vs (unLoc v) f (emVar m) }
      go (ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
as Boxity
b) =
        EMap a
m { emExplicitTuple = mAlter env vs b (toA (mAlter env vs as f)) (emExplicitTuple m) }
      go (HsApp XApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
r) =
        EMap a
m { emApp = mAlter env vs l (toA (mAlter env vs r f)) (emApp m) }
      go (HsCase XCase GhcPs
_ LHsExpr GhcPs
s MatchGroup GhcPs (LHsExpr GhcPs)
mg) =
        EMap a
m { emCase = mAlter env vs s (toA (mAlter env vs mg f)) (emCase m) }
      go (HsDo XDo GhcPs
_ HsDoFlavour
sc XRec GhcPs [ExprLStmt GhcPs]
ss) =
        EMap a
m { emDo = mAlter env vs sc (toA (mAlter env vs (unLoc ss) f)) (emDo 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 = mAlter env vs c
                      (toA (mAlter env vs tr
                          (toA (mAlter env vs fl f)))) (emIf m) }
      go (HsIPVar XIPVar GhcPs
_ (HsIPName FastString
ip)) = EMap a
m { emIPVar = mAlter env vs ip f (emIPVar m) }
      go (HsLit XLitE GhcPs
_ HsLit GhcPs
l) = EMap a
m { emLit   = mAlter env vs l f (emLit m) }
      go (HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg) = EMap a
m { emLam   = mAlter env vs mg f (emLam m) }
      go (HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
ol) = EMap a
m { emOverLit = mAlter env vs (ol_val ol) f (emOverLit m) }
      go (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e' SyntaxExpr GhcPs
_) = EMap a
m { emNegApp = mAlter env vs e' f (emNegApp m) }
#if __GLASGOW_HASKELL__ < 904
      go (HsPar _ e') = m { emPar  = mAlter env vs e' f (emPar m) }
#else
      go (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
e' LHsToken ")" GhcPs
_) = EMap a
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 = mAlter env vs o (toA (mAlter env vs l (toA (mAlter env vs r f)))) (emOpApp m) }
#if __GLASGOW_HASKELL__ < 904
      go (RecordCon _ v fs) =
        m { emRecordCon = mAlter env vs (unLoc v) (toA (mAlter env vs (fieldsToRdrNames $ rec_flds fs) f)) (emRecordCon m) }
#else
      go (RecordCon XRecordCon GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
v HsRecordBinds GhcPs
fs) =
        EMap a
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 = mAlter env vs e' (toA (mAlter env vs (fieldsToRdrNamesUpd fs) f)) (emRecordUpd m) }
      go (SectionL XSectionL GhcPs
_ LHsExpr GhcPs
lhs LHsExpr GhcPs
o) =
        EMap a
m { emSecL = mAlter env vs o (toA (mAlter env vs lhs f)) (emSecL m) }
      go (SectionR XSectionR GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
rhs) =
        EMap a
m { emSecR = mAlter env vs o (toA (mAlter env vs rhs f)) (emSecR m) }
#if __GLASGOW_HASKELL__ < 904
      go (HsLet _ lbs e') =
#else
      go (HsLet XLet GhcPs
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
lbs LHsToken "in" GhcPs
_ LHsExpr GhcPs
e') =
#endif
        let
          bs :: [IdP GhcPs]
bs = CollectFlag GhcPs -> HsLocalBinds GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
          env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
[RdrName]
bs
          vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
[RdrName]
bs
        in EMap a
m { emLet = mAlter env vs lbs (toA (mAlter env' vs' e' f)) (emLet m) }
      go HsLamCase{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsLamCase"
      go HsMultiIf{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsMultiIf"
      go (ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
es) = EMap a
m { emExplicitList = mAlter env vs es f (emExplicitList m) }
      go ArithSeq{} = String -> EMap a
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 = mAlter env vs e' (toA (mAlter env vs ty f)) (emExprWithTySig 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{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsPragE"
#endif
#if __GLASGOW_HASKELL__ < 904
      go HsBracket{} = missingSyntax "HsBracket"
      go HsRnBracketOut{} = missingSyntax "HsRnBracketOut"
      go HsTcBracketOut{} = missingSyntax "HsTcBracketOut"
      go HsSpliceE{} = missingSyntax "HsSpliceE"
      go HsProc{} = missingSyntax "HsProc"
      go HsStatic{} = missingSyntax "HsStatic"
#else
      go HsTypedBracket{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsTypedBracket"
      go HsUntypedBracket{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsUntypedBracket"
#if __GLASGOW_HASKELL__ < 906
      go HsSpliceE{} = missingSyntax "HsSpliceE"
#endif
#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{} = missingSyntax "HsTick"
      go HsBinTick{} = missingSyntax "HsBinTick"
#endif
      go HsUnboundVar{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsUnboundVar"
#if __GLASGOW_HASKELL__ < 904
      go HsRecFld{} = missingSyntax "HsRecFld"
#endif
      go HsOverLabel{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsOverLabel"
      go HsAppType{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsAppType"
#if __GLASGOW_HASKELL__ < 904
      go HsConLikeOut{} = missingSyntax "HsConLikeOut"
#endif
      go ExplicitSum{} = String -> EMap a
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 [(Substitution, a)] -> [(Substitution, a)] -> [(Substitution, a)]
forall a. [a] -> [a] -> [a]
++ HsExpr GhcPs -> (Substitution, EMap a) -> [(Substitution, a)]
go (GenLocated SrcSpanAnnA (HsExpr GhcPs) -> HsExpr GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
e) (Substitution
hs,EMap a
m)
    where
      hss :: [(Substitution, a)]
hss = Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
forall a.
Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult (EMap a -> Map RdrName a
forall a. EMap a -> Map RdrName a
emHole EMap a
m) (AnnotatedHsExpr -> HoleVal
HoleExpr (AnnotatedHsExpr -> HoleVal) -> AnnotatedHsExpr -> HoleVal
forall a b. (a -> b) -> a -> b
$ MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
e) Substitution
hs

      go :: HsExpr GhcPs -> (Substitution, EMap a) -> [(Substitution, a)]
go (ExplicitTuple XExplicitTuple GhcPs
_ [HsTupArg GhcPs]
as Boxity
b) = (EMap a -> BoxityMap (ListMap TupArgMap a))
-> (Substitution, EMap a)
-> [(Substitution, BoxityMap (ListMap TupArgMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> BoxityMap (ListMap TupArgMap a)
forall a. EMap a -> BoxityMap (ListMap TupArgMap a)
emExplicitTuple ((Substitution, EMap a)
 -> [(Substitution, BoxityMap (ListMap TupArgMap a))])
-> ((Substitution, BoxityMap (ListMap TupArgMap a))
    -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key BoxityMap
-> (Substitution, BoxityMap (ListMap TupArgMap a))
-> [(Substitution, ListMap TupArgMap a)]
forall a.
MatchEnv
-> Key BoxityMap
-> (Substitution, BoxityMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Boxity
Key BoxityMap
b ((Substitution, BoxityMap (ListMap TupArgMap a))
 -> [(Substitution, ListMap TupArgMap a)])
-> ((Substitution, ListMap TupArgMap a) -> [(Substitution, a)])
-> (Substitution, BoxityMap (ListMap TupArgMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap TupArgMap)
-> (Substitution, ListMap TupArgMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap TupArgMap)
-> (Substitution, ListMap TupArgMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [HsTupArg GhcPs]
Key (ListMap TupArgMap)
as
      go (HsApp XApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
r) = (EMap a -> EMap (EMap a))
-> (Substitution, EMap a) -> [(Substitution, EMap (EMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emApp ((Substitution, EMap a) -> [(Substitution, EMap (EMap a))])
-> ((Substitution, EMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
l ((Substitution, EMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, EMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
r
      go (HsCase XCase GhcPs
_ LHsExpr GhcPs
s MatchGroup GhcPs (LHsExpr GhcPs)
mg) = (EMap a -> EMap (MGMap a))
-> (Substitution, EMap a) -> [(Substitution, EMap (MGMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (MGMap a)
forall a. EMap a -> EMap (MGMap a)
emCase ((Substitution, EMap a) -> [(Substitution, EMap (MGMap a))])
-> ((Substitution, EMap (MGMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (MGMap a))
-> [(Substitution, MGMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
s ((Substitution, EMap (MGMap a)) -> [(Substitution, MGMap a)])
-> ((Substitution, MGMap a) -> [(Substitution, a)])
-> (Substitution, EMap (MGMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg
      go (HsDo XDo GhcPs
_ HsDoFlavour
sc XRec GhcPs [ExprLStmt GhcPs]
ss) = (EMap a -> SCMap (SLMap a))
-> (Substitution, EMap a) -> [(Substitution, SCMap (SLMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> SCMap (SLMap a)
forall a. EMap a -> SCMap (SLMap a)
emDo ((Substitution, EMap a) -> [(Substitution, SCMap (SLMap a))])
-> ((Substitution, SCMap (SLMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key SCMap
-> (Substitution, SCMap (SLMap a))
-> [(Substitution, SLMap a)]
forall a.
MatchEnv
-> Key SCMap -> (Substitution, SCMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsDoFlavour
Key SCMap
sc ((Substitution, SCMap (SLMap a)) -> [(Substitution, SLMap a)])
-> ((Substitution, SLMap a) -> [(Substitution, a)])
-> (Substitution, SCMap (SLMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (GenLocated
  SrcSpanAnnL
  [LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc XRec GhcPs [ExprLStmt GhcPs]
GenLocated
  SrcSpanAnnL
  [LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr 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
        (EMap a -> EMap (EMap (EMap a)))
-> (Substitution, EMap a) -> [(Substitution, EMap (EMap (EMap a)))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (EMap (EMap a))
forall a. EMap a -> EMap (EMap (EMap a))
emIf ((Substitution, EMap a) -> [(Substitution, EMap (EMap (EMap a)))])
-> ((Substitution, EMap (EMap (EMap a))) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (EMap (EMap a)))
-> [(Substitution, EMap (EMap a))]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
c ((Substitution, EMap (EMap (EMap a)))
 -> [(Substitution, EMap (EMap a))])
-> ((Substitution, EMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, EMap (EMap (EMap a)))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
tr ((Substitution, EMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, EMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
fl
      go (HsIPVar XIPVar GhcPs
_ (HsIPName FastString
ip)) = (EMap a -> FSEnv a)
-> (Substitution, EMap a) -> [(Substitution, FSEnv a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> FSEnv a
forall a. EMap a -> FSEnv a
emIPVar ((Substitution, EMap a) -> [(Substitution, FSEnv a)])
-> ((Substitution, FSEnv a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env FastString
Key FSEnv
ip
      go (HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg) = (EMap a -> MGMap a)
-> (Substitution, EMap a) -> [(Substitution, MGMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> MGMap a
forall a. EMap a -> MGMap a
emLam ((Substitution, EMap a) -> [(Substitution, MGMap a)])
-> ((Substitution, MGMap a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg
      go (HsLit XLitE GhcPs
_ HsLit GhcPs
l) = (EMap a -> LMap a)
-> (Substitution, EMap a) -> [(Substitution, LMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> LMap a
forall a. EMap a -> LMap a
emLit ((Substitution, EMap a) -> [(Substitution, LMap a)])
-> ((Substitution, LMap a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key LMap -> (Substitution, LMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key LMap -> (Substitution, LMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsLit GhcPs
Key LMap
l
      go (HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
ol) = (EMap a -> OLMap a)
-> (Substitution, EMap a) -> [(Substitution, OLMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> OLMap a
forall a. EMap a -> OLMap a
emOverLit ((Substitution, EMap a) -> [(Substitution, OLMap a)])
-> ((Substitution, OLMap a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key OLMap -> (Substitution, OLMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key OLMap -> (Substitution, OLMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
ol)
#if __GLASGOW_HASKELL__ < 904
      go (HsPar _ e') = mapFor emPar >=> mMatch env e'
#else
      go (HsPar XPar GhcPs
_ LHsToken "(" GhcPs
_ LHsExpr GhcPs
e' LHsToken ")" GhcPs
_) = (EMap a -> EMap a)
-> (Substitution, EMap a) -> [(Substitution, EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap a
forall a. EMap a -> EMap a
emPar ((Substitution, EMap a) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e'
#endif
      go (HsVar XVar GhcPs
_ LIdP GhcPs
v) = (EMap a -> VMap a)
-> (Substitution, EMap a) -> [(Substitution, VMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> VMap a
forall a. EMap a -> VMap a
emVar ((Substitution, EMap a) -> [(Substitution, VMap a)])
-> ((Substitution, VMap a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
v)
      go (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r) =
        (EMap a -> EMap (EMap (EMap a)))
-> (Substitution, EMap a) -> [(Substitution, EMap (EMap (EMap a)))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (EMap (EMap a))
forall a. EMap a -> EMap (EMap (EMap a))
emOpApp ((Substitution, EMap a) -> [(Substitution, EMap (EMap (EMap a)))])
-> ((Substitution, EMap (EMap (EMap a))) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (EMap (EMap a)))
-> [(Substitution, EMap (EMap a))]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
o ((Substitution, EMap (EMap (EMap a)))
 -> [(Substitution, EMap (EMap a))])
-> ((Substitution, EMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, EMap (EMap (EMap a)))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
l ((Substitution, EMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, EMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
r
      go (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e' SyntaxExpr GhcPs
_) = (EMap a -> EMap a)
-> (Substitution, EMap a) -> [(Substitution, EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap a
forall a. EMap a -> EMap a
emNegApp ((Substitution, EMap a) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e'
#if __GLASGOW_HASKELL__ < 904
      go (RecordCon _ v fs) =
        mapFor emRecordCon >=> mMatch env (unLoc v) >=> mMatch env (fieldsToRdrNames $ rec_flds fs)
#else
      go (RecordCon XRecordCon GhcPs
_ XRec GhcPs (ConLikeP GhcPs)
v HsRecordBinds GhcPs
fs) =
        (EMap a -> VMap (ListMap RFMap a))
-> (Substitution, EMap a)
-> [(Substitution, VMap (ListMap RFMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> VMap (ListMap RFMap a)
forall a. EMap a -> VMap (ListMap RFMap a)
emRecordCon ((Substitution, EMap a)
 -> [(Substitution, VMap (ListMap RFMap a))])
-> ((Substitution, VMap (ListMap RFMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key VMap
-> (Substitution, VMap (ListMap RFMap a))
-> [(Substitution, ListMap RFMap a)]
forall a.
MatchEnv
-> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
v) ((Substitution, VMap (ListMap RFMap a))
 -> [(Substitution, ListMap RFMap a)])
-> ((Substitution, ListMap RFMap a) -> [(Substitution, a)])
-> (Substitution, VMap (ListMap RFMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap RFMap)
-> (Substitution, ListMap RFMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap RFMap)
-> (Substitution, ListMap RFMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LHsRecField GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecordBinds GhcPs
HsRecFields GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
fs)
#endif
      go (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
e' Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fs) =
        (EMap a -> EMap (ListMap RFMap a))
-> (Substitution, EMap a)
-> [(Substitution, EMap (ListMap RFMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (ListMap RFMap a)
forall a. EMap a -> EMap (ListMap RFMap a)
emRecordUpd ((Substitution, EMap a)
 -> [(Substitution, EMap (ListMap RFMap a))])
-> ((Substitution, EMap (ListMap RFMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (ListMap RFMap a))
-> [(Substitution, ListMap RFMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e' ((Substitution, EMap (ListMap RFMap a))
 -> [(Substitution, ListMap RFMap a)])
-> ((Substitution, ListMap RFMap a) -> [(Substitution, a)])
-> (Substitution, EMap (ListMap RFMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap RFMap)
-> (Substitution, ListMap RFMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap RFMap)
-> (Substitution, ListMap RFMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
-> [LHsRecField GhcPs (LHsExpr GhcPs)]
fieldsToRdrNamesUpd Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
fs)
      go (SectionL XSectionL GhcPs
_ LHsExpr GhcPs
lhs LHsExpr GhcPs
o) = (EMap a -> EMap (EMap a))
-> (Substitution, EMap a) -> [(Substitution, EMap (EMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emSecL ((Substitution, EMap a) -> [(Substitution, EMap (EMap a))])
-> ((Substitution, EMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
o ((Substitution, EMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, EMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
lhs
      go (SectionR XSectionR GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
rhs) = (EMap a -> EMap (EMap a))
-> (Substitution, EMap a) -> [(Substitution, EMap (EMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emSecR ((Substitution, EMap a) -> [(Substitution, EMap (EMap a))])
-> ((Substitution, EMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
o ((Substitution, EMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, EMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
rhs
#if __GLASGOW_HASKELL__ < 904
      go (HsLet _ lbs e') =
#else
      go (HsLet XLet GhcPs
_ LHsToken "let" GhcPs
_ HsLocalBinds GhcPs
lbs LHsToken "in" GhcPs
_ LHsExpr GhcPs
e') =
#endif
        let
          bs :: [IdP GhcPs]
bs = CollectFlag GhcPs -> HsLocalBinds GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
          env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
bs
        in (EMap a -> LBMap (EMap a))
-> (Substitution, EMap a) -> [(Substitution, LBMap (EMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> LBMap (EMap a)
forall a. EMap a -> LBMap (EMap a)
emLet ((Substitution, EMap a) -> [(Substitution, LBMap (EMap a))])
-> ((Substitution, LBMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key LBMap
-> (Substitution, LBMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key LBMap -> (Substitution, LBMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsLocalBinds GhcPs
Key LBMap
lbs ((Substitution, LBMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, LBMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' LHsExpr GhcPs
Key EMap
e'
      go (ExplicitList XExplicitList GhcPs
_ [LHsExpr GhcPs]
es) = (EMap a -> ListMap EMap a)
-> (Substitution, EMap a) -> [(Substitution, ListMap EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> ListMap EMap a
forall a. EMap a -> ListMap EMap a
emExplicitList ((Substitution, EMap a) -> [(Substitution, ListMap EMap a)])
-> ((Substitution, ListMap EMap a) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap EMap)
-> (Substitution, ListMap EMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap EMap)
-> (Substitution, ListMap EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LHsExpr GhcPs]
Key (ListMap EMap)
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)))) =
        (EMap a -> EMap (TyMap a))
-> (Substitution, EMap a) -> [(Substitution, EMap (TyMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor EMap a -> EMap (TyMap a)
forall a. EMap a -> EMap (TyMap a)
emExprWithTySig ((Substitution, EMap a) -> [(Substitution, EMap (TyMap a))])
-> ((Substitution, EMap (TyMap a)) -> [(Substitution, a)])
-> (Substitution, EMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap
-> (Substitution, EMap (TyMap a))
-> [(Substitution, TyMap a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e' ((Substitution, EMap (TyMap a)) -> [(Substitution, TyMap a)])
-> ((Substitution, TyMap a) -> [(Substitution, a)])
-> (Substitution, EMap (TyMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty
      go HsExpr GhcPs
_ = [(Substitution, a)]
-> (Substitution, EMap a) -> [(Substitution, a)]
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 = [Maybe (Substitution, a)] -> [(Substitution, a)]
forall a. [Maybe a] -> [a]
catMaybes
  [ case FastString -> Substitution -> Maybe HoleVal
lookupSubst FastString
n Substitution
sub of
      Maybe HoleVal
Nothing -> (Substitution, a) -> Maybe (Substitution, a)
forall a. a -> Maybe a
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' Maybe () -> Maybe (Substitution, a) -> Maybe (Substitution, a)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Substitution, a) -> Maybe (Substitution, a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Substitution
sub, a
x)
  | (RdrName
nm,a
x) <- Map RdrName a -> [(RdrName, a)]
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] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
singleton [a]
_  = Maybe 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)  =
  Key EMap -> Key EMap -> EMap () -> Maybe ()
forall (m :: * -> *).
PatternMap m =>
Key m -> Key m -> m () -> Maybe ()
alphaEquivalent (Annotated (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedHsExpr
Annotated (GenLocated SrcSpanAnnA (HsExpr GhcPs))
e1) (Annotated (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedHsExpr
Annotated (GenLocated SrcSpanAnnA (HsExpr GhcPs))
e2) EMap ()
forall a. EMap a
EMEmpty
sameHoleValue (HolePat AnnotatedPat
p1)   (HolePat AnnotatedPat
p2)   =
  Key PatMap -> Key PatMap -> PatMap () -> Maybe ()
forall (m :: * -> *).
PatternMap m =>
Key m -> Key m -> m () -> Maybe ()
alphaEquivalent (LPat GhcPs -> LPat GhcPs
forall (p :: Pass). LPat (GhcPass p) -> LPat (GhcPass p)
cLPat (LPat GhcPs -> LPat GhcPs) -> LPat GhcPs -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ Annotated (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedPat
Annotated (GenLocated SrcSpanAnnA (Pat GhcPs))
p1) (LPat GhcPs -> LPat GhcPs
forall (p :: Pass). LPat (GhcPass p) -> LPat (GhcPass p)
cLPat (LPat GhcPs -> LPat GhcPs) -> LPat GhcPs -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ Annotated (GenLocated SrcSpanAnnA (Pat GhcPs))
-> GenLocated SrcSpanAnnA (Pat GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedPat
Annotated (GenLocated SrcSpanAnnA (Pat GhcPs))
p2) PatMap ()
forall a. PatMap a
PatEmpty
sameHoleValue (HoleType AnnotatedHsType
ty1) (HoleType AnnotatedHsType
ty2) =
  Key TyMap -> Key TyMap -> TyMap () -> Maybe ()
forall (m :: * -> *).
PatternMap m =>
Key m -> Key m -> m () -> Maybe ()
alphaEquivalent (Annotated (LocatedA (HsType GhcPs)) -> LocatedA (HsType GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedHsType
Annotated (LocatedA (HsType GhcPs))
ty1) (Annotated (LocatedA (HsType GhcPs)) -> LocatedA (HsType GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedHsType
Annotated (LocatedA (HsType GhcPs))
ty2) TyMap ()
forall a. TyMap a
TyEmpty
sameHoleValue HoleVal
_              HoleVal
_              = Maybe ()
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 = (Substitution, ()) -> ()
forall a b. (a, b) -> b
snd ((Substitution, ()) -> ()) -> Maybe (Substitution, ()) -> Maybe ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Substitution, ())] -> Maybe (Substitution, ())
forall a. [a] -> Maybe a
singleton (MatchEnv -> Key m -> m () -> [(Substitution, ())]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> m a -> [(Substitution, a)]
findMatch MatchEnv
env Key m
v2 m ()
m)
  where
    m :: m ()
m = AlphaEnv -> Quantifiers -> Key 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 a -> Annotated a
forall a. a -> Annotated a
forall {p} {a}. p -> a
err
    err :: p -> a
err p
_ = String -> a
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 -> b) -> SCMap a -> SCMap b)
-> (forall a b. a -> SCMap b -> SCMap a) -> Functor SCMap
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
$cfmap :: forall a b. (a -> b) -> SCMap a -> SCMap b
fmap :: forall a b. (a -> b) -> SCMap a -> SCMap b
$c<$ :: forall a b. a -> SCMap b -> SCMap a
<$ :: forall a b. a -> SCMap b -> SCMap a
Functor)

emptySCMapWrapper :: SCMap a
emptySCMapWrapper :: forall a. SCMap a
emptySCMapWrapper = MaybeMap a -> MaybeMap a -> FSEnv a -> SCMap a
forall a. MaybeMap a -> MaybeMap a -> FSEnv a -> SCMap a
SCM MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall a. FSEnv a
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 = SCMap a
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 = (SCMap a -> MaybeMap a) -> SCMap a -> SCMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SCMap a -> MaybeMap a
forall a. SCMap a -> MaybeMap a
scmListComp SCMap a
m1 SCMap a
m2
    , scmMonadComp :: MaybeMap a
scmMonadComp = (SCMap a -> MaybeMap a) -> SCMap a -> SCMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SCMap a -> MaybeMap a
forall a. SCMap a -> MaybeMap a
scmMonadComp SCMap a
m1 SCMap a
m2
    , scmDoExpr :: FSEnv a
scmDoExpr = (SCMap a -> FSEnv a) -> SCMap a -> SCMap a -> FSEnv a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SCMap a -> FSEnv a
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 = AlphaEnv -> Quantifiers -> Key SCMap -> A a -> SCMap a -> SCMap a
forall a.
AlphaEnv -> Quantifiers -> Key SCMap -> A a -> SCMap a -> SCMap a
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 SCMap a
forall a. SCMap a
emptySCMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key SCMap
sc A a
f m :: SCMap a
m@SCM{} = HsDoFlavour -> SCMap a
go HsDoFlavour
Key SCMap
sc
    where
      go :: HsDoFlavour -> SCMap a
go HsDoFlavour
ListComp = SCMap a
m { scmListComp = mAlter env vs () f (scmListComp m) }
      go HsDoFlavour
MonadComp = SCMap a
m { scmMonadComp = mAlter env vs () f (scmMonadComp 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 = mAlter env vs (maybe "" moduleNameFS mname) f (scmDoExpr m) }
#endif
      go MDoExpr{} = String -> SCMap a
forall a. String -> a
missingSyntax String
"MDoExpr"
#if __GLASGOW_HASKELL__ < 904
      go ArrowExpr = missingSyntax "ArrowExpr"
      go (PatGuard _) = missingSyntax "PatGuard"
      go (ParStmtCtxt _) = missingSyntax "ParStmtCtxt"
      go (TransStmtCtxt _) = missingSyntax "TransStmtCtxt"
#endif
      go HsDoFlavour
GhciStmtCtxt = String -> SCMap a
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{}) = HsDoFlavour -> (Substitution, SCMap a) -> [(Substitution, a)]
go HsDoFlavour
Key SCMap
sc (Substitution
hs,SCMap a
m)
    where
      go :: HsDoFlavour -> (Substitution, SCMap a) -> [(Substitution, a)]
go HsDoFlavour
ListComp = (SCMap a -> MaybeMap a)
-> (Substitution, SCMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SCMap a -> MaybeMap a
forall a. SCMap a -> MaybeMap a
scmListComp ((Substitution, SCMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, SCMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go HsDoFlavour
MonadComp = (SCMap a -> MaybeMap a)
-> (Substitution, SCMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SCMap a -> MaybeMap a
forall a. SCMap a -> MaybeMap a
scmMonadComp ((Substitution, SCMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, SCMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
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) = (SCMap a -> FSEnv a)
-> (Substitution, SCMap a) -> [(Substitution, FSEnv a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SCMap a -> FSEnv a
forall a. SCMap a -> FSEnv a
scmDoExpr ((Substitution, SCMap a) -> [(Substitution, FSEnv a)])
-> ((Substitution, FSEnv a) -> [(Substitution, a)])
-> (Substitution, SCMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (FastString
-> (ModuleName -> FastString) -> Maybe ModuleName -> FastString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FastString
"" ModuleName -> FastString
moduleNameFS Maybe ModuleName
mname)
#endif
      go HsDoFlavour
_ = [(Substitution, a)]
-> (Substitution, SCMap a) -> [(Substitution, a)]
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 -> b) -> MGMap a -> MGMap b)
-> (forall a b. a -> MGMap b -> MGMap a) -> Functor MGMap
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
$cfmap :: forall a b. (a -> b) -> MGMap a -> MGMap b
fmap :: forall a b. (a -> b) -> MGMap a -> MGMap b
$c<$ :: forall a b. a -> MGMap b -> MGMap a
<$ :: forall a b. a -> MGMap b -> MGMap a
Functor)

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

  mEmpty :: MGMap a
  mEmpty :: forall a. MGMap a
mEmpty = ListMap MMap a -> MGMap a
forall a. ListMap MMap a -> MGMap a
MGMap ListMap MMap a
forall a. ListMap MMap a
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) = ListMap MMap a -> MGMap a
forall a. ListMap MMap a -> MGMap a
MGMap (ListMap MMap a -> ListMap MMap a -> ListMap MMap a
forall a. ListMap MMap a -> ListMap MMap a -> ListMap MMap a
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) = ListMap MMap a -> MGMap a
forall a. ListMap MMap a -> MGMap a
MGMap (AlphaEnv
-> Quantifiers
-> Key (ListMap MMap)
-> A a
-> ListMap MMap a
-> ListMap MMap a
forall a.
AlphaEnv
-> Quantifiers
-> Key (ListMap MMap)
-> A a
-> ListMap MMap a
-> ListMap MMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
Key (ListMap MMap)
alts A a
f ListMap MMap a
m)
    where alts :: [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
alts = (GenLocated
   (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc (GenLocated
  (Anno
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
  [GenLocated
     (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
     (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   (Anno
      [GenLocated
         (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
         (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
   [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
       (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> GenLocated
     (Anno
        [GenLocated
           (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
           (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 = (MGMap a -> ListMap MMap a)
-> (Substitution, MGMap a) -> [(Substitution, ListMap MMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor MGMap a -> ListMap MMap a
forall a. MGMap a -> ListMap MMap a
unMGMap ((Substitution, MGMap a) -> [(Substitution, ListMap MMap a)])
-> ((Substitution, ListMap MMap a) -> [(Substitution, a)])
-> (Substitution, MGMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap MMap)
-> (Substitution, ListMap MMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap MMap)
-> (Substitution, ListMap MMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
Key (ListMap MMap)
alts
    where alts :: [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
alts = (GenLocated
   (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc (GenLocated
  (Anno
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
  [GenLocated
     (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
     (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall l e. GenLocated l e -> e
unLoc (GenLocated
   (Anno
      [GenLocated
         (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
         (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
   [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GenLocated
       (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
       (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> GenLocated
     (Anno
        [GenLocated
           (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
           (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
     [GenLocated
        (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
        (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      (Anno (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
      (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 -> b) -> MMap a -> MMap b)
-> (forall a b. a -> MMap b -> MMap a) -> Functor MMap
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
$cfmap :: forall a b. (a -> b) -> MMap a -> MMap b
fmap :: forall a b. (a -> b) -> MMap a -> MMap b
$c<$ :: forall a b. a -> MMap b -> MMap a
<$ :: forall a b. a -> MMap b -> MMap a
Functor)

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

  mEmpty :: MMap a
  mEmpty :: forall a. MMap a
mEmpty = ListMap PatMap (GRHSSMap a) -> MMap a
forall a. ListMap PatMap (GRHSSMap a) -> MMap a
MMap ListMap PatMap (GRHSSMap a)
forall a. ListMap PatMap a
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) = ListMap PatMap (GRHSSMap a) -> MMap a
forall a. ListMap PatMap (GRHSSMap a) -> MMap a
MMap (ListMap PatMap (GRHSSMap a)
-> ListMap PatMap (GRHSSMap a) -> ListMap PatMap (GRHSSMap a)
forall a. ListMap PatMap a -> ListMap PatMap a -> ListMap PatMap a
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 = Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> [LPat GhcPs]
forall p body. Match p body -> [LPat p]
m_pats Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Key MMap
match
        pbs :: [IdP GhcPs]
pbs = CollectFlag GhcPs -> [LPat GhcPs] -> [IdP GhcPs]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders [LPat GhcPs]
lpats
        env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
[RdrName]
pbs
        vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
[RdrName]
pbs
    in ListMap PatMap (GRHSSMap a) -> MMap a
forall a. ListMap PatMap (GRHSSMap a) -> MMap a
MMap (AlphaEnv
-> Quantifiers
-> Key (ListMap PatMap)
-> A (GRHSSMap a)
-> ListMap PatMap (GRHSSMap a)
-> ListMap PatMap (GRHSSMap a)
forall a.
AlphaEnv
-> Quantifiers
-> Key (ListMap PatMap)
-> A a
-> ListMap PatMap a
-> ListMap PatMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LPat GhcPs]
Key (ListMap PatMap)
lpats
              ((GRHSSMap a -> GRHSSMap a) -> A (GRHSSMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers -> Key GRHSSMap -> A a -> GRHSSMap a -> GRHSSMap a
forall a.
AlphaEnv
-> Quantifiers -> Key GRHSSMap -> A a -> GRHSSMap a -> GRHSSMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 = (MMap a -> ListMap PatMap (GRHSSMap a))
-> (Substitution, MMap a)
-> [(Substitution, ListMap PatMap (GRHSSMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor MMap a -> ListMap PatMap (GRHSSMap a)
forall a. MMap a -> ListMap PatMap (GRHSSMap a)
unMMap ((Substitution, MMap a)
 -> [(Substitution, ListMap PatMap (GRHSSMap a))])
-> ((Substitution, ListMap PatMap (GRHSSMap a))
    -> [(Substitution, a)])
-> (Substitution, MMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap PatMap)
-> (Substitution, ListMap PatMap (GRHSSMap a))
-> [(Substitution, GRHSSMap a)]
forall a.
MatchEnv
-> Key (ListMap PatMap)
-> (Substitution, ListMap PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LPat GhcPs]
Key (ListMap PatMap)
lpats ((Substitution, ListMap PatMap (GRHSSMap a))
 -> [(Substitution, GRHSSMap a)])
-> ((Substitution, GRHSSMap a) -> [(Substitution, a)])
-> (Substitution, ListMap PatMap (GRHSSMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key GRHSSMap
-> (Substitution, GRHSSMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key GRHSSMap
-> (Substitution, GRHSSMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Key MMap
match)
    where
      lpats :: [LPat GhcPs]
lpats = Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> [LPat GhcPs]
forall p body. Match p body -> [LPat p]
m_pats Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Key MMap
match
      pbs :: [IdP GhcPs]
pbs = CollectFlag GhcPs -> [LPat GhcPs] -> [IdP GhcPs]
forall p. CollectPass p => CollectFlag p -> [LPat p] -> [IdP p]
collectPatsBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders [LPat GhcPs]
lpats
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
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 -> b) -> CDMap a -> CDMap b)
-> (forall a b. a -> CDMap b -> CDMap a) -> Functor CDMap
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
$cfmap :: forall a b. (a -> b) -> CDMap a -> CDMap b
fmap :: forall a b. (a -> b) -> CDMap a -> CDMap b
$c<$ :: forall a b. a -> CDMap b -> CDMap a
<$ :: forall a b. a -> CDMap b -> CDMap a
Functor)

emptyCDMapWrapper :: CDMap a
emptyCDMapWrapper :: forall a. CDMap a
emptyCDMapWrapper = ListMap PatMap a -> PatMap (PatMap a) -> CDMap a
forall a. ListMap PatMap a -> PatMap (PatMap a) -> CDMap a
CDMap ListMap PatMap a
forall a. ListMap PatMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap (PatMap a)
forall a. PatMap a
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))
#elif __GLASGOW_HASKELL__ < 906
  -- 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))
#else
  type Key CDMap = HsConDetails (HsConPatTyArg GhcPs) (LocatedA (Pat GhcPs)) (HsRecFields GhcPs (LocatedA (Pat GhcPs)))
#endif

  mEmpty :: CDMap a
  mEmpty :: forall a. CDMap a
mEmpty = CDMap a
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 = (CDMap a -> ListMap PatMap a)
-> CDMap a -> CDMap a -> ListMap PatMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn CDMap a -> ListMap PatMap a
forall a. CDMap a -> ListMap PatMap a
cdPrefixCon CDMap a
m1 CDMap a
m2
    , cdInfixCon :: PatMap (PatMap a)
cdInfixCon = (CDMap a -> PatMap (PatMap a))
-> CDMap a -> CDMap a -> PatMap (PatMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn CDMap a -> PatMap (PatMap a)
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   = AlphaEnv -> Quantifiers -> Key CDMap -> A a -> CDMap a -> CDMap a
forall a.
AlphaEnv -> Quantifiers -> Key CDMap -> A a -> CDMap a -> CDMap a
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 CDMap a
forall a. CDMap a
emptyCDMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key CDMap
d A a
f m :: CDMap a
m@CDMap{} = HsConDetails
  (HsConPatTyArg GhcPs)
  (GenLocated SrcSpanAnnA (Pat GhcPs))
  (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> CDMap a
go HsConDetails
  (HsConPatTyArg GhcPs)
  (GenLocated SrcSpanAnnA (Pat GhcPs))
  (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
Key CDMap
d
    where
      go :: HsConDetails
  (HsConPatTyArg GhcPs)
  (GenLocated SrcSpanAnnA (Pat GhcPs))
  (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> CDMap a
go (PrefixCon [HsConPatTyArg GhcPs]
tyargs [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps) = CDMap a
m { cdPrefixCon = mAlter env vs ps f (cdPrefixCon m) }
      go (RecCon HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs))
_) = String -> CDMap a
forall a. String -> a
missingSyntax String
"RecCon"
      go (InfixCon GenLocated SrcSpanAnnA (Pat GhcPs)
p1 GenLocated SrcSpanAnnA (Pat GhcPs)
p2) = CDMap a
m { cdInfixCon = mAlter env vs p1
                                              (toA (mAlter env vs p2 f))
                                              (cdInfixCon 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
  (HsConPatTyArg GhcPs)
  (GenLocated SrcSpanAnnA (Pat GhcPs))
  (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (Substitution, CDMap a) -> [(Substitution, a)]
go HsConDetails
  (HsConPatTyArg GhcPs)
  (GenLocated SrcSpanAnnA (Pat GhcPs))
  (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
Key CDMap
d (Substitution
hs,CDMap a
m)
    where
      go :: HsConDetails
  (HsConPatTyArg GhcPs)
  (GenLocated SrcSpanAnnA (Pat GhcPs))
  (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> (Substitution, CDMap a) -> [(Substitution, a)]
go (PrefixCon [HsConPatTyArg GhcPs]
tyargs [GenLocated SrcSpanAnnA (Pat GhcPs)]
ps) = (CDMap a -> ListMap PatMap a)
-> (Substitution, CDMap a) -> [(Substitution, ListMap PatMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor CDMap a -> ListMap PatMap a
forall a. CDMap a -> ListMap PatMap a
cdPrefixCon ((Substitution, CDMap a) -> [(Substitution, ListMap PatMap a)])
-> ((Substitution, ListMap PatMap a) -> [(Substitution, a)])
-> (Substitution, CDMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap PatMap)
-> (Substitution, ListMap PatMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap PatMap)
-> (Substitution, ListMap PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [GenLocated SrcSpanAnnA (Pat GhcPs)]
Key (ListMap PatMap)
ps
      go (InfixCon GenLocated SrcSpanAnnA (Pat GhcPs)
p1 GenLocated SrcSpanAnnA (Pat GhcPs)
p2) = (CDMap a -> PatMap (PatMap a))
-> (Substitution, CDMap a) -> [(Substitution, PatMap (PatMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor CDMap a -> PatMap (PatMap a)
forall a. CDMap a -> PatMap (PatMap a)
cdInfixCon ((Substitution, CDMap a) -> [(Substitution, PatMap (PatMap a))])
-> ((Substitution, PatMap (PatMap a)) -> [(Substitution, a)])
-> (Substitution, CDMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key PatMap
-> (Substitution, PatMap (PatMap a))
-> [(Substitution, PatMap a)]
forall a.
MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated SrcSpanAnnA (Pat GhcPs)
Key PatMap
p1 ((Substitution, PatMap (PatMap a)) -> [(Substitution, PatMap a)])
-> ((Substitution, PatMap a) -> [(Substitution, a)])
-> (Substitution, PatMap (PatMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated SrcSpanAnnA (Pat GhcPs)
Key PatMap
p2
      go HsConDetails
  (HsConPatTyArg GhcPs)
  (GenLocated SrcSpanAnnA (Pat GhcPs))
  (HsRecFields GhcPs (GenLocated SrcSpanAnnA (Pat GhcPs)))
_ = [(Substitution, a)]
-> (Substitution, CDMap a) -> [(Substitution, a)]
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 -> b) -> PatMap a -> PatMap b)
-> (forall a b. a -> PatMap b -> PatMap a) -> Functor PatMap
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
$cfmap :: forall a b. (a -> b) -> PatMap a -> PatMap b
fmap :: forall a b. (a -> b) -> PatMap a -> PatMap b
$c<$ :: forall a b. a -> PatMap b -> PatMap a
<$ :: forall a b. a -> PatMap b -> PatMap a
Functor)

emptyPatMapWrapper :: PatMap a
emptyPatMapWrapper :: forall a. PatMap a
emptyPatMapWrapper = Map RdrName a
-> MaybeMap a
-> MaybeMap a
-> PatMap a
-> BoxityMap (ListMap PatMap a)
-> FSEnv (CDMap a)
-> PatMap a
forall a.
Map RdrName a
-> MaybeMap a
-> MaybeMap a
-> PatMap a
-> BoxityMap (ListMap PatMap a)
-> FSEnv (CDMap a)
-> PatMap a
PatMap Map RdrName a
forall a. Map RdrName a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap a
forall a. PatMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty BoxityMap (ListMap PatMap a)
forall a. BoxityMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv (CDMap a)
forall a. FSEnv a
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 = PatMap a
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 = (PatMap a -> Map RdrName a)
-> PatMap a -> PatMap a -> Map RdrName a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn PatMap a -> Map RdrName a
forall a. PatMap a -> Map RdrName a
pmHole PatMap a
m1 PatMap a
m2
    , pmWild :: MaybeMap a
pmWild = (PatMap a -> MaybeMap a) -> PatMap a -> PatMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn PatMap a -> MaybeMap a
forall a. PatMap a -> MaybeMap a
pmWild PatMap a
m1 PatMap a
m2
    , pmVar :: MaybeMap a
pmVar = (PatMap a -> MaybeMap a) -> PatMap a -> PatMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn PatMap a -> MaybeMap a
forall a. PatMap a -> MaybeMap a
pmVar PatMap a
m1 PatMap a
m2
    , pmParPat :: PatMap a
pmParPat = (PatMap a -> PatMap a) -> PatMap a -> PatMap a -> PatMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn PatMap a -> PatMap a
forall a. PatMap a -> PatMap a
pmParPat PatMap a
m1 PatMap a
m2
    , pmTuplePat :: BoxityMap (ListMap PatMap a)
pmTuplePat = (PatMap a -> BoxityMap (ListMap PatMap a))
-> PatMap a -> PatMap a -> BoxityMap (ListMap PatMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn PatMap a -> BoxityMap (ListMap PatMap a)
forall a. PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat PatMap a
m1 PatMap a
m2
    , pmConPatIn :: FSEnv (CDMap a)
pmConPatIn = (PatMap a -> FSEnv (CDMap a))
-> PatMap a -> PatMap a -> FSEnv (CDMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn PatMap a -> FSEnv (CDMap a)
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   = AlphaEnv
-> Quantifiers -> Key PatMap -> A a -> PatMap a -> PatMap a
forall a.
AlphaEnv
-> Quantifiers -> Key PatMap -> A a -> PatMap a -> PatMap a
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 PatMap a
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 (GenLocated SrcSpanAnnA (Pat GhcPs) -> Pat GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (Pat GhcPs)
Key PatMap
pat)
    where
      go :: Pat GhcPs -> PatMap a
go (WildPat XWildPat GhcPs
_) = PatMap a
m { pmWild = mAlter env vs () f (pmWild m) }
      go (VarPat XVarPat GhcPs
_ LIdP GhcPs
v)
        | GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = PatMap a
m { pmHole  = mAlter env vs (unLoc v) f (pmHole m) }
        | Bool
otherwise        = PatMap a
m { pmVar   = mAlter env vs () f (pmVar m) } -- See Note [Variable Binders]
      go LazyPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"LazyPat"
      go AsPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"AsPat"
      go BangPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"BangPat"
      go ListPat{} = String -> PatMap a
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 = mAlter env vs (rdrFS (unLoc c)) (toA (mAlter env vs d f)) (pmConPatIn m) }
      go ViewPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"ViewPat"
      go SplicePat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"SplicePat"
      go LitPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"LitPat"
      go NPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"NPat"
      go NPlusKPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"NPlusKPat"
#if __GLASGOW_HASKELL__ < 904
      go (ParPat _ p) = m { pmParPat = mAlter env vs p f (pmParPat m) }
#else
      go (ParPat XParPat GhcPs
_ LHsToken "(" GhcPs
_ LPat GhcPs
p LHsToken ")" GhcPs
_) = PatMap a
m { pmParPat = mAlter env vs p f (pmParPat m) }
#endif
      go (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
ps Boxity
b) =
        PatMap a
m { pmTuplePat = mAlter env vs b (toA (mAlter env vs ps f)) (pmTuplePat m) }
      go SigPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"SigPat"
      go SumPat{} = String -> PatMap a
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) <- LPat GhcPs -> Maybe (LPat GhcPs)
forall (p :: Pass). LPat (GhcPass p) -> Maybe (LPat (GhcPass p))
dLPat LPat GhcPs
Key PatMap
pat = GenLocated SrcSpanAnnA (Pat GhcPs) -> [(Substitution, a)]
hss LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
lp [(Substitution, a)] -> [(Substitution, a)] -> [(Substitution, a)]
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 :: GenLocated SrcSpanAnnA (Pat GhcPs) -> [(Substitution, a)]
hss GenLocated SrcSpanAnnA (Pat GhcPs)
lp = Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
forall a.
Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult (PatMap a -> Map RdrName a
forall a. PatMap a -> Map RdrName a
pmHole PatMap a
m) (AnnotatedPat -> HoleVal
HolePat (AnnotatedPat -> HoleVal) -> AnnotatedPat -> HoleVal
forall a b. (a -> b) -> a -> b
$ MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env GenLocated SrcSpanAnnA (Pat GhcPs)
lp) Substitution
hs

      go :: Pat GhcPs -> (Substitution, PatMap a) -> [(Substitution, a)]
go (WildPat XWildPat GhcPs
_) = (PatMap a -> MaybeMap a)
-> (Substitution, PatMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor PatMap a -> MaybeMap a
forall a. PatMap a -> MaybeMap a
pmWild ((Substitution, PatMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
#if __GLASGOW_HASKELL__ < 904
      go (ParPat _ p) = mapFor pmParPat >=> mMatch env p
#else
      go (ParPat XParPat GhcPs
_ LHsToken "(" GhcPs
_ LPat GhcPs
p LHsToken ")" GhcPs
_) = (PatMap a -> PatMap a)
-> (Substitution, PatMap a) -> [(Substitution, PatMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor PatMap a -> PatMap a
forall a. PatMap a -> PatMap a
pmParPat ((Substitution, PatMap a) -> [(Substitution, PatMap a)])
-> ((Substitution, PatMap a) -> [(Substitution, a)])
-> (Substitution, PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LPat GhcPs
Key PatMap
p
#endif
      go (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
ps Boxity
b) = (PatMap a -> BoxityMap (ListMap PatMap a))
-> (Substitution, PatMap a)
-> [(Substitution, BoxityMap (ListMap PatMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor PatMap a -> BoxityMap (ListMap PatMap a)
forall a. PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat ((Substitution, PatMap a)
 -> [(Substitution, BoxityMap (ListMap PatMap a))])
-> ((Substitution, BoxityMap (ListMap PatMap a))
    -> [(Substitution, a)])
-> (Substitution, PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key BoxityMap
-> (Substitution, BoxityMap (ListMap PatMap a))
-> [(Substitution, ListMap PatMap a)]
forall a.
MatchEnv
-> Key BoxityMap
-> (Substitution, BoxityMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Boxity
Key BoxityMap
b ((Substitution, BoxityMap (ListMap PatMap a))
 -> [(Substitution, ListMap PatMap a)])
-> ((Substitution, ListMap PatMap a) -> [(Substitution, a)])
-> (Substitution, BoxityMap (ListMap PatMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap PatMap)
-> (Substitution, ListMap PatMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap PatMap)
-> (Substitution, ListMap PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LPat GhcPs]
Key (ListMap PatMap)
ps
      go (VarPat XVarPat GhcPs
_ LIdP GhcPs
_) = (PatMap a -> MaybeMap a)
-> (Substitution, PatMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor PatMap a -> MaybeMap a
forall a. PatMap a -> MaybeMap a
pmVar ((Substitution, PatMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
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
        (PatMap a -> FSEnv (CDMap a))
-> (Substitution, PatMap a) -> [(Substitution, FSEnv (CDMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor PatMap a -> FSEnv (CDMap a)
forall a. PatMap a -> FSEnv (CDMap a)
pmConPatIn ((Substitution, PatMap a) -> [(Substitution, FSEnv (CDMap a))])
-> ((Substitution, FSEnv (CDMap a)) -> [(Substitution, a)])
-> (Substitution, PatMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key FSEnv
-> (Substitution, FSEnv (CDMap a))
-> [(Substitution, CDMap a)]
forall a.
MatchEnv
-> Key FSEnv -> (Substitution, FSEnv a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (RdrName -> FastString
rdrFS (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc XRec GhcPs (ConLikeP GhcPs)
GenLocated SrcSpanAnnN RdrName
c)) ((Substitution, FSEnv (CDMap a)) -> [(Substitution, CDMap a)])
-> ((Substitution, CDMap a) -> [(Substitution, a)])
-> (Substitution, FSEnv (CDMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key CDMap -> (Substitution, CDMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key CDMap -> (Substitution, CDMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsConPatDetails GhcPs
Key CDMap
d
      go Pat GhcPs
_ = [(Substitution, a)]
-> (Substitution, PatMap a) -> [(Substitution, a)]
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 -> b) -> GRHSSMap a -> GRHSSMap b)
-> (forall a b. a -> GRHSSMap b -> GRHSSMap a) -> Functor GRHSSMap
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
$cfmap :: forall a b. (a -> b) -> GRHSSMap a -> GRHSSMap b
fmap :: forall a b. (a -> b) -> GRHSSMap a -> GRHSSMap b
$c<$ :: forall a b. a -> GRHSSMap b -> GRHSSMap a
<$ :: forall a b. a -> GRHSSMap b -> GRHSSMap a
Functor)

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

  mEmpty :: GRHSSMap a
  mEmpty :: forall a. GRHSSMap a
mEmpty = LBMap (ListMap GRHSMap a) -> GRHSSMap a
forall a. LBMap (ListMap GRHSMap a) -> GRHSSMap a
GRHSSMap LBMap (ListMap GRHSMap a)
forall a. LBMap a
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) = LBMap (ListMap GRHSMap a) -> GRHSSMap a
forall a. LBMap (ListMap GRHSMap a) -> GRHSSMap a
GRHSSMap (LBMap (ListMap GRHSMap a)
-> LBMap (ListMap GRHSMap a) -> LBMap (ListMap GRHSMap a)
forall a. LBMap a -> LBMap a -> LBMap a
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 = GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsLocalBinds GhcPs
forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Key GRHSSMap
grhss
        bs :: [IdP GhcPs]
bs = CollectFlag GhcPs -> HsLocalBinds GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
        env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
[RdrName]
bs
        vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
[RdrName]
bs
    in LBMap (ListMap GRHSMap a) -> GRHSSMap a
forall a. LBMap (ListMap GRHSMap a) -> GRHSSMap a
GRHSSMap (AlphaEnv
-> Quantifiers
-> Key LBMap
-> A (ListMap GRHSMap a)
-> LBMap (ListMap GRHSMap a)
-> LBMap (ListMap GRHSMap a)
forall a.
AlphaEnv -> Quantifiers -> Key LBMap -> A a -> LBMap a -> LBMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsLocalBinds GhcPs
Key LBMap
lbs
                  ((ListMap GRHSMap a -> ListMap GRHSMap a) -> A (ListMap GRHSMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (ListMap GRHSMap)
-> A a
-> ListMap GRHSMap a
-> ListMap GRHSMap a
forall a.
AlphaEnv
-> Quantifiers
-> Key (ListMap GRHSMap)
-> A a
-> ListMap GRHSMap a
-> ListMap GRHSMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' ((GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  (SrcAnn NoEpAnns)
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc ([GenLocated
    (SrcAnn NoEpAnns)
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
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 = (GRHSSMap a -> LBMap (ListMap GRHSMap a))
-> (Substitution, GRHSSMap a)
-> [(Substitution, LBMap (ListMap GRHSMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor GRHSSMap a -> LBMap (ListMap GRHSMap a)
forall a. GRHSSMap a -> LBMap (ListMap GRHSMap a)
unGRHSSMap ((Substitution, GRHSSMap a)
 -> [(Substitution, LBMap (ListMap GRHSMap a))])
-> ((Substitution, LBMap (ListMap GRHSMap a))
    -> [(Substitution, a)])
-> (Substitution, GRHSSMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key LBMap
-> (Substitution, LBMap (ListMap GRHSMap a))
-> [(Substitution, ListMap GRHSMap a)]
forall a.
MatchEnv
-> Key LBMap -> (Substitution, LBMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsLocalBinds GhcPs
Key LBMap
lbs
                      ((Substitution, LBMap (ListMap GRHSMap a))
 -> [(Substitution, ListMap GRHSMap a)])
-> ((Substitution, ListMap GRHSMap a) -> [(Substitution, a)])
-> (Substitution, LBMap (ListMap GRHSMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap GRHSMap)
-> (Substitution, ListMap GRHSMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap GRHSMap)
-> (Substitution, ListMap GRHSMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ((GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  (SrcAnn NoEpAnns)
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc ([GenLocated
    (SrcAnn NoEpAnns)
    (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Key GRHSSMap
grhss)
    where
      lbs :: HsLocalBinds GhcPs
lbs = GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> HsLocalBinds GhcPs
forall p body. GRHSs p body -> HsLocalBinds p
grhssLocalBinds  GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Key GRHSSMap
grhss
      bs :: [IdP GhcPs]
bs = CollectFlag GhcPs -> HsLocalBinds GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsLocalBindsLR (GhcPass idL) (GhcPass idR)
-> [IdP (GhcPass idL)]
collectLocalBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders HsLocalBinds GhcPs
lbs
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
bs

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

newtype GRHSMap a = GRHSMap { forall a. GRHSMap a -> SLMap (EMap a)
unGRHSMap :: SLMap (EMap a) }
  deriving ((forall a b. (a -> b) -> GRHSMap a -> GRHSMap b)
-> (forall a b. a -> GRHSMap b -> GRHSMap a) -> Functor GRHSMap
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
$cfmap :: forall a b. (a -> b) -> GRHSMap a -> GRHSMap b
fmap :: forall a b. (a -> b) -> GRHSMap a -> GRHSMap b
$c<$ :: forall a b. a -> GRHSMap b -> GRHSMap a
<$ :: forall a b. a -> GRHSMap b -> GRHSMap a
Functor)

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

  mEmpty :: GRHSMap a
  mEmpty :: forall a. GRHSMap a
mEmpty = SLMap (EMap a) -> GRHSMap a
forall a. SLMap (EMap a) -> GRHSMap a
GRHSMap SLMap (EMap a)
forall a. SLMap a
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) = SLMap (EMap a) -> GRHSMap a
forall a. SLMap (EMap a) -> GRHSMap a
GRHSMap (SLMap (EMap a) -> SLMap (EMap a) -> SLMap (EMap a)
forall a. SLMap a -> SLMap a -> SLMap a
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 (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [ExprLStmt GhcPs]
gs GenLocated SrcSpanAnnA (HsExpr GhcPs)
b) A a
f (GRHSMap SLMap (EMap a)
m) =
    let bs :: [IdP GhcPs]
bs = CollectFlag GhcPs
-> [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders [ExprLStmt GhcPs]
[LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gs
        env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
[RdrName]
bs
        vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
[RdrName]
bs
    in SLMap (EMap a) -> GRHSMap a
forall a. SLMap (EMap a) -> GRHSMap a
GRHSMap (AlphaEnv
-> Quantifiers
-> Key SLMap
-> A (EMap a)
-> SLMap (EMap a)
-> SLMap (EMap a)
forall a.
AlphaEnv -> Quantifiers -> Key SLMap -> A a -> SLMap a -> SLMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [ExprLStmt GhcPs]
Key SLMap
gs ((EMap a -> EMap a) -> A (EMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv -> Quantifiers -> Key EMap -> A a -> EMap a -> EMap a
forall a.
AlphaEnv -> Quantifiers -> Key EMap -> A a -> EMap a -> EMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
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 (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ [ExprLStmt GhcPs]
gs GenLocated SrcSpanAnnA (HsExpr GhcPs)
b) =
    (GRHSMap a -> SLMap (EMap a))
-> (Substitution, GRHSMap a) -> [(Substitution, SLMap (EMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor GRHSMap a -> SLMap (EMap a)
forall a. GRHSMap a -> SLMap (EMap a)
unGRHSMap ((Substitution, GRHSMap a) -> [(Substitution, SLMap (EMap a))])
-> ((Substitution, SLMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, GRHSMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key SLMap
-> (Substitution, SLMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [ExprLStmt GhcPs]
Key SLMap
gs ((Substitution, SLMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, SLMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
b
    where
      bs :: [IdP GhcPs]
bs = CollectFlag GhcPs
-> [LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> [LStmtLR (GhcPass idL) (GhcPass idR) body]
-> [IdP (GhcPass idL)]
collectLStmtsBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders [ExprLStmt GhcPs]
[LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
gs
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
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 -> b) -> SLMap a -> SLMap b)
-> (forall a b. a -> SLMap b -> SLMap a) -> Functor SLMap
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
$cfmap :: forall a b. (a -> b) -> SLMap a -> SLMap b
fmap :: forall a b. (a -> b) -> SLMap a -> SLMap b
$c<$ :: forall a b. a -> SLMap b -> SLMap a
<$ :: forall a b. a -> SLMap b -> SLMap a
Functor)

emptySLMapWrapper :: SLMap a
emptySLMapWrapper :: forall a. SLMap a
emptySLMapWrapper = MaybeMap a -> SMap (SLMap a) -> SLMap a
forall a. MaybeMap a -> SMap (SLMap a) -> SLMap a
SLM MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty SMap (SLMap a)
forall a. SMap a
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 = SLMap a
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 = (SLMap a -> MaybeMap a) -> SLMap a -> SLMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SLMap a -> MaybeMap a
forall a. SLMap a -> MaybeMap a
slmNil SLMap a
m1 SLMap a
m2
    , slmCons :: SMap (SLMap a)
slmCons = (SLMap a -> SMap (SLMap a)) -> SLMap a -> SLMap a -> SMap (SLMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SLMap a -> SMap (SLMap a)
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 = AlphaEnv -> Quantifiers -> Key SLMap -> A a -> SLMap a -> SLMap a
forall a.
AlphaEnv -> Quantifiers -> Key SLMap -> A a -> SLMap a -> SLMap a
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 SLMap a
forall a. SLMap a
emptySLMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key SLMap
ss A a
f m :: SLMap a
m@SLM{} = [GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> SLMap a
go [GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
Key SLMap
ss
    where
      go :: [GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> SLMap a
go []      = SLMap a
m { slmNil = mAlter env vs () f (slmNil m) }
      go (GenLocated
  (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
s:[GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ss') =
        let
          bs :: [IdP GhcPs]
bs = CollectFlag GhcPs
-> LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated
  (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
s
          env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
[RdrName]
bs
          vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
[RdrName]
bs
        in SLMap a
m { slmCons = mAlter env vs s (toA (mAlter env' vs' ss' f)) (slmCons 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 (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> (Substitution, SLMap a) -> [(Substitution, a)]
go [GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
Key SLMap
ss (Substitution
hs,SLMap a
m)
    where
      go :: [GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> (Substitution, SLMap a) -> [(Substitution, a)]
go [] = (SLMap a -> MaybeMap a)
-> (Substitution, SLMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SLMap a -> MaybeMap a
forall a. SLMap a -> MaybeMap a
slmNil ((Substitution, SLMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, SLMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go (GenLocated
  (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
s:[GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
ss') =
        let
          bs :: [IdP GhcPs]
bs = CollectFlag GhcPs
-> LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders LStmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
GenLocated
  (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
s
          env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
bs
        in (SLMap a -> SMap (SLMap a))
-> (Substitution, SLMap a) -> [(Substitution, SMap (SLMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SLMap a -> SMap (SLMap a)
forall a. SLMap a -> SMap (SLMap a)
slmCons ((Substitution, SLMap a) -> [(Substitution, SMap (SLMap a))])
-> ((Substitution, SMap (SLMap a)) -> [(Substitution, a)])
-> (Substitution, SLMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key SMap
-> (Substitution, SMap (SLMap a))
-> [(Substitution, SLMap a)]
forall a.
MatchEnv
-> Key SMap -> (Substitution, SMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated
  (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
  (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
Key SMap
s ((Substitution, SMap (SLMap a)) -> [(Substitution, SLMap a)])
-> ((Substitution, SLMap a) -> [(Substitution, a)])
-> (Substitution, SMap (SLMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' [GenLocated
   (Anno (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
   (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
Key SLMap
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 -> b) -> LBMap a -> LBMap b)
-> (forall a b. a -> LBMap b -> LBMap a) -> Functor LBMap
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
$cfmap :: forall a b. (a -> b) -> LBMap a -> LBMap b
fmap :: forall a b. (a -> b) -> LBMap a -> LBMap b
$c<$ :: forall a b. a -> LBMap b -> LBMap a
<$ :: forall a b. a -> LBMap b -> LBMap a
Functor)

emptyLBMapWrapper :: LBMap a
emptyLBMapWrapper :: forall a. LBMap a
emptyLBMapWrapper = ListMap BMap a -> MaybeMap a -> LBMap a
forall a. ListMap BMap a -> MaybeMap a -> LBMap a
LB ListMap BMap a
forall a. ListMap BMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
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 = LBMap a
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 = (LBMap a -> ListMap BMap a) -> LBMap a -> LBMap a -> ListMap BMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LBMap a -> ListMap BMap a
forall a. LBMap a -> ListMap BMap a
lbValBinds LBMap a
m1 LBMap a
m2
    , lbEmpty :: MaybeMap a
lbEmpty = (LBMap a -> MaybeMap a) -> LBMap a -> LBMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn LBMap a -> MaybeMap a
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 = AlphaEnv -> Quantifiers -> Key LBMap -> A a -> LBMap a -> LBMap a
forall a.
AlphaEnv -> Quantifiers -> Key LBMap -> A a -> LBMap a -> LBMap a
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 LBMap a
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 HsLocalBinds GhcPs
Key LBMap
lbs
    where
      go :: HsLocalBinds GhcPs -> LBMap a
go (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = LBMap a
m { lbEmpty = mAlter env vs () f (lbEmpty m) }
#if __GLASGOW_HASKELL__ < 900
      go XHsLocalBindsLR{} = missingSyntax "XHsLocalBindsLR"
#endif
      go (HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
vbs) =
        let
          bs :: [IdP GhcPs]
bs = CollectFlag GhcPs -> HsValBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR -> [IdP (GhcPass idL)]
collectHsValBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders HsValBindsLR GhcPs GhcPs
vbs
          env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
[RdrName]
bs
          vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
[RdrName]
bs
        in LBMap a
m { lbValBinds = mAlter env' vs' (deValBinds vbs) f (lbValBinds m) }
      go HsIPBinds{} = String -> LBMap a
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 HsLocalBinds GhcPs
Key LBMap
lbs (Substitution
hs,LBMap a
m)
    where
      go :: HsLocalBinds GhcPs
-> (Substitution, LBMap a) -> [(Substitution, a)]
go (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = (LBMap a -> MaybeMap a)
-> (Substitution, LBMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LBMap a -> MaybeMap a
forall a. LBMap a -> MaybeMap a
lbEmpty ((Substitution, LBMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, LBMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
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 = CollectFlag GhcPs -> HsValBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) idR.
CollectPass (GhcPass idL) =>
CollectFlag (GhcPass idL)
-> HsValBindsLR (GhcPass idL) idR -> [IdP (GhcPass idL)]
collectHsValBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders HsValBindsLR GhcPs GhcPs
vbs
          env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
bs
        in (LBMap a -> ListMap BMap a)
-> (Substitution, LBMap a) -> [(Substitution, ListMap BMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor LBMap a -> ListMap BMap a
forall a. LBMap a -> ListMap BMap a
lbValBinds ((Substitution, LBMap a) -> [(Substitution, ListMap BMap a)])
-> ((Substitution, ListMap BMap a) -> [(Substitution, a)])
-> (Substitution, LBMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap BMap)
-> (Substitution, ListMap BMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap BMap)
-> (Substitution, ListMap BMap a)
-> [(Substitution, a)]
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
_ = [(Substitution, a)]
-> (Substitution, LBMap a) -> [(Substitution, a)]
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]
_) = (GenLocated SrcSpanAnnA (HsBind GhcPs) -> HsBind GhcPs)
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)] -> [HsBind GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsBind GhcPs) -> HsBind GhcPs
forall l e. GenLocated l e -> e
unLoc (Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs GhcPs
Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
lbs)
deValBinds HsValBindsLR GhcPs GhcPs
_ = String -> [HsBind 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 -> b) -> BMap a -> BMap b)
-> (forall a b. a -> BMap b -> BMap a) -> Functor BMap
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
$cfmap :: forall a b. (a -> b) -> BMap a -> BMap b
fmap :: forall a b. (a -> b) -> BMap a -> BMap b
$c<$ :: forall a b. a -> BMap b -> BMap a
<$ :: forall a b. a -> BMap b -> BMap a
Functor)

emptyBMapWrapper :: BMap a
emptyBMapWrapper :: forall a. BMap a
emptyBMapWrapper = MGMap a -> EMap a -> PatMap (GRHSSMap a) -> BMap a
forall a. MGMap a -> EMap a -> PatMap (GRHSSMap a) -> BMap a
BM MGMap a
forall a. MGMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap (GRHSSMap a)
forall a. PatMap a
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 = BMap a
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 = (BMap a -> MGMap a) -> BMap a -> BMap a -> MGMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn BMap a -> MGMap a
forall a. BMap a -> MGMap a
bmFunBind BMap a
m1 BMap a
m2
    , bmVarBind :: EMap a
bmVarBind = (BMap a -> EMap a) -> BMap a -> BMap a -> EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn BMap a -> EMap a
forall a. BMap a -> EMap a
bmVarBind BMap a
m1 BMap a
m2
    , bmPatBind :: PatMap (GRHSSMap a)
bmPatBind = (BMap a -> PatMap (GRHSSMap a))
-> BMap a -> BMap a -> PatMap (GRHSSMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn BMap a -> PatMap (GRHSSMap a)
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 = AlphaEnv -> Quantifiers -> Key BMap -> A a -> BMap a -> BMap a
forall a.
AlphaEnv -> Quantifiers -> Key BMap -> A a -> BMap a -> BMap a
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 BMap a
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 HsBind GhcPs
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{fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcPs (LHsExpr GhcPs)
mg}) = BMap a
m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
      go (VarBind XVarBind GhcPs GhcPs
_ IdP GhcPs
_ LHsExpr GhcPs
e) = BMap a
m { bmVarBind = mAlter env vs e f (bmVarBind m) }
#endif
      go (PatBind{pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs=LPat GhcPs
lhs, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs=GRHSs GhcPs (LHsExpr GhcPs)
rhs}) =
        BMap a
m { bmPatBind = mAlter env vs lhs
              (toA $ mAlter env vs rhs f) (bmPatBind m) }
#if __GLASGOW_HASKELL__ < 904
      go AbsBinds{} = missingSyntax "AbsBinds"
#endif
      go PatSynBind{} = String -> BMap a
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 HsBind GhcPs
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{fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcPs (LHsExpr GhcPs)
mg}) = (BMap a -> MGMap a)
-> (Substitution, BMap a) -> [(Substitution, MGMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor BMap a -> MGMap a
forall a. BMap a -> MGMap a
bmFunBind ((Substitution, BMap a) -> [(Substitution, MGMap a)])
-> ((Substitution, MGMap a) -> [(Substitution, a)])
-> (Substitution, BMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg
      go (VarBind XVarBind GhcPs GhcPs
_ IdP GhcPs
_ LHsExpr GhcPs
e) = (BMap a -> EMap a)
-> (Substitution, BMap a) -> [(Substitution, EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor BMap a -> EMap a
forall a. BMap a -> EMap a
bmVarBind ((Substitution, BMap a) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, BMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e
#endif
      go (PatBind{pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs=LPat GhcPs
lhs, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs=GRHSs GhcPs (LHsExpr GhcPs)
rhs})
        = (BMap a -> PatMap (GRHSSMap a))
-> (Substitution, BMap a) -> [(Substitution, PatMap (GRHSSMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor BMap a -> PatMap (GRHSSMap a)
forall a. BMap a -> PatMap (GRHSSMap a)
bmPatBind ((Substitution, BMap a) -> [(Substitution, PatMap (GRHSSMap a))])
-> ((Substitution, PatMap (GRHSSMap a)) -> [(Substitution, a)])
-> (Substitution, BMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key PatMap
-> (Substitution, PatMap (GRHSSMap a))
-> [(Substitution, GRHSSMap a)]
forall a.
MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LPat GhcPs
Key PatMap
lhs ((Substitution, PatMap (GRHSSMap a))
 -> [(Substitution, GRHSSMap a)])
-> ((Substitution, GRHSSMap a) -> [(Substitution, a)])
-> (Substitution, PatMap (GRHSSMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key GRHSSMap
-> (Substitution, GRHSSMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key GRHSSMap
-> (Substitution, GRHSSMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GRHSs GhcPs (LHsExpr GhcPs)
Key GRHSSMap
rhs
      go HsBind GhcPs
_ = [(Substitution, a)]
-> (Substitution, BMap a) -> [(Substitution, a)]
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 -> b) -> SMap a -> SMap b)
-> (forall a b. a -> SMap b -> SMap a) -> Functor SMap
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
$cfmap :: forall a b. (a -> b) -> SMap a -> SMap b
fmap :: forall a b. (a -> b) -> SMap a -> SMap b
$c<$ :: forall a b. a -> SMap b -> SMap a
<$ :: forall a b. a -> SMap b -> SMap a
Functor)

emptySMapWrapper :: SMap a
emptySMapWrapper :: forall a. SMap a
emptySMapWrapper = EMap a -> PatMap (EMap a) -> EMap a -> SMap a
forall a. EMap a -> PatMap (EMap a) -> EMap a -> SMap a
SM EMap a
forall a. EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap (EMap a)
forall a. PatMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall a. EMap a
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 = SMap a
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 = (SMap a -> EMap a) -> SMap a -> SMap a -> EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SMap a -> EMap a
forall a. SMap a -> EMap a
smLastStmt SMap a
m1 SMap a
m2
    , smBindStmt :: PatMap (EMap a)
smBindStmt = (SMap a -> PatMap (EMap a)) -> SMap a -> SMap a -> PatMap (EMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SMap a -> PatMap (EMap a)
forall a. SMap a -> PatMap (EMap a)
smBindStmt SMap a
m1 SMap a
m2
    , smBodyStmt :: EMap a
smBodyStmt = (SMap a -> EMap a) -> SMap a -> SMap a -> EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn SMap a -> EMap a
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 = AlphaEnv -> Quantifiers -> Key SMap -> A a -> SMap a -> SMap a
forall a.
AlphaEnv -> Quantifiers -> Key SMap -> A a -> SMap a -> SMap a
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 SMap a
forall a. SMap a
emptySMapWrapper
  mAlter AlphaEnv
env Quantifiers
vs Key SMap
s A a
f m :: SMap a
m@(SM {}) = Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> SMap a
go (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
Key SMap
s)
    where
      go :: Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)) -> SMap a
go (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = SMap a
m { smBodyStmt = mAlter env vs e f (smBodyStmt m) }
      go (LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e Maybe Bool
_ SyntaxExpr GhcPs
_)   = SMap a
m { smLastStmt = mAlter env vs e f (smLastStmt m) }
#if __GLASGOW_HASKELL__ < 900
      go XStmtLR{} = missingSyntax "XStmtLR"
      go (BindStmt _ p e _ _) =
#else
      go (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ LPat GhcPs
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) =
#endif
        let bs :: [IdP GhcPs]
bs = CollectFlag GhcPs -> LPat GhcPs -> [IdP GhcPs]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders LPat GhcPs
p
            env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RdrName -> AlphaEnv -> AlphaEnv
extendAlphaEnvInternal AlphaEnv
env [IdP GhcPs]
[RdrName]
bs
            vs' :: Quantifiers
vs' = Quantifiers
vs Quantifiers -> [RdrName] -> Quantifiers
`exceptQ` [IdP GhcPs]
[RdrName]
bs
        in SMap a
m { smBindStmt = mAlter env vs p
                              (toA (mAlter env' vs' e f)) (smBindStmt m) }
      go LetStmt{} = String -> SMap a
forall a. String -> a
missingSyntax String
"LetStmt"
      go ParStmt{} = String -> SMap a
forall a. String -> a
missingSyntax String
"ParStmt"
      go TransStmt{} = String -> SMap a
forall a. String -> a
missingSyntax String
"TransStmt"
      go RecStmt{} = String -> SMap a
forall a. String -> a
missingSyntax String
"RecStmt"
      go ApplicativeStmt{} = String -> SMap a
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) = Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (Substitution, SMap a) -> [(Substitution, a)]
go (LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc LocatedA (Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
Key SMap
s) (Substitution
hs,SMap a
m)
    where
      go :: Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (Substitution, SMap a) -> [(Substitution, a)]
go (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = (SMap a -> EMap a)
-> (Substitution, SMap a) -> [(Substitution, EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SMap a -> EMap a
forall a. SMap a -> EMap a
smBodyStmt ((Substitution, SMap a) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, SMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
e
      go (LastStmt XLastStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ GenLocated SrcSpanAnnA (HsExpr GhcPs)
e Maybe Bool
_ SyntaxExpr GhcPs
_) = (SMap a -> EMap a)
-> (Substitution, SMap a) -> [(Substitution, EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SMap a -> EMap a
forall a. SMap a -> EMap a
smLastStmt ((Substitution, SMap a) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, SMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
e
#if __GLASGOW_HASKELL__ < 900
      go (BindStmt _ p e _ _) =
#else
      go (BindStmt XBindStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ LPat GhcPs
p GenLocated SrcSpanAnnA (HsExpr GhcPs)
e) =
#endif
        let bs :: [IdP GhcPs]
bs = CollectFlag GhcPs -> LPat GhcPs -> [IdP GhcPs]
forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
collectPatBinders CollectFlag GhcPs
forall p. CollectFlag p
CollNoDictBinders LPat GhcPs
p
            env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
bs
        in (SMap a -> PatMap (EMap a))
-> (Substitution, SMap a) -> [(Substitution, PatMap (EMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor SMap a -> PatMap (EMap a)
forall a. SMap a -> PatMap (EMap a)
smBindStmt ((Substitution, SMap a) -> [(Substitution, PatMap (EMap a))])
-> ((Substitution, PatMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, SMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key PatMap
-> (Substitution, PatMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LPat GhcPs
Key PatMap
p ((Substitution, PatMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, PatMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
e
      go Stmt GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
_ = [(Substitution, a)]
-> (Substitution, SMap a) -> [(Substitution, a)]
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 -> b) -> TyMap a -> TyMap b)
-> (forall a b. a -> TyMap b -> TyMap a) -> Functor TyMap
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
$cfmap :: forall a b. (a -> b) -> TyMap a -> TyMap b
fmap :: forall a b. (a -> b) -> TyMap a -> TyMap b
$c<$ :: forall a b. a -> TyMap b -> TyMap a
<$ :: forall a b. a -> TyMap b -> TyMap a
Functor)

emptyTyMapWrapper :: TyMap a
emptyTyMapWrapper :: forall a. TyMap a
emptyTyMapWrapper = 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
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
  Map RdrName a
forall a. Map RdrName a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty VMap a
forall a. VMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (TyMap a)
forall a. TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
  ForallVisMap (ForAllTyMap a)
forall a. ForallVisMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (TyMap a)
forall a. TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap a
forall a. TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap a
forall a. TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (ListMap TyMap a)
forall a. TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty ListMap TyMap a
forall a. ListMap TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TupleSortMap (ListMap TyMap a)
forall a. TupleSortMap a
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 = TyMap a
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 = (TyMap a -> Map RdrName a) -> TyMap a -> TyMap a -> Map RdrName a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> Map RdrName a
forall a. TyMap a -> Map RdrName a
tyHole TyMap a
m1 TyMap a
m2
    , tyHsTyVar :: VMap a
tyHsTyVar = (TyMap a -> VMap a) -> TyMap a -> TyMap a -> VMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> VMap a
forall a. TyMap a -> VMap a
tyHsTyVar TyMap a
m1 TyMap a
m2
    , tyHsAppTy :: TyMap (TyMap a)
tyHsAppTy = (TyMap a -> TyMap (TyMap a))
-> TyMap a -> TyMap a -> TyMap (TyMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> TyMap (TyMap a)
forall a. TyMap a -> TyMap (TyMap a)
tyHsAppTy TyMap a
m1 TyMap a
m2
    , tyHsForAllTy :: ForallVisMap (ForAllTyMap a)
tyHsForAllTy = (TyMap a -> ForallVisMap (ForAllTyMap a))
-> TyMap a -> TyMap a -> ForallVisMap (ForAllTyMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> ForallVisMap (ForAllTyMap a)
forall a. TyMap a -> ForallVisMap (ForAllTyMap a)
tyHsForAllTy TyMap a
m1 TyMap a
m2
    , tyHsFunTy :: TyMap (TyMap a)
tyHsFunTy = (TyMap a -> TyMap (TyMap a))
-> TyMap a -> TyMap a -> TyMap (TyMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> TyMap (TyMap a)
forall a. TyMap a -> TyMap (TyMap a)
tyHsFunTy TyMap a
m1 TyMap a
m2
    , tyHsListTy :: TyMap a
tyHsListTy = (TyMap a -> TyMap a) -> TyMap a -> TyMap a -> TyMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> TyMap a
forall a. TyMap a -> TyMap a
tyHsListTy TyMap a
m1 TyMap a
m2
    , tyHsParTy :: TyMap a
tyHsParTy = (TyMap a -> TyMap a) -> TyMap a -> TyMap a -> TyMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> TyMap a
forall a. TyMap a -> TyMap a
tyHsParTy TyMap a
m1 TyMap a
m2
    , tyHsQualTy :: TyMap (ListMap TyMap a)
tyHsQualTy = (TyMap a -> TyMap (ListMap TyMap a))
-> TyMap a -> TyMap a -> TyMap (ListMap TyMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> TyMap (ListMap TyMap a)
forall a. TyMap a -> TyMap (ListMap TyMap a)
tyHsQualTy TyMap a
m1 TyMap a
m2
    , tyHsSumTy :: ListMap TyMap a
tyHsSumTy = (TyMap a -> ListMap TyMap a)
-> TyMap a -> TyMap a -> ListMap TyMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> ListMap TyMap a
forall a. TyMap a -> ListMap TyMap a
tyHsSumTy TyMap a
m1 TyMap a
m2
    , tyHsTupleTy :: TupleSortMap (ListMap TyMap a)
tyHsTupleTy = (TyMap a -> TupleSortMap (ListMap TyMap a))
-> TyMap a -> TyMap a -> TupleSortMap (ListMap TyMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TyMap a -> TupleSortMap (ListMap TyMap a)
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 = AlphaEnv -> Quantifiers -> Key TyMap -> A a -> TyMap a -> TyMap a
forall a.
AlphaEnv -> Quantifiers -> Key TyMap -> A a -> TyMap a -> TyMap a
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 TyMap a
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 (LocatedA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (HsType GhcPs)
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    = mAlter env vs v f (tyHole m) }
        | Bool
otherwise  = TyMap a
m { tyHsTyVar = mAlter env vs v f (tyHsTyVar m) }
      go HsOpTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsOpTy"
      go HsIParamTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsIParamTy"
      go HsKindSig{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsKindSig"
      go HsSpliceTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsSpliceTy"
      go HsDocTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsDocTy"
      go HsBangTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsBangTy"
      go HsRecTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsRecTy"
      go (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2) = TyMap a
m { tyHsAppTy = mAlter env vs ty1 (toA (mAlter env vs ty2 f)) (tyHsAppTy 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 = mAlter env vs isVisible (toA (mAlter env vs (bndrs, ty') f)) (tyHsForAllTy 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 = mAlter env vs ty1 (toA (mAlter env vs ty2 f)) (tyHsFunTy m) }
#endif
      go (HsListTy XListTy GhcPs
_ LHsType GhcPs
ty') = TyMap a
m { tyHsListTy = mAlter env vs ty' f (tyHsListTy m) }
      go (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty') = TyMap a
m { tyHsParTy = mAlter env vs ty' f (tyHsParTy m) }
      go (HsQualTy XQualTy GhcPs
_ LHsContext GhcPs
cons LHsType GhcPs
ty') =
#if __GLASGOW_HASKELL__ < 904
        m { tyHsQualTy = mAlter env vs ty' (toA (mAlter env vs (fromMaybeContext cons) f)) (tyHsQualTy m) }
#else
        TyMap a
m { tyHsQualTy = mAlter env vs ty' (toA (mAlter env vs (fromMaybeContext (Just cons)) f)) (tyHsQualTy m) }
#endif
      go HsStarTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsStarTy"
      go (HsSumTy XSumTy GhcPs
_ HsContext GhcPs
tys) = TyMap a
m { tyHsSumTy = mAlter env vs tys f (tyHsSumTy m) }
      go (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
ts HsContext GhcPs
tys) =
        TyMap a
m { tyHsTupleTy = mAlter env vs ts (toA (mAlter env vs tys f)) (tyHsTupleTy m) }
      go XHsType{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"XHsType"
      go HsExplicitListTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsExplicitListTy"
      go HsExplicitTupleTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsExplicitTupleTy"
      go HsTyLit{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsTyLit"
      go HsWildCardTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsWildCardTy"
      go HsAppKindTy{} = String -> TyMap a
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 [(Substitution, a)] -> [(Substitution, a)] -> [(Substitution, a)]
forall a. [a] -> [a] -> [a]
++ HsType GhcPs -> (Substitution, TyMap a) -> [(Substitution, a)]
go (LocatedA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
unLoc LocatedA (HsType GhcPs)
Key TyMap
ty) (Substitution
hs,TyMap a
m) -- See Note [TyVar Quantifiers]
    where
      hss :: [(Substitution, a)]
hss = Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
forall a.
Map RdrName a -> HoleVal -> Substitution -> [(Substitution, a)]
extendResult (TyMap a -> Map RdrName a
forall a. TyMap a -> Map RdrName a
tyHole TyMap a
m) (AnnotatedHsType -> HoleVal
HoleType (AnnotatedHsType -> HoleVal) -> AnnotatedHsType -> HoleVal
forall a b. (a -> b) -> a -> b
$ MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env LocatedA (HsType GhcPs)
Key TyMap
ty) Substitution
hs

      go :: HsType GhcPs -> (Substitution, TyMap a) -> [(Substitution, a)]
go (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2) = (TyMap a -> TyMap (TyMap a))
-> (Substitution, TyMap a) -> [(Substitution, TyMap (TyMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> TyMap (TyMap a)
forall a. TyMap a -> TyMap (TyMap a)
tyHsAppTy ((Substitution, TyMap a) -> [(Substitution, TyMap (TyMap a))])
-> ((Substitution, TyMap (TyMap a)) -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap
-> (Substitution, TyMap (TyMap a))
-> [(Substitution, TyMap a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty1 ((Substitution, TyMap (TyMap a)) -> [(Substitution, TyMap a)])
-> ((Substitution, TyMap a) -> [(Substitution, a)])
-> (Substitution, TyMap (TyMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
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 =
        (TyMap a -> ForallVisMap (ForAllTyMap a))
-> (Substitution, TyMap a)
-> [(Substitution, ForallVisMap (ForAllTyMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> ForallVisMap (ForAllTyMap a)
forall a. TyMap a -> ForallVisMap (ForAllTyMap a)
tyHsForAllTy ((Substitution, TyMap a)
 -> [(Substitution, ForallVisMap (ForAllTyMap a))])
-> ((Substitution, ForallVisMap (ForAllTyMap a))
    -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key ForallVisMap
-> (Substitution, ForallVisMap (ForAllTyMap a))
-> [(Substitution, ForAllTyMap a)]
forall a.
MatchEnv
-> Key ForallVisMap
-> (Substitution, ForallVisMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Bool
Key ForallVisMap
isVisible ((Substitution, ForallVisMap (ForAllTyMap a))
 -> [(Substitution, ForAllTyMap a)])
-> ((Substitution, ForAllTyMap a) -> [(Substitution, a)])
-> (Substitution, ForallVisMap (ForAllTyMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ([(RdrName, Maybe (LHsType GhcPs))]
[(RdrName, Maybe (LocatedA (HsType GhcPs)))]
bndrs, LHsType GhcPs
LocatedA (HsType 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) = (TyMap a -> TyMap (TyMap a))
-> (Substitution, TyMap a) -> [(Substitution, TyMap (TyMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> TyMap (TyMap a)
forall a. TyMap a -> TyMap (TyMap a)
tyHsFunTy ((Substitution, TyMap a) -> [(Substitution, TyMap (TyMap a))])
-> ((Substitution, TyMap (TyMap a)) -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap
-> (Substitution, TyMap (TyMap a))
-> [(Substitution, TyMap a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty1 ((Substitution, TyMap (TyMap a)) -> [(Substitution, TyMap a)])
-> ((Substitution, TyMap a) -> [(Substitution, a)])
-> (Substitution, TyMap (TyMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty2
#endif
      go (HsListTy XListTy GhcPs
_ LHsType GhcPs
ty') = (TyMap a -> TyMap a)
-> (Substitution, TyMap a) -> [(Substitution, TyMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> TyMap a
forall a. TyMap a -> TyMap a
tyHsListTy ((Substitution, TyMap a) -> [(Substitution, TyMap a)])
-> ((Substitution, TyMap a) -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty'
      go (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty') = (TyMap a -> TyMap a)
-> (Substitution, TyMap a) -> [(Substitution, TyMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> TyMap a
forall a. TyMap a -> TyMap a
tyHsParTy ((Substitution, TyMap a) -> [(Substitution, TyMap a)])
-> ((Substitution, TyMap a) -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty'
#if __GLASGOW_HASKELL__ < 904
      go (HsQualTy _ cons ty') = mapFor tyHsQualTy >=> mMatch env ty' >=> mMatch env (fromMaybeContext cons)
#else
      go (HsQualTy XQualTy GhcPs
_ LHsContext GhcPs
cons LHsType GhcPs
ty') = (TyMap a -> TyMap (ListMap TyMap a))
-> (Substitution, TyMap a)
-> [(Substitution, TyMap (ListMap TyMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> TyMap (ListMap TyMap a)
forall a. TyMap a -> TyMap (ListMap TyMap a)
tyHsQualTy ((Substitution, TyMap a)
 -> [(Substitution, TyMap (ListMap TyMap a))])
-> ((Substitution, TyMap (ListMap TyMap a)) -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap
-> (Substitution, TyMap (ListMap TyMap a))
-> [(Substitution, ListMap TyMap a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty' ((Substitution, TyMap (ListMap TyMap a))
 -> [(Substitution, ListMap TyMap a)])
-> ((Substitution, ListMap TyMap a) -> [(Substitution, a)])
-> (Substitution, TyMap (ListMap TyMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap TyMap)
-> (Substitution, ListMap TyMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap TyMap)
-> (Substitution, ListMap TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Maybe (LHsContext GhcPs) -> HsContext GhcPs
forall (p :: Pass).
Maybe (LHsContext (GhcPass p)) -> HsContext (GhcPass p)
fromMaybeContext (GenLocated SrcSpanAnnC [LocatedA (HsType GhcPs)]
-> Maybe (GenLocated SrcSpanAnnC [LocatedA (HsType GhcPs)])
forall a. a -> Maybe a
Just LHsContext GhcPs
GenLocated SrcSpanAnnC [LocatedA (HsType GhcPs)]
cons))
#endif
      go (HsSumTy XSumTy GhcPs
_ HsContext GhcPs
tys) = (TyMap a -> ListMap TyMap a)
-> (Substitution, TyMap a) -> [(Substitution, ListMap TyMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> ListMap TyMap a
forall a. TyMap a -> ListMap TyMap a
tyHsSumTy ((Substitution, TyMap a) -> [(Substitution, ListMap TyMap a)])
-> ((Substitution, ListMap TyMap a) -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap TyMap)
-> (Substitution, ListMap TyMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap TyMap)
-> (Substitution, ListMap TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsContext GhcPs
Key (ListMap TyMap)
tys
      go (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
ts HsContext GhcPs
tys) = (TyMap a -> TupleSortMap (ListMap TyMap a))
-> (Substitution, TyMap a)
-> [(Substitution, TupleSortMap (ListMap TyMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> TupleSortMap (ListMap TyMap a)
forall a. TyMap a -> TupleSortMap (ListMap TyMap a)
tyHsTupleTy ((Substitution, TyMap a)
 -> [(Substitution, TupleSortMap (ListMap TyMap a))])
-> ((Substitution, TupleSortMap (ListMap TyMap a))
    -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TupleSortMap
-> (Substitution, TupleSortMap (ListMap TyMap a))
-> [(Substitution, ListMap TyMap a)]
forall a.
MatchEnv
-> Key TupleSortMap
-> (Substitution, TupleSortMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsTupleSort
Key TupleSortMap
ts ((Substitution, TupleSortMap (ListMap TyMap a))
 -> [(Substitution, ListMap TyMap a)])
-> ((Substitution, ListMap TyMap a) -> [(Substitution, a)])
-> (Substitution, TupleSortMap (ListMap TyMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key (ListMap TyMap)
-> (Substitution, ListMap TyMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key (ListMap TyMap)
-> (Substitution, ListMap TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsContext GhcPs
Key (ListMap TyMap)
tys
      go (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ LIdP GhcPs
v) = (TyMap a -> VMap a)
-> (Substitution, TyMap a) -> [(Substitution, VMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TyMap a -> VMap a
forall a. TyMap a -> VMap a
tyHsTyVar ((Substitution, TyMap a) -> [(Substitution, VMap a)])
-> ((Substitution, VMap a) -> [(Substitution, a)])
-> (Substitution, TyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
v)
      go HsType GhcPs
_                  = [(Substitution, a)]
-> (Substitution, TyMap a) -> [(Substitution, a)]
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_xvis :: XHsForAllVis GhcPs
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_xvis :: forall pass. HsForAllTelescope pass -> XHsForAllVis pass
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
..} = (Bool
True, (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
 -> (RdrName, Maybe (LocatedA (HsType GhcPs))))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
-> [(RdrName, Maybe (LocatedA (HsType GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr () GhcPs -> (RdrName, Maybe (LHsType GhcPs))
GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> (RdrName, Maybe (LocatedA (HsType GhcPs)))
forall flag.
LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
hsf_vis_bndrs)
splitVisBinders HsForAllInvis{[LHsTyVarBndr Specificity GhcPs]
XHsForAllInvis GhcPs
hsf_xinvis :: XHsForAllInvis GhcPs
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
..} = (Bool
False, (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> (RdrName, Maybe (LocatedA (HsType GhcPs))))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [(RdrName, Maybe (LocatedA (HsType GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr Specificity GhcPs -> (RdrName, Maybe (LHsType GhcPs))
GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> (RdrName, Maybe (LocatedA (HsType GhcPs)))
forall flag.
LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
hsf_invis_bndrs)

extractBinderInfo :: LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsKind GhcPs))
extractBinderInfo :: forall flag.
LHsTyVarBndr flag GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo = HsTyVarBndr flag GhcPs -> (IdP GhcPs, Maybe (LHsType GhcPs))
HsTyVarBndr flag GhcPs
-> (RdrName, Maybe (LocatedA (HsType GhcPs)))
forall {pass} {l} {flag}.
(XRec pass (IdP pass) ~ GenLocated l (IdP pass)) =>
HsTyVarBndr flag pass
-> (IdP pass, Maybe (XRec pass (HsKind pass)))
go (HsTyVarBndr flag GhcPs
 -> (RdrName, Maybe (LocatedA (HsType GhcPs))))
-> (GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
    -> HsTyVarBndr flag GhcPs)
-> GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> (RdrName, Maybe (LocatedA (HsType GhcPs)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr flag GhcPs)
-> HsTyVarBndr flag GhcPs
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) = (GenLocated l (IdP pass) -> IdP pass
forall l e. GenLocated l e -> e
unLoc XRec pass (IdP pass)
GenLocated l (IdP pass)
v, Maybe (XRec pass (HsKind pass))
forall a. Maybe a
Nothing)
    go (KindedTyVar XKindedTyVar pass
_ flag
_ XRec pass (IdP pass)
v XRec pass (HsKind pass)
k) = (GenLocated l (IdP pass) -> IdP pass
forall l e. GenLocated l e -> e
unLoc XRec pass (IdP pass)
GenLocated l (IdP pass)
v, XRec pass (HsKind pass) -> Maybe (XRec pass (HsKind pass))
forall a. a -> Maybe a
Just XRec pass (HsKind pass)
k)
    go XTyVarBndr{} = String -> (IdP pass, Maybe (XRec pass (HsKind pass)))
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 -> b) -> RFMap a -> RFMap b)
-> (forall a b. a -> RFMap b -> RFMap a) -> Functor RFMap
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
$cfmap :: forall a b. (a -> b) -> RFMap a -> RFMap b
fmap :: forall a b. (a -> b) -> RFMap a -> RFMap b
$c<$ :: forall a b. a -> RFMap b -> RFMap a
<$ :: forall a b. a -> RFMap b -> RFMap a
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 = VMap (EMap a) -> RFMap a
forall a. VMap (EMap a) -> RFMap a
RFM VMap (EMap a)
forall a. VMap a
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) = VMap (EMap a) -> RFMap a
forall a. VMap (EMap a) -> RFMap a
RFM (VMap (EMap a) -> VMap (EMap a) -> VMap (EMap a)
forall a. VMap a -> VMap a -> VMap a
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 = HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RFMap a
go (GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
Key RFMap
lf)
    where
#if __GLASGOW_HASKELL__ < 904
      go (HsRecField _ lbl arg _pun) =
        m { rfmField = mAlter env vs (unLoc lbl) (toA (mAlter env vs arg f)) (rfmField m) }
#else
      go :: HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> RFMap a
go (HsFieldBind XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
lbl GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
_pun) =
        RFMap a
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) = HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (Substitution, RFMap a) -> [(Substitution, a)]
go (GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall l e. GenLocated l e -> e
unLoc GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
Key RFMap
lf) (Substitution
hs,RFMap a
m)
    where
#if __GLASGOW_HASKELL__ < 904
      go (HsRecField _ lbl arg _pun) =
        mapFor rfmField >=> mMatch env (unLoc lbl) >=> mMatch env arg
#else
      go :: HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
  (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> (Substitution, RFMap a) -> [(Substitution, a)]
go (HsFieldBind XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
_ GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
lbl GenLocated SrcSpanAnnA (HsExpr GhcPs)
arg Bool
_pun) =
        (RFMap a -> VMap (EMap a))
-> (Substitution, RFMap a) -> [(Substitution, VMap (EMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor RFMap a -> VMap (EMap a)
forall a. RFMap a -> VMap (EMap a)
rfmField ((Substitution, RFMap a) -> [(Substitution, VMap (EMap a))])
-> ((Substitution, VMap (EMap a)) -> [(Substitution, a)])
-> (Substitution, RFMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key VMap
-> (Substitution, VMap (EMap a))
-> [(Substitution, EMap a)]
forall a.
MatchEnv
-> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (FieldOcc GhcPs -> XRec GhcPs RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> FieldOcc GhcPs
forall l e. GenLocated l e -> e
unLoc GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)
lbl))) ((Substitution, VMap (EMap a)) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, VMap (EMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env GenLocated SrcSpanAnnA (HsExpr GhcPs)
Key EMap
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
#if __GLASGOW_HASKELL__ < 908
  recordFieldToRdrName :: AmbiguousFieldOcc GhcPs -> RdrName
recordFieldToRdrName = AmbiguousFieldOcc GhcPs -> RdrName
forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
rdrNameAmbiguousFieldOcc
#else
  recordFieldToRdrName = ambiguousFieldOccRdrName
#endif

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

instance RecordFieldToRdrName (FieldLabelStrings GhcPs) where
  recordFieldToRdrName :: FieldLabelStrings GhcPs -> RdrName
recordFieldToRdrName = String -> FieldLabelStrings GhcPs -> RdrName
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 (Left fs) = map go fs
  where
    go (L l (HsRecField a (L l2 f) arg pun)) =
      L l (HsRecField a (L l2 (recordFieldToRdrName f)) arg pun)
fieldsToRdrNamesUpd (Right fs) = map go fs
  where
    go (L l (HsRecField a (L l2 f) arg pun)) =
      L l (HsRecField a (L l2 (recordFieldToRdrName f)) arg pun)
#elif __GLASGOW_HASKELL__ < 908
fieldsToRdrNamesUpd :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
  -> [LHsRecField GhcPs (LHsExpr GhcPs)]
fieldsToRdrNamesUpd :: Either [LHsRecUpdField GhcPs] [LHsRecUpdProj GhcPs]
-> [LHsRecField GhcPs (LHsExpr GhcPs)]
fieldsToRdrNamesUpd (Left [LHsRecUpdField GhcPs]
xs) = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {pass} {pass} {l} {l} {rhs}.
(XCFieldOcc pass ~ NoExtField,
 XRec pass RdrName ~ XRec pass RdrName) =>
GenLocated
  l (HsFieldBind (GenLocated l (AmbiguousFieldOcc pass)) rhs)
-> GenLocated l (HsFieldBind (GenLocated l (FieldOcc pass)) rhs)
go [LHsRecUpdField GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (AmbiguousFieldOcc GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
  where
    go :: GenLocated
  l (HsFieldBind (GenLocated l (AmbiguousFieldOcc pass)) rhs)
-> GenLocated l (HsFieldBind (GenLocated l (FieldOcc pass)) rhs)
go (L l
l (HsFieldBind XHsFieldBind (GenLocated l (AmbiguousFieldOcc pass))
a (L l
l2 AmbiguousFieldOcc pass
f) rhs
arg Bool
pun)) =
      let lrdrName :: XRec pass RdrName
lrdrName = case AmbiguousFieldOcc pass
f of
            Unambiguous XUnambiguous pass
_ XRec pass RdrName
n -> XRec pass RdrName
n
            Ambiguous XAmbiguous pass
_ XRec pass RdrName
n -> XRec pass RdrName
n
            XAmbiguousFieldOcc{} -> String -> XRec pass RdrName
forall a. HasCallStack => String -> a
error String
"XAmbiguousFieldOcc"
          f' :: FieldOcc pass
f' = XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc pass
NoExtField
NoExtField XRec pass RdrName
XRec pass RdrName
lrdrName
       in l
-> HsFieldBind (GenLocated l (FieldOcc pass)) rhs
-> GenLocated l (HsFieldBind (GenLocated l (FieldOcc pass)) rhs)
forall l e. l -> e -> GenLocated l e
L l
l (XHsFieldBind (GenLocated l (FieldOcc pass))
-> GenLocated l (FieldOcc pass)
-> rhs
-> Bool
-> HsFieldBind (GenLocated l (FieldOcc pass)) rhs
forall lhs rhs.
XHsFieldBind lhs -> lhs -> rhs -> Bool -> HsFieldBind lhs rhs
HsFieldBind XHsFieldBind (GenLocated l (AmbiguousFieldOcc pass))
XHsFieldBind (GenLocated l (FieldOcc pass))
a (l -> FieldOcc pass -> GenLocated l (FieldOcc pass)
forall l e. l -> e -> GenLocated l e
L l
l2 FieldOcc pass
f') rhs
arg Bool
pun)
fieldsToRdrNamesUpd (Right [LHsRecUpdProj GhcPs]
xs) = (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
         (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
     (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs))
        (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall {pass} {l} {l} {e} {rhs}.
(XCFieldOcc pass ~ NoExtField) =>
GenLocated l (HsFieldBind (GenLocated l e) rhs)
-> GenLocated l (HsFieldBind (GenLocated l (FieldOcc pass)) rhs)
go [LHsRecUpdProj GhcPs]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldLabelStrings GhcPs))
      (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
xs
  where
    go :: GenLocated l (HsFieldBind (GenLocated l e) rhs)
-> GenLocated l (HsFieldBind (GenLocated l (FieldOcc pass)) rhs)
go (L l
l (HsFieldBind XHsFieldBind (GenLocated l e)
a (L l
l2 e
_f) rhs
arg Bool
pun)) =
      let lrdrName :: a
lrdrName = String -> a
forall a. HasCallStack => String -> a
error String
"TBD" -- same as GHC 9.2
          f' :: FieldOcc pass
f' = XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
forall pass. XCFieldOcc pass -> XRec pass RdrName -> FieldOcc pass
FieldOcc XCFieldOcc pass
NoExtField
NoExtField XRec pass RdrName
forall {a}. a
lrdrName
       in l
-> HsFieldBind (GenLocated l (FieldOcc pass)) rhs
-> GenLocated l (HsFieldBind (GenLocated l (FieldOcc pass)) rhs)
forall l e. l -> e -> GenLocated l e
L l
l (XHsFieldBind (GenLocated l (FieldOcc pass))
-> GenLocated l (FieldOcc pass)
-> rhs
-> Bool
-> HsFieldBind (GenLocated l (FieldOcc pass)) rhs
forall lhs rhs.
XHsFieldBind lhs -> lhs -> rhs -> Bool -> HsFieldBind lhs rhs
HsFieldBind XHsFieldBind (GenLocated l e)
XHsFieldBind (GenLocated l (FieldOcc pass))
a (l -> FieldOcc pass -> GenLocated l (FieldOcc pass)
forall l e. l -> e -> GenLocated l e
L l
l2 FieldOcc pass
f') rhs
arg Bool
pun)
#else
fieldsToRdrNamesUpd :: LHsRecUpdFields GhcPs
  -> [LHsRecField GhcPs (LHsExpr GhcPs)]
fieldsToRdrNamesUpd (RegularRecUpdFields _ 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 (OverloadedRecUpdFields _ 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 = map go
  where
    go (L l (HsRecField a (L l2 f) arg pun)) =
      L l (HsRecField a (L l2 (recordFieldToRdrName f)) arg 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 -> b) -> TupleSortMap a -> TupleSortMap b)
-> (forall a b. a -> TupleSortMap b -> TupleSortMap a)
-> Functor TupleSortMap
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
$cfmap :: forall a b. (a -> b) -> TupleSortMap a -> TupleSortMap b
fmap :: forall a b. (a -> b) -> TupleSortMap a -> TupleSortMap b
$c<$ :: forall a b. a -> TupleSortMap b -> TupleSortMap a
<$ :: forall a b. a -> TupleSortMap b -> TupleSortMap a
Functor)

instance PatternMap TupleSortMap where
  type Key TupleSortMap = HsTupleSort

  mEmpty :: TupleSortMap a
  mEmpty :: forall a. TupleSortMap a
mEmpty = MaybeMap a
-> MaybeMap a -> MaybeMap a -> MaybeMap a -> TupleSortMap a
forall a.
MaybeMap a
-> MaybeMap a -> MaybeMap a -> MaybeMap a -> TupleSortMap a
TupleSortMap MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall a. MaybeMap a
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 = (TupleSortMap a -> MaybeMap a)
-> TupleSortMap a -> TupleSortMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsUnboxed TupleSortMap a
m1 TupleSortMap a
m2
    , tsBoxed :: MaybeMap a
tsBoxed = (TupleSortMap a -> MaybeMap a)
-> TupleSortMap a -> TupleSortMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsBoxed TupleSortMap a
m1 TupleSortMap a
m2
    , tsConstraint :: MaybeMap a
tsConstraint = (TupleSortMap a -> MaybeMap a)
-> TupleSortMap a -> TupleSortMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsConstraint TupleSortMap a
m1 TupleSortMap a
m2
    , tsBoxedOrConstraint :: MaybeMap a
tsBoxedOrConstraint = (TupleSortMap a -> MaybeMap a)
-> TupleSortMap a -> TupleSortMap a -> MaybeMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn TupleSortMap a -> MaybeMap a
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 = mAlter env vs () f (tsUnboxed 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 = mAlter env vs () f (tsBoxedOrConstraint 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 = (TupleSortMap a -> MaybeMap a)
-> (Substitution, TupleSortMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsUnboxed ((Substitution, TupleSortMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, TupleSortMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
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 = (TupleSortMap a -> MaybeMap a)
-> (Substitution, TupleSortMap a) -> [(Substitution, MaybeMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsBoxedOrConstraint ((Substitution, TupleSortMap a) -> [(Substitution, MaybeMap a)])
-> ((Substitution, MaybeMap a) -> [(Substitution, a)])
-> (Substitution, TupleSortMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key MaybeMap
-> (Substitution, MaybeMap a)
-> [(Substitution, a)]
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 -> b) -> ForAllTyMap a -> ForAllTyMap b)
-> (forall a b. a -> ForAllTyMap b -> ForAllTyMap a)
-> Functor ForAllTyMap
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
$cfmap :: forall a b. (a -> b) -> ForAllTyMap a -> ForAllTyMap b
fmap :: forall a b. (a -> b) -> ForAllTyMap a -> ForAllTyMap b
$c<$ :: forall a b. a -> ForAllTyMap b -> ForAllTyMap a
<$ :: forall a b. a -> ForAllTyMap b -> ForAllTyMap a
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 = TyMap a -> ForAllTyMap a -> TyMap (ForAllTyMap a) -> ForAllTyMap a
forall a.
TyMap a -> ForAllTyMap a -> TyMap (ForAllTyMap a) -> ForAllTyMap a
ForAllTyMap TyMap a
forall a. TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty ForAllTyMap a
forall a. ForAllTyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (ForAllTyMap a)
forall a. TyMap a
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 = (ForAllTyMap a -> TyMap a)
-> ForAllTyMap a -> ForAllTyMap a -> TyMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn ForAllTyMap a -> TyMap a
forall a. ForAllTyMap a -> TyMap a
fatNil ForAllTyMap a
m1 ForAllTyMap a
m2
    , fatUser :: ForAllTyMap a
fatUser = (ForAllTyMap a -> ForAllTyMap a)
-> ForAllTyMap a -> ForAllTyMap a -> ForAllTyMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn ForAllTyMap a -> ForAllTyMap a
forall a. ForAllTyMap a -> ForAllTyMap a
fatUser ForAllTyMap a
m1 ForAllTyMap a
m2
    , fatKinded :: TyMap (ForAllTyMap a)
fatKinded = (ForAllTyMap a -> TyMap (ForAllTyMap a))
-> ForAllTyMap a -> ForAllTyMap a -> TyMap (ForAllTyMap a)
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn ForAllTyMap a -> TyMap (ForAllTyMap a)
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 ([], LocatedA (HsType GhcPs)
ty) A a
f ForAllTyMap a
m = ForAllTyMap a
m { fatNil = mAlter env vs ty f (fatNil m) }
  mAlter AlphaEnv
env Quantifiers
vs ((RdrName
v,Maybe (LocatedA (HsType GhcPs))
mbK):[(RdrName, Maybe (LocatedA (HsType GhcPs)))]
rest, LocatedA (HsType GhcPs)
ty) A a
f ForAllTyMap a
m
    | Just LocatedA (HsType GhcPs)
k <- Maybe (LocatedA (HsType GhcPs))
mbK = ForAllTyMap a
m { fatKinded = mAlter env vs k (toA (mAlter env' vs' (rest, ty) f)) (fatKinded m) }
    | Bool
otherwise = ForAllTyMap a
m { fatUser = mAlter env' vs' (rest, ty) f (fatUser 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 ([],LocatedA (HsType GhcPs)
ty) = (ForAllTyMap a -> TyMap a)
-> (Substitution, ForAllTyMap a) -> [(Substitution, TyMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor ForAllTyMap a -> TyMap a
forall a. ForAllTyMap a -> TyMap a
fatNil ((Substitution, ForAllTyMap a) -> [(Substitution, TyMap a)])
-> ((Substitution, TyMap a) -> [(Substitution, a)])
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LocatedA (HsType GhcPs)
Key TyMap
ty
  mMatch MatchEnv
env ((RdrName
v,Maybe (LocatedA (HsType GhcPs))
mbK):[(RdrName, Maybe (LocatedA (HsType GhcPs)))]
rest, LocatedA (HsType GhcPs)
ty)
    | Just LocatedA (HsType GhcPs)
k <- Maybe (LocatedA (HsType GhcPs))
mbK = (ForAllTyMap a -> TyMap (ForAllTyMap a))
-> (Substitution, ForAllTyMap a)
-> [(Substitution, TyMap (ForAllTyMap a))]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor ForAllTyMap a -> TyMap (ForAllTyMap a)
forall a. ForAllTyMap a -> TyMap (ForAllTyMap a)
fatKinded ((Substitution, ForAllTyMap a)
 -> [(Substitution, TyMap (ForAllTyMap a))])
-> ((Substitution, TyMap (ForAllTyMap a)) -> [(Substitution, a)])
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap
-> (Substitution, TyMap (ForAllTyMap a))
-> [(Substitution, ForAllTyMap a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LocatedA (HsType GhcPs)
Key TyMap
k ((Substitution, TyMap (ForAllTyMap a))
 -> [(Substitution, ForAllTyMap a)])
-> ((Substitution, ForAllTyMap a) -> [(Substitution, a)])
-> (Substitution, TyMap (ForAllTyMap a))
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ([(RdrName, Maybe (LocatedA (HsType GhcPs)))]
rest, LocatedA (HsType GhcPs)
ty)
    | Bool
otherwise = (ForAllTyMap a -> ForAllTyMap a)
-> (Substitution, ForAllTyMap a) -> [(Substitution, ForAllTyMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor ForAllTyMap a -> ForAllTyMap a
forall a. ForAllTyMap a -> ForAllTyMap a
fatUser ((Substitution, ForAllTyMap a) -> [(Substitution, ForAllTyMap a)])
-> ((Substitution, ForAllTyMap a) -> [(Substitution, a)])
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall a.
MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ([(RdrName, Maybe (LocatedA (HsType GhcPs)))]
rest, LocatedA (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 -> b) -> ForallVisMap a -> ForallVisMap b)
-> (forall a b. a -> ForallVisMap b -> ForallVisMap a)
-> Functor ForallVisMap
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
$cfmap :: forall a b. (a -> b) -> ForallVisMap a -> ForallVisMap b
fmap :: forall a b. (a -> b) -> ForallVisMap a -> ForallVisMap b
$c<$ :: forall a b. a -> ForallVisMap b -> ForallVisMap a
<$ :: forall a b. a -> ForallVisMap b -> ForallVisMap a
Functor)

instance PatternMap ForallVisMap where
  type Key ForallVisMap = Bool

  mEmpty :: ForallVisMap a
  mEmpty :: forall a. ForallVisMap a
mEmpty = BoolMap a -> ForallVisMap a
forall a. BoolMap a -> ForallVisMap a
ForallVisMap BoolMap a
forall a. BoolMap a
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 = BoolMap a -> ForallVisMap a
forall a. BoolMap a -> ForallVisMap a
ForallVisMap ((ForallVisMap a -> BoolMap a)
-> ForallVisMap a -> ForallVisMap a -> BoolMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn ForallVisMap a -> BoolMap a
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) = BoolMap a -> ForallVisMap a
forall a. BoolMap a -> ForallVisMap a
ForallVisMap (BoolMap a -> ForallVisMap a) -> BoolMap a -> ForallVisMap a
forall a b. (a -> b) -> a -> b
$ AlphaEnv
-> Quantifiers -> Key BoolMap -> A a -> BoolMap a -> BoolMap a
forall a.
AlphaEnv
-> Quantifiers -> Key BoolMap -> A a -> BoolMap a -> BoolMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Key BoolMap
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 = (ForallVisMap a -> BoolMap a)
-> (Substitution, ForallVisMap a) -> [(Substitution, BoolMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor ForallVisMap a -> BoolMap a
forall a. ForallVisMap a -> BoolMap a
favBoolMap ((Substitution, ForallVisMap a) -> [(Substitution, BoolMap a)])
-> ((Substitution, BoolMap a) -> [(Substitution, a)])
-> (Substitution, ForallVisMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key BoolMap -> (Substitution, BoolMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key BoolMap -> (Substitution, BoolMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Key BoolMap
Key ForallVisMap
b
#endif