-- 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 RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
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 { TupArgMap a -> EMap a
tamPresent :: EMap a, TupArgMap a -> MaybeMap a
tamMissing :: MaybeMap a }
  deriving (a -> TupArgMap b -> TupArgMap a
(a -> b) -> TupArgMap a -> TupArgMap b
(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
<$ :: a -> TupArgMap b -> TupArgMap a
$c<$ :: forall a b. a -> TupArgMap b -> TupArgMap a
fmap :: (a -> b) -> TupArgMap a -> TupArgMap b
$cfmap :: forall a b. (a -> b) -> TupArgMap a -> TupArgMap b
Functor)

instance PatternMap TupArgMap where
  type Key TupArgMap = LHsTupArg GhcPs

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

  mUnion :: TupArgMap a -> TupArgMap a -> TupArgMap a
  mUnion :: TupArgMap a -> TupArgMap a -> TupArgMap a
mUnion TupArgMap a
m1 TupArgMap a
m2 = TupArgMap :: forall a. EMap a -> MaybeMap a -> TupArgMap a
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 :: 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 (LHsTupArg GhcPs -> SrcSpanLess (LHsTupArg GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsTupArg GhcPs
Key TupArgMap
tupArg)
    where
      go :: HsTupArg GhcPs -> TupArgMap a
go (Present XPresent GhcPs
_ LHsExpr GhcPs
e) = TupArgMap a
m { tamPresent :: EMap a
tamPresent = 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 LHsExpr GhcPs
Key EMap
e  A a
f (TupArgMap a -> EMap a
forall a. TupArgMap a -> EMap a
tamPresent TupArgMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XTupArg{} = String -> TupArgMap a
forall a. String -> a
missingSyntax String
"XTupArg"
#endif
      go (Missing XMissing GhcPs
_) = TupArgMap a
m { tamMissing :: MaybeMap a
tamMissing = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (TupArgMap a -> MaybeMap a
forall a. TupArgMap a -> MaybeMap a
tamMissing TupArgMap a
m) }

  mMatch :: MatchEnv -> Key TupArgMap -> (Substitution, TupArgMap a) -> [(Substitution, a)]
  mMatch :: MatchEnv
-> Key TupArgMap
-> (Substitution, TupArgMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env = HsTupArg GhcPs
-> (Substitution, TupArgMap a) -> [(Substitution, a)]
go (HsTupArg GhcPs
 -> (Substitution, TupArgMap a) -> [(Substitution, a)])
-> (LHsTupArg GhcPs -> HsTupArg GhcPs)
-> LHsTupArg GhcPs
-> (Substitution, TupArgMap a)
-> [(Substitution, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTupArg GhcPs -> HsTupArg GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
    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 (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{} = [(Substitution, a)]
-> (Substitution, TupArgMap a) -> [(Substitution, a)]
forall a b. a -> b -> a
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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()

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

data BoxityMap a
  = BoxityMap { BoxityMap a -> MaybeMap a
boxBoxed :: MaybeMap a, BoxityMap a -> MaybeMap a
boxUnboxed :: MaybeMap a }
  deriving (a -> BoxityMap b -> BoxityMap a
(a -> b) -> BoxityMap a -> BoxityMap b
(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
<$ :: a -> BoxityMap b -> BoxityMap a
$c<$ :: forall a b. a -> BoxityMap b -> BoxityMap a
fmap :: (a -> b) -> BoxityMap a -> BoxityMap b
$cfmap :: forall a b. (a -> b) -> BoxityMap a -> BoxityMap b
Functor)

instance PatternMap BoxityMap where
  type Key BoxityMap = Boxity

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

  mUnion :: BoxityMap a -> BoxityMap a -> BoxityMap a
  mUnion :: BoxityMap a -> BoxityMap a -> BoxityMap a
mUnion BoxityMap a
m1 BoxityMap a
m2 = BoxityMap :: forall a. MaybeMap a -> MaybeMap a -> BoxityMap a
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 :: AlphaEnv
-> Quantifiers
-> Key BoxityMap
-> A a
-> BoxityMap a
-> BoxityMap a
mAlter AlphaEnv
env Quantifiers
vs Key BoxityMap
Boxed   A a
f BoxityMap a
m = BoxityMap a
m { boxBoxed :: MaybeMap a
boxBoxed   = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (BoxityMap a -> MaybeMap a
forall a. BoxityMap a -> MaybeMap a
boxBoxed BoxityMap a
m) }
  mAlter AlphaEnv
env Quantifiers
vs Key BoxityMap
Unboxed A a
f BoxityMap a
m = BoxityMap a
m { boxUnboxed :: MaybeMap a
boxUnboxed = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (BoxityMap a -> MaybeMap a
forall a. BoxityMap a -> MaybeMap a
boxUnboxed BoxityMap a
m) }

  mMatch :: MatchEnv -> Key BoxityMap -> (Substitution, BoxityMap a) -> [(Substitution, a)]
  mMatch :: MatchEnv
-> Key BoxityMap
-> (Substitution, BoxityMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
  mMatch MatchEnv
env 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()

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

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

instance PatternMap VMap where
  type Key VMap = RdrName

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

  mUnion :: VMap a -> VMap a -> VMap a
  mUnion :: 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 :: forall a. IntMap a -> FSEnv a -> VMap a
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 :: 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 (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 (m :: * -> *) a. PatternMap m => m a
mEmpty 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 :: IntMap a
bvmap = AlphaEnv
-> Quantifiers -> Key IntMap -> A a -> IntMap a -> IntMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Int
Key IntMap
bv A a
f (VMap a -> IntMap a
forall a. VMap a -> IntMap a
bvmap VMap a
m) }
    | Bool
otherwise                       = VMap a
m { fvmap :: FSEnv a
fvmap = AlphaEnv -> Quantifiers -> Key FSEnv -> A a -> FSEnv a -> FSEnv a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (RdrName -> FastString
rdrFS RdrName
Key VMap
v) A a
f (VMap a -> FSEnv a
forall a. VMap a -> FSEnv a
fvmap VMap a
m) }

  mMatch :: MatchEnv -> Key VMap -> (Substitution, VMap a) -> [(Substitution, a)]
  mMatch :: 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 (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 (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 { LMap a -> Map Char a
lmChar :: Map Char a
       , LMap a -> Map Char a
lmCharPrim :: Map Char a
       , LMap a -> FSEnv a
lmString :: FSEnv a
       , LMap a -> Map ByteString a
lmStringPrim :: Map ByteString a
       , LMap a -> BoolMap (Map Integer a)
lmInt :: BoolMap (Map Integer a)
       , LMap a -> Map Integer a
lmIntPrim :: Map Integer a
       , LMap a -> Map Integer a
lmWordPrim :: Map Integer a
       , LMap a -> Map Integer a
lmInt64Prim :: Map Integer a
       , LMap a -> Map Integer a
lmWord64Prim :: Map Integer a
       }
  deriving (a -> LMap b -> LMap a
(a -> b) -> LMap a -> LMap b
(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
<$ :: a -> LMap b -> LMap a
$c<$ :: forall a b. a -> LMap b -> LMap a
fmap :: (a -> b) -> LMap a -> LMap b
$cfmap :: forall a b. (a -> b) -> LMap a -> LMap b
Functor)

emptyLMapWrapper :: LMap a
emptyLMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty Map Char a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map ByteString a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty BoolMap (Map Integer a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
       Map Integer a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Integer a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Integer a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty Map Integer a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap LMap where
  type Key LMap = HsLit GhcPs

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

  mUnion :: LMap a -> LMap a -> LMap a
  mUnion :: 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 :: 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
    { 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 :: 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 (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 :: Map Char a
lmChar = AlphaEnv
-> Quantifiers -> Key (Map Char) -> A a -> Map Char a -> Map Char a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Char
Key (Map Char)
c A a
f (LMap a -> Map Char a
forall a. LMap a -> Map Char a
lmChar LMap a
m) }
      go (HsCharPrim XHsCharPrim GhcPs
_ Char
c)   = LMap a
m { lmCharPrim :: Map Char a
lmCharPrim = AlphaEnv
-> Quantifiers -> Key (Map Char) -> A a -> Map Char a -> Map Char a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Char
Key (Map Char)
c A a
f (LMap a -> Map Char a
forall a. LMap a -> Map Char a
lmCharPrim LMap a
m) }
      go (HsString XHsString GhcPs
_ FastString
fs)    = LMap a
m { lmString :: FSEnv a
lmString = AlphaEnv -> Quantifiers -> Key FSEnv -> A a -> FSEnv a -> FSEnv a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs FastString
Key FSEnv
fs A a
f (LMap a -> FSEnv a
forall a. LMap a -> FSEnv a
lmString LMap a
m) }
      go (HsStringPrim XHsStringPrim GhcPs
_ ByteString
bs) = LMap a
m { lmStringPrim :: Map ByteString a
lmStringPrim = AlphaEnv
-> Quantifiers
-> Key (Map ByteString)
-> A a
-> Map ByteString a
-> Map ByteString a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs ByteString
Key (Map ByteString)
bs A a
f (LMap a -> Map ByteString a
forall a. LMap a -> Map ByteString a
lmStringPrim LMap a
m) }
      go (HsInt XHsInt GhcPs
_ (IL SourceText
_ Bool
b Integer
i)) =
        LMap a
m { lmInt :: BoolMap (Map Integer a)
lmInt = AlphaEnv
-> Quantifiers
-> Key BoolMap
-> A (Map Integer a)
-> BoolMap (Map Integer a)
-> BoolMap (Map Integer a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Bool
Key BoolMap
b ((Map Integer a -> Map Integer a) -> A (Map Integer a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (Map Integer)
-> A a
-> Map Integer a
-> Map Integer a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
Key (Map Integer)
i A a
f)) (LMap a -> BoolMap (Map Integer a)
forall a. LMap a -> BoolMap (Map Integer a)
lmInt LMap a
m) }
      go (HsIntPrim XHsIntPrim GhcPs
_ Integer
i)    = LMap a
m { lmIntPrim :: Map Integer a
lmIntPrim = AlphaEnv
-> Quantifiers
-> Key (Map Integer)
-> A a
-> Map Integer a
-> Map Integer a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
Key (Map Integer)
i A a
f (LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmIntPrim LMap a
m) }
      go (HsWordPrim XHsWordPrim GhcPs
_ Integer
i)   = LMap a
m { lmWordPrim :: Map Integer a
lmWordPrim = AlphaEnv
-> Quantifiers
-> Key (Map Integer)
-> A a
-> Map Integer a
-> Map Integer a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
Key (Map Integer)
i A a
f (LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmWordPrim LMap a
m) }
      go (HsInt64Prim XHsInt64Prim GhcPs
_ Integer
i)  = LMap a
m { lmInt64Prim :: Map Integer a
lmInt64Prim = AlphaEnv
-> Quantifiers
-> Key (Map Integer)
-> A a
-> Map Integer a
-> Map Integer a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
Key (Map Integer)
i A a
f (LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmInt64Prim LMap a
m) }
      go (HsWord64Prim XHsWord64Prim GhcPs
_ Integer
i) = LMap a
m { lmWord64Prim :: Map Integer a
lmWord64Prim = AlphaEnv
-> Quantifiers
-> Key (Map Integer)
-> A a
-> Map Integer a
-> Map Integer a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
Key (Map Integer)
i A a
f (LMap a -> Map Integer a
forall a. LMap a -> Map Integer a
lmWord64Prim LMap a
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{} = String -> LMap a
forall a. String -> a
missingSyntax String
"XLit"
#endif

  mMatch :: MatchEnv -> Key LMap -> (Substitution, LMap a) -> [(Substitution, a)]
  mMatch :: 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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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
    { OLMap a -> BoolMap (Map Integer a)
olmIntegral :: BoolMap (Map Integer a)
    , OLMap a -> Map Rational a
olmFractional :: Map Rational a
    , OLMap a -> FSEnv a
olmIsString :: FSEnv a
    }
  deriving (a -> OLMap b -> OLMap a
(a -> b) -> OLMap a -> OLMap b
(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
<$ :: a -> OLMap b -> OLMap a
$c<$ :: forall a b. a -> OLMap b -> OLMap a
fmap :: (a -> b) -> OLMap a -> OLMap b
$cfmap :: forall a b. (a -> b) -> OLMap a -> OLMap b
Functor)

emptyOLMapWrapper :: OLMap a
emptyOLMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty Map Rational a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap OLMap where
  type Key OLMap = OverLitVal

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

  mUnion :: OLMap a -> OLMap a -> OLMap a
  mUnion :: 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 :: forall a.
BoolMap (Map Integer a) -> Map Rational a -> FSEnv a -> OLMap a
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 :: 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 (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 :: BoolMap (Map Integer a)
olmIntegral = AlphaEnv
-> Quantifiers
-> Key BoolMap
-> A (Map Integer a)
-> BoolMap (Map Integer a)
-> BoolMap (Map Integer a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Bool
Key BoolMap
b ((Map Integer a -> Map Integer a) -> A (Map Integer a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (Map Integer)
-> A a
-> Map Integer a
-> Map Integer a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Integer
Key (Map Integer)
i A a
f)) (OLMap a -> BoolMap (Map Integer a)
forall a. OLMap a -> BoolMap (Map Integer a)
olmIntegral OLMap a
m) }
      go (HsFractional FractionalLit
fl) = OLMap a
m { olmFractional :: Map Rational a
olmFractional = AlphaEnv
-> Quantifiers
-> Key (Map Rational)
-> A a
-> Map Rational a
-> Map Rational a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (FractionalLit -> Rational
fl_value FractionalLit
fl) A a
f (OLMap a -> Map Rational a
forall a. OLMap a -> Map Rational a
olmFractional OLMap a
m) }
      go (HsIsString SourceText
_ FastString
fs) = OLMap a
m { olmIsString :: FSEnv a
olmIsString = AlphaEnv -> Quantifiers -> Key FSEnv -> A a -> FSEnv a -> FSEnv a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs FastString
Key FSEnv
fs A a
f (OLMap a -> FSEnv a
forall a. OLMap a -> FSEnv a
olmIsString OLMap a
m) }

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

emptyEMapWrapper :: EMap a
emptyEMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty VMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty OLMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty LMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     MGMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap (EMap a))
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     BoxityMap (ListMap TupArgMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (MGMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (EMap (EMap a))
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     LBMap (EMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty SCMap (SLMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty ListMap EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty VMap (ListMap RFMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap (ListMap RFMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
     EMap (TyMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap EMap where
  type Key EMap = LHsExpr GhcPs

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

  mUnion :: EMap a -> EMap a -> EMap a
  mUnion :: 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 :: 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
    { 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 :: AlphaEnv -> Quantifiers -> Key EMap -> A a -> EMap a -> EMap a
  mAlter :: 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 (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 (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr GhcPs
Key EMap
e)
    where
      go :: HsExpr GhcPs -> EMap a
go (HsVar XVar GhcPs
_ Located (IdP GhcPs)
v)
        | Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = EMap a
m { emHole :: Map RdrName a
emHole  = AlphaEnv
-> Quantifiers
-> Key (Map RdrName)
-> A a
-> Map RdrName a
-> Map RdrName a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
v) A a
f (EMap a -> Map RdrName a
forall a. EMap a -> Map RdrName a
emHole EMap a
m) }
        | Bool
otherwise        = EMap a
m { emVar :: VMap a
emVar   = 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 (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
v) A a
f (EMap a -> VMap a
forall a. EMap a -> VMap a
emVar EMap a
m) }
      go (ExplicitTuple XExplicitTuple GhcPs
_ [LHsTupArg GhcPs]
as Boxity
b) =
        EMap a
m { emExplicitTuple :: BoxityMap (ListMap TupArgMap a)
emExplicitTuple = AlphaEnv
-> Quantifiers
-> Key BoxityMap
-> A (ListMap TupArgMap a)
-> BoxityMap (ListMap TupArgMap a)
-> BoxityMap (ListMap TupArgMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Boxity
Key BoxityMap
b ((ListMap TupArgMap a -> ListMap TupArgMap a)
-> A (ListMap TupArgMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (ListMap TupArgMap)
-> A a
-> ListMap TupArgMap a
-> ListMap TupArgMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LHsTupArg GhcPs]
Key (ListMap TupArgMap)
as A a
f)) (EMap a -> BoxityMap (ListMap TupArgMap a)
forall a. EMap a -> BoxityMap (ListMap TupArgMap a)
emExplicitTuple EMap a
m) }
      go (HsApp XApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
r) =
        EMap a
m { emApp :: EMap (EMap a)
emApp = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (EMap a)
-> EMap (EMap a)
-> EMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
l ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
r A a
f)) (EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emApp EMap a
m) }
      go (HsCase XCase GhcPs
_ LHsExpr GhcPs
s MatchGroup GhcPs (LHsExpr GhcPs)
mg) =
        EMap a
m { emCase :: EMap (MGMap a)
emCase = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (MGMap a)
-> EMap (MGMap a)
-> EMap (MGMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
s ((MGMap a -> MGMap a) -> A (MGMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv -> Quantifiers -> Key MGMap -> A a -> MGMap a -> MGMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg A a
f)) (EMap a -> EMap (MGMap a)
forall a. EMap a -> EMap (MGMap a)
emCase EMap a
m) }
      go (HsDo XDo GhcPs
_ HsStmtContext Name
sc Located [ExprLStmt GhcPs]
ss) =
        EMap a
m { emDo :: SCMap (SLMap a)
emDo = AlphaEnv
-> Quantifiers
-> Key SCMap
-> A (SLMap a)
-> SCMap (SLMap a)
-> SCMap (SLMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsStmtContext Name
Key SCMap
sc ((SLMap a -> SLMap a) -> A (SLMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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 (Located [ExprLStmt GhcPs]
-> SrcSpanLess (Located [ExprLStmt GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [ExprLStmt GhcPs]
ss) A a
f)) (EMap a -> SCMap (SLMap a)
forall a. EMap a -> SCMap (SLMap a)
emDo EMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go (HsIf XIf GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ LHsExpr GhcPs
c LHsExpr GhcPs
tr LHsExpr GhcPs
fl) =
#else
      go (HsIf _ c tr fl) =
#endif
        EMap a
m { emIf :: EMap (EMap (EMap a))
emIf = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (EMap (EMap a))
-> EMap (EMap (EMap a))
-> EMap (EMap (EMap a))
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
c
                      ((EMap (EMap a) -> EMap (EMap a)) -> A (EMap (EMap a))
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key EMap
-> A (EMap a)
-> EMap (EMap a)
-> EMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
tr
                          ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
fl A a
f)))) (EMap a -> EMap (EMap (EMap a))
forall a. EMap a -> EMap (EMap (EMap a))
emIf EMap a
m) }
      go (HsIPVar XIPVar GhcPs
_ (HsIPName FastString
ip)) = EMap a
m { emIPVar :: FSEnv a
emIPVar = AlphaEnv -> Quantifiers -> Key FSEnv -> A a -> FSEnv a -> FSEnv a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs FastString
Key FSEnv
ip A a
f (EMap a -> FSEnv a
forall a. EMap a -> FSEnv a
emIPVar EMap a
m) }
      go (HsLit XLitE GhcPs
_ HsLit GhcPs
l) = EMap a
m { emLit :: LMap a
emLit   = 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 HsLit GhcPs
Key LMap
l A a
f (EMap a -> LMap a
forall a. EMap a -> LMap a
emLit EMap a
m) }
      go (HsLam XLam GhcPs
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg) = EMap a
m { emLam :: MGMap a
emLam   = AlphaEnv -> Quantifiers -> Key MGMap -> A a -> MGMap a -> MGMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg A a
f (EMap a -> MGMap a
forall a. EMap a -> MGMap a
emLam EMap a
m) }
      go (HsOverLit XOverLitE GhcPs
_ HsOverLit GhcPs
ol) = EMap a
m { emOverLit :: OLMap a
emOverLit = 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 (HsOverLit GhcPs -> OverLitVal
forall p. HsOverLit p -> OverLitVal
ol_val HsOverLit GhcPs
ol) A a
f (EMap a -> OLMap a
forall a. EMap a -> OLMap a
emOverLit EMap a
m) }
      go (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e' SyntaxExpr GhcPs
_) = EMap a
m { emNegApp :: EMap a
emNegApp = 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 LHsExpr GhcPs
Key EMap
e' A a
f (EMap a -> EMap a
forall a. EMap a -> EMap a
emNegApp EMap a
m) }
      go (HsPar XPar GhcPs
_ LHsExpr GhcPs
e') = EMap a
m { emPar :: EMap a
emPar  = 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 LHsExpr GhcPs
Key EMap
e' A a
f (EMap a -> EMap a
forall a. EMap a -> EMap a
emPar EMap a
m) }
      go (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
l LHsExpr GhcPs
o LHsExpr GhcPs
r) =
        EMap a
m { emOpApp :: EMap (EMap (EMap a))
emOpApp = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (EMap (EMap a))
-> EMap (EMap (EMap a))
-> EMap (EMap (EMap a))
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
o ((EMap (EMap a) -> EMap (EMap a)) -> A (EMap (EMap a))
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key EMap
-> A (EMap a)
-> EMap (EMap a)
-> EMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
l ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
r A a
f)))) (EMap a -> EMap (EMap (EMap a))
forall a. EMap a -> EMap (EMap (EMap a))
emOpApp EMap a
m) }
      go (RecordCon XRecordCon GhcPs
_ Located (IdP GhcPs)
v HsRecordBinds GhcPs
fs) =
        EMap a
m { emRecordCon :: VMap (ListMap RFMap a)
emRecordCon = AlphaEnv
-> Quantifiers
-> Key VMap
-> A (ListMap RFMap a)
-> VMap (ListMap RFMap a)
-> VMap (ListMap RFMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
v) ((ListMap RFMap a -> ListMap RFMap a) -> A (ListMap RFMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (ListMap RFMap)
-> A a
-> ListMap RFMap a
-> ListMap RFMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs ([LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
-> [LHsRecField' RdrName (LHsExpr GhcPs)]
forall f arg.
RecordFieldToRdrName f =>
[LHsRecField' f arg] -> [LHsRecField' RdrName arg]
fieldsToRdrNames ([LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
 -> [LHsRecField' RdrName (LHsExpr GhcPs)])
-> [LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
-> [LHsRecField' RdrName (LHsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ HsRecordBinds GhcPs
-> [LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecordBinds GhcPs
fs) A a
f)) (EMap a -> VMap (ListMap RFMap a)
forall a. EMap a -> VMap (ListMap RFMap a)
emRecordCon EMap a
m) }
      go (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
e' [LHsRecUpdField GhcPs]
fs) =
        EMap a
m { emRecordUpd :: EMap (ListMap RFMap a)
emRecordUpd = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (ListMap RFMap a)
-> EMap (ListMap RFMap a)
-> EMap (ListMap RFMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
e' ((ListMap RFMap a -> ListMap RFMap a) -> A (ListMap RFMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (ListMap RFMap)
-> A a
-> ListMap RFMap a
-> ListMap RFMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs ([LHsRecUpdField GhcPs] -> [LHsRecField' RdrName (LHsExpr GhcPs)]
forall f arg.
RecordFieldToRdrName f =>
[LHsRecField' f arg] -> [LHsRecField' RdrName arg]
fieldsToRdrNames [LHsRecUpdField GhcPs]
fs) A a
f)) (EMap a -> EMap (ListMap RFMap a)
forall a. EMap a -> EMap (ListMap RFMap a)
emRecordUpd EMap a
m) }
      go (SectionL XSectionL GhcPs
_ LHsExpr GhcPs
lhs LHsExpr GhcPs
o) =
        EMap a
m { emSecL :: EMap (EMap a)
emSecL = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (EMap a)
-> EMap (EMap a)
-> EMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
o ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
lhs A a
f)) (EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emSecL EMap a
m) }
      go (SectionR XSectionR GhcPs
_ LHsExpr GhcPs
o LHsExpr GhcPs
rhs) =
        EMap a
m { emSecR :: EMap (EMap a)
emSecR = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (EMap a)
-> EMap (EMap a)
-> EMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
o ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
rhs A a
f)) (EMap a -> EMap (EMap a)
forall a. EMap a -> EMap (EMap a)
emSecR EMap a
m) }
      go (HsLet XLet GhcPs
_ LHsLocalBinds GhcPs
lbs LHsExpr GhcPs
e') =
        let
          bs :: [IdP GhcPs]
bs = HsLocalBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders (HsLocalBindsLR GhcPs GhcPs -> [IdP GhcPs])
-> HsLocalBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall a b. (a -> b) -> a -> b
$ LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
lbs
          env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
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 :: LBMap (EMap a)
emLet = AlphaEnv
-> Quantifiers
-> Key LBMap
-> A (EMap a)
-> LBMap (EMap a)
-> LBMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
lbs) ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' LHsExpr GhcPs
Key EMap
e' A a
f)) (EMap a -> LBMap (EMap a)
forall a. EMap a -> LBMap (EMap a)
emLet EMap a
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
_ Maybe (SyntaxExpr GhcPs)
_ [LHsExpr GhcPs]
es) = EMap a
m { emExplicitList :: ListMap EMap a
emExplicitList = AlphaEnv
-> Quantifiers
-> Key (ListMap EMap)
-> A a
-> ListMap EMap a
-> ListMap EMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [LHsExpr GhcPs]
Key (ListMap EMap)
es A a
f (EMap a -> ListMap EMap a
forall a. EMap a -> ListMap EMap a
emExplicitList EMap a
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))
_ (HsIB XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
_ LHsType (NoGhcTc GhcPs)
ty))) =
        EMap a
m { emExprWithTySig :: EMap (TyMap a)
emExprWithTySig = AlphaEnv
-> Quantifiers
-> Key EMap
-> A (TyMap a)
-> EMap (TyMap a)
-> EMap (TyMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
e' ((TyMap a -> TyMap a) -> A (TyMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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 LHsType (NoGhcTc GhcPs)
Key TyMap
ty A a
f)) (EMap a -> EMap (TyMap a)
forall a. EMap a -> EMap (TyMap a)
emExprWithTySig EMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XExpr{} = String -> EMap a
forall a. String -> a
missingSyntax String
"XExpr"
      go ExprWithTySig{} = String -> EMap a
forall a. String -> a
missingSyntax String
"ExprWithTySig"
      go HsSCC{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsSCC"
      go HsCoreAnn{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsCoreAnn"
      go HsTickPragma{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsTickPragma"
      go HsWrap{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsWrap"
#else
      go HsPragE{} = missingSyntax "HsPragE"
#endif
      go HsBracket{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsBracket"
      go HsRnBracketOut{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsRnBracketOut"
      go HsTcBracketOut{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsTcBracketOut"
      go HsSpliceE{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsSpliceE"
      go HsProc{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsProc"
      go HsStatic{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsStatic"
#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
      go HsTick{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsTick"
      go HsBinTick{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsBinTick"
      go HsUnboundVar{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsUnboundVar"
      go HsRecFld{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsRecFld"
      go HsOverLabel{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsOverLabel"
      go HsAppType{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsAppType"
      go HsConLikeOut{} = String -> EMap a
forall a. String -> a
missingSyntax String
"HsConLikeOut"
      go ExplicitSum{} = String -> EMap a
forall a. String -> a
missingSyntax String
"ExplicitSum"

  mMatch :: MatchEnv -> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
  mMatch :: 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 (LHsExpr GhcPs -> SrcSpanLess (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr 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 -> LHsExpr GhcPs -> AnnotatedHsExpr
MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env LHsExpr GhcPs
Key EMap
e) Substitution
hs

      go :: HsExpr GhcPs -> (Substitution, EMap a) -> [(Substitution, a)]
go (ExplicitTuple XExplicitTuple GhcPs
_ [LHsTupArg 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [LHsTupArg 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 (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 (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 (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 (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
_ HsStmtContext Name
sc Located [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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsStmtContext Name
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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Located [ExprLStmt GhcPs]
-> SrcSpanLess (Located [ExprLStmt GhcPs])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [ExprLStmt GhcPs]
ss)
#if __GLASGOW_HASKELL__ < 900
      go (HsIf XIf GhcPs
_ Maybe (SyntaxExpr GhcPs)
_ LHsExpr GhcPs
c LHsExpr GhcPs
tr LHsExpr GhcPs
fl) =
#else
      go (HsIf _ c tr 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 (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 (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 (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 (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 (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 (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 (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)
      go (HsPar XPar GhcPs
_ LHsExpr GhcPs
e') = (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e'
      go (HsVar XVar GhcPs
_ Located (IdP 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located 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 (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 (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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e'
      go (RecordCon XRecordCon GhcPs
_ Located (IdP 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ([LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
-> [LHsRecField' RdrName (LHsExpr GhcPs)]
forall f arg.
RecordFieldToRdrName f =>
[LHsRecField' f arg] -> [LHsRecField' RdrName arg]
fieldsToRdrNames ([LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
 -> [LHsRecField' RdrName (LHsExpr GhcPs)])
-> [LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
-> [LHsRecField' RdrName (LHsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ HsRecordBinds GhcPs
-> [LHsRecField' (FieldOcc GhcPs) (LHsExpr GhcPs)]
forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds HsRecordBinds GhcPs
fs)
      go (RecordUpd XRecordUpd GhcPs
_ LHsExpr GhcPs
e' [LHsRecUpdField 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ([LHsRecUpdField GhcPs] -> [LHsRecField' RdrName (LHsExpr GhcPs)]
forall f arg.
RecordFieldToRdrName f =>
[LHsRecField' f arg] -> [LHsRecField' RdrName arg]
fieldsToRdrNames [LHsRecUpdField 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 (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 (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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
rhs
      go (HsLet XLet GhcPs
_ LHsLocalBinds GhcPs
lbs LHsExpr GhcPs
e') =
        let
          bs :: [IdP GhcPs]
bs = HsLocalBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsLocalBinds GhcPs
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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' LHsExpr GhcPs
Key EMap
e'
      go (ExplicitList XExplicitList GhcPs
_ Maybe (SyntaxExpr 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 (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))
_ (HsIB XHsIB (NoGhcTc GhcPs) (LHsType (NoGhcTc GhcPs))
_ LHsType (NoGhcTc 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType (NoGhcTc 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 :: 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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Substitution, a) -> Maybe (Substitution, 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 :: [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 (AnnotatedHsExpr -> LHsExpr GhcPs
forall ast. Annotated ast -> ast
astA AnnotatedHsExpr
e1) (AnnotatedHsExpr -> LHsExpr GhcPs
forall ast. Annotated ast -> ast
astA AnnotatedHsExpr
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 (Located (Pat GhcPs) -> LPat GhcPs
forall (p :: Pass). Located (Pat (GhcPass p)) -> LPat (GhcPass p)
cLPat (Located (Pat GhcPs) -> LPat GhcPs)
-> Located (Pat GhcPs) -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ AnnotatedPat -> Located (Pat GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedPat
p1) (Located (Pat GhcPs) -> LPat GhcPs
forall (p :: Pass). Located (Pat (GhcPass p)) -> LPat (GhcPass p)
cLPat (Located (Pat GhcPs) -> LPat GhcPs)
-> Located (Pat GhcPs) -> LPat GhcPs
forall a b. (a -> b) -> a -> b
$ AnnotatedPat -> Located (Pat GhcPs)
forall ast. Annotated ast -> ast
astA AnnotatedPat
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 (AnnotatedHsType -> LHsType GhcPs
forall ast. Annotated ast -> ast
astA AnnotatedHsType
ty1) (AnnotatedHsType -> LHsType GhcPs
forall ast. Annotated ast -> ast
astA AnnotatedHsType
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 :: 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 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 { SCMap a -> MaybeMap a
scmListComp :: MaybeMap a
        , SCMap a -> MaybeMap a
scmMonadComp :: MaybeMap a
#if __GLASGOW_HASKELL__ < 900
        , SCMap a -> MaybeMap a
scmDoExpr :: MaybeMap a
#else
        , scmDoExpr :: FSEnv a -- We use empty string when modulename is Nothing
#endif
        -- TODO: the rest
        }
  deriving (a -> SCMap b -> SCMap a
(a -> b) -> SCMap a -> SCMap b
(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
<$ :: a -> SCMap b -> SCMap a
$c<$ :: forall a b. a -> SCMap b -> SCMap a
fmap :: (a -> b) -> SCMap a -> SCMap b
$cfmap :: forall a b. (a -> b) -> SCMap a -> SCMap b
Functor)

emptySCMapWrapper :: SCMap a
emptySCMapWrapper :: SCMap a
emptySCMapWrapper = MaybeMap a -> MaybeMap a -> MaybeMap a -> SCMap a
forall a. MaybeMap a -> MaybeMap a -> MaybeMap a -> SCMap a
SCM MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap 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__ < 920
  type Key SCMap = HsStmtContext GhcRn
#else
  type Key SCMap = HsStmtContext (HsDoRn GhcPs)
#endif

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

  mUnion :: SCMap a -> SCMap a -> SCMap a
  mUnion :: 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 :: forall a. MaybeMap a -> MaybeMap a -> MaybeMap a -> SCMap a
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 :: MaybeMap a
scmDoExpr = (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
scmDoExpr SCMap a
m1 SCMap a
m2
    }

  mAlter :: AlphaEnv -> Quantifiers -> Key SCMap -> A a -> SCMap a -> SCMap a
  mAlter :: 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 (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{} = HsStmtContext Name -> SCMap a
go HsStmtContext Name
Key SCMap
sc
    where
      go :: HsStmtContext Name -> SCMap a
go HsStmtContext Name
ListComp = SCMap a
m { scmListComp :: MaybeMap a
scmListComp = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (SCMap a -> MaybeMap a
forall a. SCMap a -> MaybeMap a
scmListComp SCMap a
m) }
      go HsStmtContext Name
MonadComp = SCMap a
m { scmMonadComp :: MaybeMap a
scmMonadComp = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (SCMap a -> MaybeMap a
forall a. SCMap a -> MaybeMap a
scmMonadComp SCMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go HsStmtContext Name
DoExpr = SCMap a
m { scmDoExpr :: MaybeMap a
scmDoExpr = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (SCMap a -> MaybeMap a
forall a. SCMap a -> MaybeMap a
scmDoExpr SCMap a
m) }
#else
      go (DoExpr mname) = m { scmDoExpr = mAlter env vs (maybe "" moduleNameFS mname) f (scmDoExpr m) }
#endif
      go MDoExpr{} = String -> SCMap a
forall a. String -> a
missingSyntax String
"MDoExpr"
      go HsStmtContext Name
ArrowExpr = String -> SCMap a
forall a. String -> a
missingSyntax String
"ArrowExpr"
      go HsStmtContext Name
GhciStmtCtxt = String -> SCMap a
forall a. String -> a
missingSyntax String
"GhciStmtCtxt"
      go (PatGuard HsMatchContext Name
_) = String -> SCMap a
forall a. String -> a
missingSyntax String
"PatGuard"
      go (ParStmtCtxt HsStmtContext Name
_) = String -> SCMap a
forall a. String -> a
missingSyntax String
"ParStmtCtxt"
      go (TransStmtCtxt HsStmtContext Name
_) = String -> SCMap a
forall a. String -> a
missingSyntax String
"TransStmtCtxt"

  mMatch :: MatchEnv -> Key SCMap -> (Substitution, SCMap a) -> [(Substitution, a)]
  mMatch :: MatchEnv
-> Key SCMap -> (Substitution, SCMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key SCMap
_  (Substitution
_,SCMap a
SCEmpty)  = []
  mMatch MatchEnv
env Key SCMap
sc (Substitution
hs,m :: SCMap a
m@SCM{}) = HsStmtContext Name
-> (Substitution, SCMap a) -> [(Substitution, a)]
go HsStmtContext Name
Key SCMap
sc (Substitution
hs,SCMap a
m)
    where
      go :: HsStmtContext Name
-> (Substitution, SCMap a) -> [(Substitution, a)]
go HsStmtContext Name
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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go HsStmtContext Name
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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
#if __GLASGOW_HASKELL__ < 900
      go HsStmtContext Name
DoExpr = (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
scmDoExpr ((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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
#else
      go (DoExpr mname) = mapFor scmDoExpr >=> mMatch env (maybe "" moduleNameFS mname)
#endif
      go HsStmtContext Name
_ = [(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 { MGMap a -> ListMap MMap a
unMGMap :: ListMap MMap a }
  deriving (a -> MGMap b -> MGMap a
(a -> b) -> MGMap a -> MGMap b
(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
<$ :: a -> MGMap b -> MGMap a
$c<$ :: forall a b. a -> MGMap b -> MGMap a
fmap :: (a -> b) -> MGMap a -> MGMap b
$cfmap :: forall a b. (a -> b) -> MGMap a -> MGMap b
Functor)

instance PatternMap MGMap where
  type Key MGMap = MatchGroup GhcPs (LHsExpr GhcPs)

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

  mUnion :: MGMap a -> MGMap a -> MGMap a
  mUnion :: 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 (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 :: 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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs [Match GhcPs (LHsExpr GhcPs)]
Key (ListMap MMap)
alts A a
f ListMap MMap a
m)
    where alts :: [Match GhcPs (LHsExpr GhcPs)]
alts = (LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs))
-> [LMatch GhcPs (LHsExpr GhcPs)] -> [Match GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LMatch GhcPs (LHsExpr GhcPs)]
 -> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)]))
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (LHsExpr GhcPs)
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg)

  mMatch :: MatchEnv -> Key MGMap -> (Substitution, MGMap a) -> [(Substitution, a)]
  mMatch :: 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [Match GhcPs (LHsExpr GhcPs)]
Key (ListMap MMap)
alts
    where alts :: [Match GhcPs (LHsExpr GhcPs)]
alts = (LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs))
-> [LMatch GhcPs (LHsExpr GhcPs)] -> [Match GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LMatch GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located [LMatch GhcPs (LHsExpr GhcPs)]
 -> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)]))
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcPs (LHsExpr GhcPs)
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg)

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

newtype MMap a = MMap { MMap a -> ListMap PatMap (GRHSSMap a)
unMMap :: ListMap PatMap (GRHSSMap a) }
  deriving (a -> MMap b -> MMap a
(a -> b) -> MMap a -> MMap b
(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
<$ :: a -> MMap b -> MMap a
$c<$ :: forall a b. a -> MMap b -> MMap a
fmap :: (a -> b) -> MMap a -> MMap b
$cfmap :: forall a b. (a -> b) -> MMap a -> MMap b
Functor)

instance PatternMap MMap where
  type Key MMap = Match GhcPs (LHsExpr GhcPs)

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

  mUnion :: MMap a -> MMap a -> MMap a
  mUnion :: 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 (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 :: 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 (LHsExpr GhcPs) -> [LPat GhcPs]
forall p body. Match p body -> [LPat p]
m_pats Match GhcPs (LHsExpr GhcPs)
Key MMap
match
        pbs :: [IdP GhcPs]
pbs = [LPat GhcPs] -> [IdP GhcPs]
forall (p :: Pass). [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders [LPat GhcPs]
lpats
        env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
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 (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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' (Match GhcPs (LHsExpr GhcPs) -> GRHSs GhcPs (LHsExpr GhcPs)
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (LHsExpr GhcPs)
Key MMap
match) A a
f)) ListMap PatMap (GRHSSMap a)
m)

  mMatch :: MatchEnv -> Key MMap -> (Substitution, MMap a) -> [(Substitution, a)]
  mMatch :: 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' (Match GhcPs (LHsExpr GhcPs) -> GRHSs GhcPs (LHsExpr GhcPs)
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (LHsExpr GhcPs)
Key MMap
match)
    where
      lpats :: [LPat GhcPs]
lpats = Match GhcPs (LHsExpr GhcPs) -> [LPat GhcPs]
forall p body. Match p body -> [LPat p]
m_pats Match GhcPs (LHsExpr GhcPs)
Key MMap
match
      pbs :: [IdP GhcPs]
pbs = [LPat GhcPs] -> [IdP GhcPs]
forall (p :: Pass). [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders [LPat GhcPs]
lpats
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
pbs

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

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

emptyCDMapWrapper :: CDMap a
emptyCDMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap (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))
#else
  -- We must manually expand 'LPat' to avoid UndecidableInstances in GHC 8.10+
  type Key CDMap = HsConDetails (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
#endif

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

  mUnion :: CDMap a -> CDMap a -> CDMap a
  mUnion :: 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 :: forall a. ListMap PatMap a -> PatMap (PatMap a) -> CDMap a
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 :: 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 (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
  (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
-> CDMap a
go HsConDetails
  (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
Key CDMap
d
    where
      go :: HsConDetails
  (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
-> CDMap a
go (PrefixCon [Located (Pat GhcPs)]
ps) = CDMap a
m { cdPrefixCon :: ListMap PatMap a
cdPrefixCon = 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 [Located (Pat GhcPs)]
Key (ListMap PatMap)
ps A a
f (CDMap a -> ListMap PatMap a
forall a. CDMap a -> ListMap PatMap a
cdPrefixCon CDMap a
m) }
      go (RecCon HsRecFields GhcPs (Located (Pat GhcPs))
_) = String -> CDMap a
forall a. String -> a
missingSyntax String
"RecCon"
      go (InfixCon Located (Pat GhcPs)
p1 Located (Pat GhcPs)
p2) = CDMap a
m { cdInfixCon :: PatMap (PatMap a)
cdInfixCon = AlphaEnv
-> Quantifiers
-> Key PatMap
-> A (PatMap a)
-> PatMap (PatMap a)
-> PatMap (PatMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Located (Pat GhcPs)
Key PatMap
p1
                                              ((PatMap a -> PatMap a) -> A (PatMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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 Located (Pat GhcPs)
Key PatMap
p2 A a
f))
                                              (CDMap a -> PatMap (PatMap a)
forall a. CDMap a -> PatMap (PatMap a)
cdInfixCon CDMap a
m) }

  mMatch :: MatchEnv -> Key CDMap -> (Substitution, CDMap a) -> [(Substitution, a)]
  mMatch :: 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
  (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
-> (Substitution, CDMap a) -> [(Substitution, a)]
go HsConDetails
  (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
Key CDMap
d (Substitution
hs,CDMap a
m)
    where
      go :: HsConDetails
  (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))
-> (Substitution, CDMap a) -> [(Substitution, a)]
go (PrefixCon [Located (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env [Located (Pat GhcPs)]
Key (ListMap PatMap)
ps
      go (InfixCon Located (Pat GhcPs)
p1 Located (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Located (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Located (Pat GhcPs)
Key PatMap
p2
      go HsConDetails
  (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (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 { PatMap a -> Map RdrName a
pmHole :: Map RdrName a -- See Note [Holes]
           , PatMap a -> MaybeMap a
pmWild :: MaybeMap a
           , PatMap a -> MaybeMap a
pmVar  :: MaybeMap a -- See Note [Variable Binders]
           , PatMap a -> PatMap a
pmParPat :: PatMap a
           , PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat :: BoxityMap (ListMap PatMap a)
           , PatMap a -> FSEnv (CDMap a)
pmConPatIn :: FSEnv (CDMap a)
           -- TODO: the rest
           }
  deriving (a -> PatMap b -> PatMap a
(a -> b) -> PatMap a -> PatMap b
(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
<$ :: a -> PatMap b -> PatMap a
$c<$ :: forall a b. a -> PatMap b -> PatMap a
fmap :: (a -> b) -> PatMap a -> PatMap b
$cfmap :: forall a b. (a -> b) -> PatMap a -> PatMap b
Functor)

emptyPatMapWrapper :: PatMap a
emptyPatMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty BoxityMap (ListMap PatMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty FSEnv (CDMap 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 = Located (Pat GhcPs)
#endif

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

  mUnion :: PatMap a -> PatMap a -> PatMap a
  mUnion :: 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 :: forall a.
Map RdrName a
-> MaybeMap a
-> MaybeMap a
-> PatMap a
-> BoxityMap (ListMap PatMap a)
-> FSEnv (CDMap a)
-> PatMap a
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 :: 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 (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 (Located (Pat GhcPs) -> SrcSpanLess (Located (Pat GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (Pat GhcPs)
Key PatMap
pat)
    where
      go :: Pat GhcPs -> PatMap a
go (WildPat XWildPat GhcPs
_) = PatMap a
m { pmWild :: MaybeMap a
pmWild = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (PatMap a -> MaybeMap a
forall a. PatMap a -> MaybeMap a
pmWild PatMap a
m) }
      go (VarPat XVarPat GhcPs
_ Located (IdP GhcPs)
v)
        | Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = PatMap a
m { pmHole :: Map RdrName a
pmHole  = AlphaEnv
-> Quantifiers
-> Key (Map RdrName)
-> A a
-> Map RdrName a
-> Map RdrName a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
v) A a
f (PatMap a -> Map RdrName a
forall a. PatMap a -> Map RdrName a
pmHole PatMap a
m) }
        | Bool
otherwise        = PatMap a
m { pmVar :: MaybeMap a
pmVar   = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (PatMap a -> MaybeMap a
forall a. PatMap a -> MaybeMap a
pmVar PatMap a
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{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"XPat"
      go CoPat{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"CoPat"
      go ConPatOut{} = String -> PatMap a
forall a. String -> a
missingSyntax String
"ConPatOut"
      go (ConPatIn Located (IdP GhcPs)
c HsConPatDetails GhcPs
d) =
#else
      go (ConPat _ c d) =
#endif
        PatMap a
m { pmConPatIn :: FSEnv (CDMap a)
pmConPatIn = AlphaEnv
-> Quantifiers
-> Key FSEnv
-> A (CDMap a)
-> FSEnv (CDMap a)
-> FSEnv (CDMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (RdrName -> FastString
rdrFS (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
c)) ((CDMap a -> CDMap a) -> A (CDMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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 HsConPatDetails GhcPs
Key CDMap
d A a
f)) (PatMap a -> FSEnv (CDMap a)
forall a. PatMap a -> FSEnv (CDMap a)
pmConPatIn PatMap a
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"
      go (ParPat XParPat GhcPs
_ LPat GhcPs
p) = PatMap a
m { pmParPat :: PatMap a
pmParPat = 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 LPat GhcPs
Key PatMap
p A a
f (PatMap a -> PatMap a
forall a. PatMap a -> PatMap a
pmParPat PatMap a
m) }
      go (TuplePat XTuplePat GhcPs
_ [LPat GhcPs]
ps Boxity
b) =
        PatMap a
m { pmTuplePat :: BoxityMap (ListMap PatMap a)
pmTuplePat = AlphaEnv
-> Quantifiers
-> Key BoxityMap
-> A (ListMap PatMap a)
-> BoxityMap (ListMap PatMap a)
-> BoxityMap (ListMap PatMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs Boxity
Key BoxityMap
b ((ListMap PatMap a -> ListMap PatMap a) -> A (ListMap PatMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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)
ps A a
f)) (PatMap a -> BoxityMap (ListMap PatMap a)
forall a. PatMap a -> BoxityMap (ListMap PatMap a)
pmTuplePat PatMap a
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 :: 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 :: Located (Pat GhcPs)
lp@(L SrcSpan
_ Pat GhcPs
p) <- LPat GhcPs -> Maybe (Located (Pat GhcPs))
forall (p :: Pass).
LPat (GhcPass p) -> Maybe (Located (Pat (GhcPass p)))
dLPat LPat GhcPs
Key PatMap
pat = Located (Pat GhcPs) -> [(Substitution, a)]
hss Located (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 :: Located (Pat GhcPs) -> [(Substitution, a)]
hss Located (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 -> Located (Pat GhcPs) -> AnnotatedPat
MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env Located (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go (ParPat XParPat GhcPs
_ LPat GhcPs
p) = (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LPat GhcPs
Key PatMap
p
      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 (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 (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
_ Located (IdP 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
#if __GLASGOW_HASKELL__ < 900
      go (ConPatIn Located (IdP GhcPs)
c HsConPatDetails GhcPs
d) =
#else
      go (ConPat _ c 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (RdrName -> FastString
rdrFS (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located 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 (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 { GRHSSMap a -> LBMap (ListMap GRHSMap a)
unGRHSSMap :: LBMap (ListMap GRHSMap a) }
  deriving (a -> GRHSSMap b -> GRHSSMap a
(a -> b) -> GRHSSMap a -> GRHSSMap b
(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
<$ :: a -> GRHSSMap b -> GRHSSMap a
$c<$ :: forall a b. a -> GRHSSMap b -> GRHSSMap a
fmap :: (a -> b) -> GRHSSMap a -> GRHSSMap b
$cfmap :: forall a b. (a -> b) -> GRHSSMap a -> GRHSSMap b
Functor)

instance PatternMap GRHSSMap where
  type Key GRHSSMap = GRHSs GhcPs (LHsExpr GhcPs)

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

  mUnion :: GRHSSMap a -> GRHSSMap a -> GRHSSMap a
  mUnion :: 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 (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 :: 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 :: SrcSpanLess (LHsLocalBinds GhcPs)
lbs = LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs))
-> LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a b. (a -> b) -> a -> b
$ GRHSs GhcPs (LHsExpr GhcPs) -> LHsLocalBinds GhcPs
forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds GRHSs GhcPs (LHsExpr GhcPs)
Key GRHSSMap
grhss
        bs :: [IdP GhcPs]
bs = HsLocalBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders HsLocalBindsLR GhcPs GhcPs
SrcSpanLess (LHsLocalBinds GhcPs)
lbs
        env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs SrcSpanLess (LHsLocalBinds 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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' ((LGRHS GhcPs (LHsExpr GhcPs) -> GRHS GhcPs (LHsExpr GhcPs))
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> [GRHS GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LGRHS GhcPs (LHsExpr GhcPs) -> GRHS GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([LGRHS GhcPs (LHsExpr GhcPs)] -> [GRHS GhcPs (LHsExpr GhcPs)])
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> [GRHS GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ GRHSs GhcPs (LHsExpr GhcPs) -> [LGRHS GhcPs (LHsExpr GhcPs)]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs GRHSs GhcPs (LHsExpr GhcPs)
Key GRHSSMap
grhss) A a
f)) LBMap (ListMap GRHSMap a)
m)

  mMatch :: MatchEnv -> Key GRHSSMap -> (Substitution, GRHSSMap a) -> [(Substitution, a)]
  mMatch :: 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env SrcSpanLess (LHsLocalBinds 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ((LGRHS GhcPs (LHsExpr GhcPs) -> GRHS GhcPs (LHsExpr GhcPs))
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> [GRHS GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LGRHS GhcPs (LHsExpr GhcPs) -> GRHS GhcPs (LHsExpr GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([LGRHS GhcPs (LHsExpr GhcPs)] -> [GRHS GhcPs (LHsExpr GhcPs)])
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> [GRHS GhcPs (LHsExpr GhcPs)]
forall a b. (a -> b) -> a -> b
$ GRHSs GhcPs (LHsExpr GhcPs) -> [LGRHS GhcPs (LHsExpr GhcPs)]
forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs GRHSs GhcPs (LHsExpr GhcPs)
Key GRHSSMap
grhss)
    where
      lbs :: SrcSpanLess (LHsLocalBinds GhcPs)
lbs = LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs))
-> LHsLocalBinds GhcPs -> SrcSpanLess (LHsLocalBinds GhcPs)
forall a b. (a -> b) -> a -> b
$ GRHSs GhcPs (LHsExpr GhcPs) -> LHsLocalBinds GhcPs
forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds GRHSs GhcPs (LHsExpr GhcPs)
Key GRHSSMap
grhss
      bs :: [IdP GhcPs]
bs = HsLocalBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders HsLocalBindsLR GhcPs GhcPs
SrcSpanLess (LHsLocalBinds GhcPs)
lbs
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
bs

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

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

instance PatternMap GRHSMap where
  type Key GRHSMap = GRHS GhcPs (LHsExpr GhcPs)

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

  mUnion :: GRHSMap a -> GRHSMap a -> GRHSMap a
  mUnion :: 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 (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 :: AlphaEnv
-> Quantifiers -> Key GRHSMap -> A a -> GRHSMap a -> GRHSMap a
mAlter AlphaEnv
_ Quantifiers
_ XGRHS{} A a
_ GRHSMap a
_ = String -> GRHSMap a
forall a. String -> a
missingSyntax String
"XGRHS"
#endif
  mAlter AlphaEnv
env Quantifiers
vs (GRHS _ gs b) A a
f (GRHSMap SLMap (EMap a)
m) =
    let bs :: [IdP GhcPs]
bs = [ExprLStmt GhcPs] -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders [ExprLStmt GhcPs]
gs
        env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
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 (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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' LHsExpr 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 :: MatchEnv
-> Key GRHSMap -> (Substitution, GRHSMap a) -> [(Substitution, a)]
mMatch MatchEnv
_ XGRHS{} = [(Substitution, a)]
-> (Substitution, GRHSMap a) -> [(Substitution, a)]
forall a b. a -> b -> a
const []
#endif
  mMatch MatchEnv
env (GRHS _ gs 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' LHsExpr GhcPs
Key EMap
b
    where
      bs :: [IdP GhcPs]
bs = [ExprLStmt GhcPs] -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders [ExprLStmt GhcPs]
gs
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [IdP GhcPs]
[RdrName]
bs

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

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

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

instance PatternMap SLMap where
  type Key SLMap = [LStmt GhcPs (LHsExpr GhcPs)]

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

  mUnion :: SLMap a -> SLMap a -> SLMap a
  mUnion :: 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 :: forall a. MaybeMap a -> SMap (SLMap a) -> SLMap a
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 :: 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 (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{} = [ExprLStmt GhcPs] -> SLMap a
go [ExprLStmt GhcPs]
Key SLMap
ss
    where
      go :: [ExprLStmt GhcPs] -> SLMap a
go []      = SLMap a
m { slmNil :: MaybeMap a
slmNil = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (SLMap a -> MaybeMap a
forall a. SLMap a -> MaybeMap a
slmNil SLMap a
m) }
      go (ExprLStmt GhcPs
s:[ExprLStmt GhcPs]
ss') =
        let
          bs :: [IdP GhcPs]
bs = ExprLStmt GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders ExprLStmt GhcPs
s
          env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
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 :: SMap (SLMap a)
slmCons = AlphaEnv
-> Quantifiers
-> Key SMap
-> A (SLMap a)
-> SMap (SLMap a)
-> SMap (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 SMap
s ((SLMap a -> SLMap a) -> A (SLMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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
ss' A a
f)) (SLMap a -> SMap (SLMap a)
forall a. SLMap a -> SMap (SLMap a)
slmCons SLMap a
m) }

  mMatch :: MatchEnv -> Key SLMap -> (Substitution, SLMap a) -> [(Substitution, a)]
  mMatch :: 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{}) = [ExprLStmt GhcPs] -> (Substitution, SLMap a) -> [(Substitution, a)]
go [ExprLStmt GhcPs]
Key SLMap
ss (Substitution
hs,SLMap a
m)
    where
      go :: [ExprLStmt 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
      go (ExprLStmt GhcPs
s:[ExprLStmt GhcPs]
ss') =
        let
          bs :: [IdP GhcPs]
bs = ExprLStmt GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass) body.
LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectLStmtBinders ExprLStmt 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ExprLStmt 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' [ExprLStmt 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 { LBMap a -> ListMap BMap a
lbValBinds :: ListMap BMap a -- see Note [Local Binds]
       -- TODO: , lbIPBinds ::
       , LBMap a -> MaybeMap a
lbEmpty :: MaybeMap a
       }
  deriving (a -> LBMap b -> LBMap a
(a -> b) -> LBMap a -> LBMap b
(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
<$ :: a -> LBMap b -> LBMap a
$c<$ :: forall a b. a -> LBMap b -> LBMap a
fmap :: (a -> b) -> LBMap a -> LBMap b
$cfmap :: forall a b. (a -> b) -> LBMap a -> LBMap b
Functor)

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

instance PatternMap LBMap where
  type Key LBMap = HsLocalBinds GhcPs

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

  mUnion :: LBMap a -> LBMap a -> LBMap a
  mUnion :: 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 :: forall a. ListMap BMap a -> MaybeMap a -> LBMap a
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 :: 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 (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{}  = HsLocalBindsLR GhcPs GhcPs -> LBMap a
go HsLocalBindsLR GhcPs GhcPs
Key LBMap
lbs
    where
      go :: HsLocalBindsLR GhcPs GhcPs -> LBMap a
go (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_) = LBMap a
m { lbEmpty :: MaybeMap a
lbEmpty = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (LBMap a -> MaybeMap a
forall a. LBMap a -> MaybeMap a
lbEmpty LBMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XHsLocalBindsLR{} = String -> LBMap a
forall a. String -> a
missingSyntax String
"XHsLocalBindsLR"
#endif
      go (HsValBinds XHsValBinds GhcPs GhcPs
_ HsValBindsLR GhcPs GhcPs
vbs) =
        let
          bs :: [IdP GhcPs]
bs = HsValBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsValBinders HsValBindsLR GhcPs GhcPs
vbs
          env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
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 :: ListMap BMap a
lbValBinds = AlphaEnv
-> Quantifiers
-> Key (ListMap BMap)
-> A a
-> ListMap BMap a
-> ListMap BMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' (HsValBindsLR GhcPs GhcPs -> [HsBind GhcPs]
deValBinds HsValBindsLR GhcPs GhcPs
vbs) A a
f (LBMap a -> ListMap BMap a
forall a. LBMap a -> ListMap BMap a
lbValBinds LBMap a
m) }
      go HsIPBinds{} = String -> LBMap a
forall a. String -> a
missingSyntax String
"HsIPBinds"

  mMatch :: MatchEnv -> Key LBMap -> (Substitution, LBMap a) -> [(Substitution, a)]
  mMatch :: 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{}) = HsLocalBindsLR GhcPs GhcPs
-> (Substitution, LBMap a) -> [(Substitution, a)]
go HsLocalBindsLR GhcPs GhcPs
Key LBMap
lbs (Substitution
hs,LBMap a
m)
    where
      go :: HsLocalBindsLR GhcPs 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 (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 = HsValBindsLR GhcPs GhcPs -> [IdP GhcPs]
forall (idL :: Pass) (idR :: Pass).
HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectHsValBinders 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 (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 HsLocalBindsLR GhcPs 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]
_) = (LHsBindLR GhcPs GhcPs -> HsBind GhcPs)
-> [LHsBindLR GhcPs GhcPs] -> [HsBind GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LHsBindLR GhcPs GhcPs -> HsBind GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsBindsLR GhcPs GhcPs -> [LHsBindLR GhcPs GhcPs]
forall a. Bag a -> [a]
bagToList LHsBindsLR GhcPs 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 { BMap a -> MGMap a
bmFunBind :: MGMap a
       , BMap a -> EMap a
bmVarBind :: EMap a
       , BMap a -> PatMap (GRHSSMap a)
bmPatBind :: PatMap (GRHSSMap a)
       -- TODO: rest
       }
  deriving (a -> BMap b -> BMap a
(a -> b) -> BMap a -> BMap b
(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
<$ :: a -> BMap b -> BMap a
$c<$ :: forall a b. a -> BMap b -> BMap a
fmap :: (a -> b) -> BMap a -> BMap b
$cfmap :: forall a b. (a -> b) -> BMap a -> BMap b
Functor)

emptyBMapWrapper :: BMap a
emptyBMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap (GRHSSMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap BMap where
  type Key BMap = HsBind GhcPs

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

  mUnion :: BMap a -> BMap a -> BMap a
  mUnion :: 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 :: forall a. MGMap a -> EMap a -> PatMap (GRHSSMap a) -> BMap a
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 :: 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 (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 :: HsBind GhcPs -> BMap a
go XHsBindsLR{} = String -> BMap a
forall a. String -> a
missingSyntax String
"XHsBindsLR"
      go (FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg HsWrapper
_ [Tickish Id]
_) = BMap a
m { bmFunBind :: MGMap a
bmFunBind = AlphaEnv -> Quantifiers -> Key MGMap -> A a -> MGMap a -> MGMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs MatchGroup GhcPs (LHsExpr GhcPs)
Key MGMap
mg A a
f (BMap a -> MGMap a
forall a. BMap a -> MGMap a
bmFunBind BMap a
m) }
      go (VarBind XVarBind GhcPs GhcPs
_ IdP GhcPs
_ LHsExpr GhcPs
e Bool
_) = BMap a
m { bmVarBind :: EMap a
bmVarBind = 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 LHsExpr GhcPs
Key EMap
e A a
f (BMap a -> EMap a
forall a. BMap a -> EMap a
bmVarBind BMap a
m) }
#else
      go (FunBind _ _ mg _) = m { bmFunBind = mAlter env vs mg f (bmFunBind m) }
      go (VarBind _ _ e) = m { bmVarBind = mAlter env vs e f (bmVarBind m) }
#endif
      go (PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
lhs GRHSs GhcPs (LHsExpr GhcPs)
rhs ([Tickish Id], [[Tickish Id]])
_) =
        BMap a
m { bmPatBind :: PatMap (GRHSSMap a)
bmPatBind = AlphaEnv
-> Quantifiers
-> Key PatMap
-> A (GRHSSMap a)
-> PatMap (GRHSSMap a)
-> PatMap (GRHSSMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LPat GhcPs
Key PatMap
lhs
              ((GRHSSMap a -> GRHSSMap a) -> A (GRHSSMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA ((GRHSSMap a -> GRHSSMap a) -> A (GRHSSMap a))
-> (GRHSSMap a -> GRHSSMap a) -> A (GRHSSMap a)
forall a b. (a -> b) -> a -> b
$ 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 GRHSs GhcPs (LHsExpr GhcPs)
Key GRHSSMap
rhs A a
f) (BMap a -> PatMap (GRHSSMap a)
forall a. BMap a -> PatMap (GRHSSMap a)
bmPatBind BMap a
m) }
      go AbsBinds{} = String -> BMap a
forall a. String -> a
missingSyntax String
"AbsBinds"
      go PatSynBind{} = String -> BMap a
forall a. String -> a
missingSyntax String
"PatSynBind"

  mMatch :: MatchEnv -> Key BMap -> (Substitution, BMap a) -> [(Substitution, a)]
  mMatch :: 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 :: HsBind GhcPs -> (Substitution, BMap a) -> [(Substitution, a)]
go (FunBind XFunBind GhcPs GhcPs
_ Located (IdP GhcPs)
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg HsWrapper
_ [Tickish Id]
_) = (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 (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 Bool
_) = (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e
#else
      go (FunBind _ _ mg _) = mapFor bmFunBind >=> mMatch env mg
      go (VarBind _ _ e) = mapFor bmVarBind >=> mMatch env e
#endif
      go (PatBind XPatBind GhcPs GhcPs
_ LPat GhcPs
lhs GRHSs GhcPs (LHsExpr GhcPs)
rhs ([Tickish Id], [[Tickish Id]])
_)
        = (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 (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 (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 { SMap a -> EMap a
smLastStmt :: EMap a
       , SMap a -> PatMap (EMap a)
smBindStmt :: PatMap (EMap a)
       , SMap a -> EMap a
smBodyStmt :: EMap a
         -- TODO: the rest
       }
  deriving (a -> SMap b -> SMap a
(a -> b) -> SMap a -> SMap b
(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
<$ :: a -> SMap b -> SMap a
$c<$ :: forall a b. a -> SMap b -> SMap a
fmap :: (a -> b) -> SMap a -> SMap b
$cfmap :: forall a b. (a -> b) -> SMap a -> SMap b
Functor)

emptySMapWrapper :: SMap a
emptySMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty PatMap (EMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty EMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap SMap where
  type Key SMap = LStmt GhcPs (LHsExpr GhcPs)

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

  mUnion :: SMap a -> SMap a -> SMap a
  mUnion :: 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 :: forall a. EMap a -> PatMap (EMap a) -> EMap a -> SMap a
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 :: 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 (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 {}) = StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> SMap a
go (ExprLStmt GhcPs -> SrcSpanLess (ExprLStmt GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ExprLStmt GhcPs
Key SMap
s)
    where
      go :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> SMap a
go (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) = SMap a
m { smBodyStmt :: EMap a
smBodyStmt = 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 LHsExpr GhcPs
Key EMap
e A a
f (SMap a -> EMap a
forall a. SMap a -> EMap a
smBodyStmt SMap a
m) }
      go (LastStmt XLastStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
e Bool
_ SyntaxExpr GhcPs
_)   = SMap a
m { smLastStmt :: EMap a
smLastStmt = 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 LHsExpr GhcPs
Key EMap
e A a
f (SMap a -> EMap a
forall a. SMap a -> EMap a
smLastStmt SMap a
m) }
#if __GLASGOW_HASKELL__ < 900
      go XStmtLR{} = String -> SMap a
forall a. String -> a
missingSyntax String
"XStmtLR"
      go (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LPat GhcPs
p LHsExpr GhcPs
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) =
#else
      go (BindStmt _ p e) =
#endif
        let bs :: [IdP GhcPs]
bs = LPat GhcPs -> [IdP GhcPs]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat GhcPs
p
            env' :: AlphaEnv
env' = (RdrName -> AlphaEnv -> AlphaEnv)
-> AlphaEnv -> [RdrName] -> AlphaEnv
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 :: PatMap (EMap a)
smBindStmt = AlphaEnv
-> Quantifiers
-> Key PatMap
-> A (EMap a)
-> PatMap (EMap a)
-> PatMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LPat GhcPs
Key PatMap
p
                              ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env' Quantifiers
vs' LHsExpr GhcPs
Key EMap
e A a
f)) (SMap a -> PatMap (EMap a)
forall a. SMap a -> PatMap (EMap a)
smBindStmt SMap a
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 :: MatchEnv
-> Key SMap -> (Substitution, SMap a) -> [(Substitution, a)]
mMatch MatchEnv
_   Key SMap
_   (Substitution
_,SMap a
SMEmpty) = []
  mMatch MatchEnv
env Key SMap
s   (Substitution
hs,SMap a
m) = StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-> (Substitution, SMap a) -> [(Substitution, a)]
go (ExprLStmt GhcPs -> SrcSpanLess (ExprLStmt GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ExprLStmt GhcPs
Key SMap
s) (Substitution
hs,SMap a
m)
    where
      go :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-> (Substitution, SMap a) -> [(Substitution, a)]
go (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e
      go (LastStmt XLastStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LHsExpr GhcPs
e 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 (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 (BindStmt XBindStmt GhcPs GhcPs (LHsExpr GhcPs)
_ LPat GhcPs
p LHsExpr GhcPs
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_) =
#else
      go (BindStmt _ p e) =
#endif
        let bs :: [IdP GhcPs]
bs = LPat GhcPs -> [IdP GhcPs]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' LHsExpr GhcPs
Key EMap
e
      go StmtLR GhcPs GhcPs (LHsExpr GhcPs)
_ = [(Substitution, a)]
-> (Substitution, SMap a) -> [(Substitution, a)]
forall a b. a -> b -> a
const [] -- TODO

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

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

emptyTyMapWrapper :: TyMap a
emptyTyMapWrapper :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty VMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (TyMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
  ForallVisMap (ForAllTyMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (TyMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (ListMap TyMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty ListMap TyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TupleSortMap (ListMap TyMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

instance PatternMap TyMap where
  type Key TyMap = LHsType GhcPs

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

  mUnion :: TyMap a -> TyMap a -> TyMap a
  mUnion :: 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 :: 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
    { 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 :: 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 (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 (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcPs
Key TyMap
ty) -- See Note [TyVar Quantifiers]
    where
      go :: HsType GhcPs -> TyMap a
go (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ (L SrcSpan
_ IdP GhcPs
v))
        | IdP GhcPs
RdrName
v RdrName -> Quantifiers -> Bool
`isQ` Quantifiers
vs = TyMap a
m { tyHole :: Map RdrName a
tyHole    = AlphaEnv
-> Quantifiers
-> Key (Map RdrName)
-> A a
-> Map RdrName a
-> Map RdrName a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs IdP GhcPs
Key (Map RdrName)
v A a
f (TyMap a -> Map RdrName a
forall a. TyMap a -> Map RdrName a
tyHole TyMap a
m) }
        | Bool
otherwise  = TyMap a
m { tyHsTyVar :: VMap a
tyHsTyVar = 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 IdP GhcPs
Key VMap
v A a
f (TyMap a -> VMap a
forall a. TyMap a -> VMap a
tyHsTyVar TyMap a
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 :: TyMap (TyMap a)
tyHsAppTy = AlphaEnv
-> Quantifiers
-> Key TyMap
-> A (TyMap a)
-> TyMap (TyMap a)
-> TyMap (TyMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
Key TyMap
ty1 ((TyMap a -> TyMap a) -> A (TyMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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 LHsType GhcPs
Key TyMap
ty2 A a
f)) (TyMap a -> TyMap (TyMap a)
forall a. TyMap a -> TyMap (TyMap a)
tyHsAppTy TyMap a
m) }
#if __GLASGOW_HASKELL__ < 810
      go (HsForAllTy _ bndrs ty') = m { tyHsForAllTy = mAlter env vs (map extractBinderInfo bndrs, ty') f (tyHsForAllTy m) }
#elif __GLASGOW_HASKELL__ < 900
      go (HsForAllTy XForAllTy GhcPs
_ ForallVisFlag
vis [LHsTyVarBndr GhcPs]
bndrs LHsType GhcPs
ty') =
        TyMap a
m { tyHsForAllTy :: ForallVisMap (ForAllTyMap a)
tyHsForAllTy = AlphaEnv
-> Quantifiers
-> Key ForallVisMap
-> A (ForAllTyMap a)
-> ForallVisMap (ForAllTyMap a)
-> ForallVisMap (ForAllTyMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (ForallVisFlag
vis ForallVisFlag -> ForallVisFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ForallVisFlag
ForallVis) ((ForAllTyMap a -> ForAllTyMap a) -> A (ForAllTyMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key ForAllTyMap
-> A a
-> ForAllTyMap a
-> ForAllTyMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs ((LHsTyVarBndr GhcPs -> (RdrName, Maybe (LHsType GhcPs)))
-> [LHsTyVarBndr GhcPs] -> [(RdrName, Maybe (LHsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo [LHsTyVarBndr GhcPs]
bndrs, LHsType GhcPs
ty') A a
f)) (TyMap a -> ForallVisMap (ForAllTyMap a)
forall a. TyMap a -> ForallVisMap (ForAllTyMap a)
tyHsForAllTy TyMap a
m) }
#else
      go (HsForAllTy _ vis ty') | (isVisible, bndrs) <- splitVisBinders vis =
        m { tyHsForAllTy = mAlter env vs isVisible (toA (mAlter env vs (bndrs, ty') f)) (tyHsForAllTy m) }
#endif
#if __GLASGOW_HASKELL__ < 900
      go (HsFunTy XFunTy GhcPs
_ LHsType GhcPs
ty1 LHsType GhcPs
ty2) = TyMap a
m { tyHsFunTy :: TyMap (TyMap a)
tyHsFunTy = AlphaEnv
-> Quantifiers
-> Key TyMap
-> A (TyMap a)
-> TyMap (TyMap a)
-> TyMap (TyMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
Key TyMap
ty1 ((TyMap a -> TyMap a) -> A (TyMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (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 LHsType GhcPs
Key TyMap
ty2 A a
f)) (TyMap a -> TyMap (TyMap a)
forall a. TyMap a -> TyMap (TyMap a)
tyHsFunTy TyMap a
m) }
#else
      go (HsFunTy _ _ ty1 ty2) = 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 :: TyMap a
tyHsListTy = 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 LHsType GhcPs
Key TyMap
ty' A a
f (TyMap a -> TyMap a
forall a. TyMap a -> TyMap a
tyHsListTy TyMap a
m) }
      go (HsParTy XParTy GhcPs
_ LHsType GhcPs
ty') = TyMap a
m { tyHsParTy :: TyMap a
tyHsParTy = 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 LHsType GhcPs
Key TyMap
ty' A a
f (TyMap a -> TyMap a
forall a. TyMap a -> TyMap a
tyHsParTy TyMap a
m) }
      go (HsQualTy XQualTy GhcPs
_ (L SrcSpan
_ HsContext GhcPs
cons) LHsType GhcPs
ty') =
        TyMap a
m { tyHsQualTy :: TyMap (ListMap TyMap a)
tyHsQualTy = AlphaEnv
-> Quantifiers
-> Key TyMap
-> A (ListMap TyMap a)
-> TyMap (ListMap TyMap a)
-> TyMap (ListMap TyMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsType GhcPs
Key TyMap
ty' ((ListMap TyMap a -> ListMap TyMap a) -> A (ListMap TyMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (ListMap TyMap)
-> A a
-> ListMap TyMap a
-> ListMap TyMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsContext GhcPs
Key (ListMap TyMap)
cons A a
f)) (TyMap a -> TyMap (ListMap TyMap a)
forall a. TyMap a -> TyMap (ListMap TyMap a)
tyHsQualTy TyMap a
m) }
      go HsStarTy{} = String -> TyMap a
forall a. String -> a
missingSyntax String
"HsStarTy"
      go (HsSumTy XSumTy GhcPs
_ HsContext GhcPs
tys) = TyMap a
m { tyHsSumTy :: ListMap TyMap a
tyHsSumTy = AlphaEnv
-> Quantifiers
-> Key (ListMap TyMap)
-> A a
-> ListMap TyMap a
-> ListMap TyMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsContext GhcPs
Key (ListMap TyMap)
tys A a
f (TyMap a -> ListMap TyMap a
forall a. TyMap a -> ListMap TyMap a
tyHsSumTy TyMap a
m) }
      go (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
ts HsContext GhcPs
tys) =
        TyMap a
m { tyHsTupleTy :: TupleSortMap (ListMap TyMap a)
tyHsTupleTy = AlphaEnv
-> Quantifiers
-> Key TupleSortMap
-> A (ListMap TyMap a)
-> TupleSortMap (ListMap TyMap a)
-> TupleSortMap (ListMap TyMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsTupleSort
Key TupleSortMap
ts ((ListMap TyMap a -> ListMap TyMap a) -> A (ListMap TyMap a)
forall (m :: * -> *) a. PatternMap m => (m a -> m a) -> A (m a)
toA (AlphaEnv
-> Quantifiers
-> Key (ListMap TyMap)
-> A a
-> ListMap TyMap a
-> ListMap TyMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs HsContext GhcPs
Key (ListMap TyMap)
tys A a
f)) (TyMap a -> TupleSortMap (ListMap TyMap a)
forall a. TyMap a -> TupleSortMap (ListMap TyMap a)
tyHsTupleTy TyMap a
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 :: 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 (LHsType GhcPs -> SrcSpanLess (LHsType GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType 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 -> LHsType GhcPs -> AnnotatedHsType
MatchEnv -> forall a. a -> Annotated a
mePruneA MatchEnv
env LHsType 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 (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 (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 XForAllTy GhcPs
_ ForallVisFlag
vis [LHsTyVarBndr GhcPs]
bndrs LHsType GhcPs
ty') =
        (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (ForallVisFlag
vis ForallVisFlag -> ForallVisFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ForallVisFlag
ForallVis) ((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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ((LHsTyVarBndr GhcPs -> (RdrName, Maybe (LHsType GhcPs)))
-> [LHsTyVarBndr GhcPs] -> [(RdrName, Maybe (LHsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map LHsTyVarBndr GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo [LHsTyVarBndr GhcPs]
bndrs, LHsType GhcPs
ty')
#else
      go (HsForAllTy _ telescope ty') | (isVisible, bndrs) <- splitVisBinders telescope =
        mapFor tyHsForAllTy >=> mMatch env isVisible >=> mMatch env (bndrs, ty')
#endif
#if __GLASGOW_HASKELL__ < 900
      go (HsFunTy XFunTy 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty2
#else
      go (HsFunTy _ _ ty1 ty2) = mapFor tyHsFunTy >=> mMatch env ty1 >=> mMatch env 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty'
      go (HsQualTy XQualTy GhcPs
_ (L SrcSpan
_ HsContext 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 (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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env HsContext GhcPs
Key (ListMap TyMap)
cons
      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 (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 (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 (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
_ Located (IdP 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located 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 :: LHsTyVarBndr GhcPs -> (RdrName, Maybe (LHsType GhcPs))
extractBinderInfo = HsTyVarBndr GhcPs -> (RdrName, Maybe (LHsType GhcPs))
forall pass. HsTyVarBndr pass -> (IdP pass, Maybe (LHsKind pass))
go (HsTyVarBndr GhcPs -> (RdrName, Maybe (LHsType GhcPs)))
-> (LHsTyVarBndr GhcPs -> HsTyVarBndr GhcPs)
-> LHsTyVarBndr GhcPs
-> (RdrName, Maybe (LHsType GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr GhcPs -> HsTyVarBndr GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
  where
    go :: HsTyVarBndr pass -> (IdP pass, Maybe (LHsKind pass))
go (UserTyVar XUserTyVar pass
_ Located (IdP pass)
v) = (Located (IdP pass) -> SrcSpanLess (Located (IdP pass))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP pass)
v, Maybe (LHsKind pass)
forall a. Maybe a
Nothing)
    go (KindedTyVar XKindedTyVar pass
_ Located (IdP pass)
v LHsKind pass
k) = (Located (IdP pass) -> SrcSpanLess (Located (IdP pass))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP pass)
v, LHsKind pass -> Maybe (LHsKind pass)
forall a. a -> Maybe a
Just LHsKind pass
k)
    go XTyVarBndr{} = String -> (IdP pass, Maybe (LHsKind pass))
forall a. String -> a
missingSyntax String
"XTyVarBndr"
#else
splitVisBinders :: HsForAllTelescope GhcPs -> (Bool, [(RdrName, Maybe (LHsKind GhcPs))])
splitVisBinders HsForAllVis{..} = (True, map extractBinderInfo hsf_vis_bndrs)
splitVisBinders HsForAllInvis{..} = (False, map extractBinderInfo hsf_invis_bndrs)

extractBinderInfo :: LHsTyVarBndr flag 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"
#endif

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

newtype RFMap a = RFM { RFMap a -> VMap (EMap a)
rfmField :: VMap (EMap a) }
  deriving (a -> RFMap b -> RFMap a
(a -> b) -> RFMap a -> RFMap b
(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
<$ :: a -> RFMap b -> RFMap a
$c<$ :: forall a b. a -> RFMap b -> RFMap a
fmap :: (a -> b) -> RFMap a -> RFMap b
$cfmap :: forall a b. (a -> b) -> RFMap a -> RFMap b
Functor)

instance PatternMap RFMap where
  type Key RFMap = LHsRecField' RdrName (LHsExpr GhcPs)

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

  mUnion :: RFMap a -> RFMap a -> RFMap a
  mUnion :: 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 (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 :: AlphaEnv -> Quantifiers -> Key RFMap -> A a -> RFMap a -> RFMap a
mAlter AlphaEnv
env Quantifiers
vs Key RFMap
lf A a
f RFMap a
m = HsRecField' RdrName (LHsExpr GhcPs) -> RFMap a
go (LHsRecField' RdrName (LHsExpr GhcPs)
-> SrcSpanLess (LHsRecField' RdrName (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsRecField' RdrName (LHsExpr GhcPs)
Key RFMap
lf)
    where
      go :: HsRecField' RdrName (LHsExpr GhcPs) -> RFMap a
go (HsRecField Located RdrName
lbl LHsExpr GhcPs
arg Bool
_pun) =
        RFMap a
m { rfmField :: VMap (EMap a)
rfmField = AlphaEnv
-> Quantifiers
-> Key VMap
-> A (EMap a)
-> VMap (EMap a)
-> VMap (EMap a)
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
lbl) ((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 (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs LHsExpr GhcPs
Key EMap
arg A a
f)) (RFMap a -> VMap (EMap a)
forall a. RFMap a -> VMap (EMap a)
rfmField RFMap a
m) }

  mMatch :: MatchEnv -> Key RFMap -> (Substitution, RFMap a) -> [(Substitution, a)]
  mMatch :: MatchEnv
-> Key RFMap -> (Substitution, RFMap a) -> [(Substitution, a)]
mMatch MatchEnv
env Key RFMap
lf (Substitution
hs,RFMap a
m) = HsRecField' RdrName (LHsExpr GhcPs)
-> (Substitution, RFMap a) -> [(Substitution, a)]
go (LHsRecField' RdrName (LHsExpr GhcPs)
-> SrcSpanLess (LHsRecField' RdrName (LHsExpr GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsRecField' RdrName (LHsExpr GhcPs)
Key RFMap
lf) (Substitution
hs,RFMap a
m)
    where
      go :: HsRecField' RdrName (LHsExpr GhcPs)
-> (Substitution, RFMap a) -> [(Substitution, a)]
go (HsRecField Located RdrName
lbl LHsExpr 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
arg

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

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

instance RecordFieldToRdrName (FieldOcc p) where
  recordFieldToRdrName :: FieldOcc p -> RdrName
recordFieldToRdrName = Located RdrName -> RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located RdrName -> RdrName)
-> (FieldOcc p -> Located RdrName) -> FieldOcc p -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc p -> Located RdrName
forall pass. FieldOcc pass -> Located RdrName
rdrNameFieldOcc

fieldsToRdrNames
  :: RecordFieldToRdrName f
  => [LHsRecField' f arg]
  -> [LHsRecField' RdrName arg]
fieldsToRdrNames :: [LHsRecField' f arg] -> [LHsRecField' RdrName arg]
fieldsToRdrNames = (LHsRecField' f arg -> LHsRecField' RdrName arg)
-> [LHsRecField' f arg] -> [LHsRecField' RdrName arg]
forall a b. (a -> b) -> [a] -> [b]
map LHsRecField' f arg -> LHsRecField' RdrName arg
forall f l arg.
RecordFieldToRdrName f =>
GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go
  where
    go :: GenLocated l (HsRecField' f arg)
-> GenLocated l (HsRecField' RdrName arg)
go (L l
l (HsRecField (L SrcSpan
l2 f
f) arg
arg Bool
pun)) =
      l
-> HsRecField' RdrName arg
-> GenLocated l (HsRecField' RdrName arg)
forall l e. l -> e -> GenLocated l e
L l
l (Located RdrName -> arg -> Bool -> HsRecField' RdrName arg
forall id arg. Located id -> arg -> Bool -> HsRecField' id arg
HsRecField (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l2 (f -> RdrName
forall f. RecordFieldToRdrName f => f -> RdrName
recordFieldToRdrName f
f)) arg
arg Bool
pun)

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

data TupleSortMap a = TupleSortMap
  { TupleSortMap a -> MaybeMap a
tsUnboxed :: MaybeMap a
  , TupleSortMap a -> MaybeMap a
tsBoxed :: MaybeMap a
  , TupleSortMap a -> MaybeMap a
tsConstraint :: MaybeMap a
  , TupleSortMap a -> MaybeMap a
tsBoxedOrConstraint :: MaybeMap a
  }
  deriving (a -> TupleSortMap b -> TupleSortMap a
(a -> b) -> TupleSortMap a -> TupleSortMap b
(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
<$ :: a -> TupleSortMap b -> TupleSortMap a
$c<$ :: forall a b. a -> TupleSortMap b -> TupleSortMap a
fmap :: (a -> b) -> TupleSortMap a -> TupleSortMap b
$cfmap :: forall a b. (a -> b) -> TupleSortMap a -> TupleSortMap b
Functor)

instance PatternMap TupleSortMap where
  type Key TupleSortMap = HsTupleSort

  mEmpty :: TupleSortMap a
  mEmpty :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty MaybeMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

  mUnion :: TupleSortMap a -> TupleSortMap a -> TupleSortMap a
  mUnion :: TupleSortMap a -> TupleSortMap a -> TupleSortMap a
mUnion TupleSortMap a
m1 TupleSortMap a
m2 = TupleSortMap :: forall a.
MaybeMap a
-> MaybeMap a -> MaybeMap a -> MaybeMap a -> TupleSortMap a
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 :: AlphaEnv
-> Quantifiers
-> Key TupleSortMap
-> A a
-> TupleSortMap a
-> TupleSortMap a
mAlter AlphaEnv
env Quantifiers
vs Key TupleSortMap
HsUnboxedTuple A a
f TupleSortMap a
m =
    TupleSortMap a
m { tsUnboxed :: MaybeMap a
tsUnboxed = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsUnboxed TupleSortMap a
m) }
  mAlter AlphaEnv
env Quantifiers
vs Key TupleSortMap
HsBoxedTuple A a
f TupleSortMap a
m =
    TupleSortMap a
m { tsBoxed :: MaybeMap a
tsBoxed = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsBoxed TupleSortMap a
m) }
  mAlter AlphaEnv
env Quantifiers
vs Key TupleSortMap
HsConstraintTuple A a
f TupleSortMap a
m =
    TupleSortMap a
m { tsConstraint :: MaybeMap a
tsConstraint = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsConstraint TupleSortMap a
m) }
  mAlter AlphaEnv
env Quantifiers
vs Key TupleSortMap
HsBoxedOrConstraintTuple A a
f TupleSortMap a
m =
    TupleSortMap a
m { tsBoxedOrConstraint :: MaybeMap a
tsBoxedOrConstraint = AlphaEnv
-> Quantifiers -> Key MaybeMap -> A a -> MaybeMap a -> MaybeMap a
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> A a -> m a -> m a
mAlter AlphaEnv
env Quantifiers
vs () A a
f (TupleSortMap a -> MaybeMap a
forall a. TupleSortMap a -> MaybeMap a
tsBoxedOrConstraint TupleSortMap a
m) }

  mMatch :: MatchEnv -> Key TupleSortMap -> (Substitution, TupleSortMap a) -> [(Substitution, a)]
  mMatch :: MatchEnv
-> Key TupleSortMap
-> (Substitution, TupleSortMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
  mMatch MatchEnv
env Key TupleSortMap
HsBoxedTuple = (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
tsBoxed ((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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
  mMatch MatchEnv
env Key TupleSortMap
HsConstraintTuple = (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
tsConstraint ((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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env ()
  mMatch MatchEnv
env 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 (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
  { ForAllTyMap a -> TyMap a
fatNil :: TyMap a
  , ForAllTyMap a -> ForAllTyMap a
fatUser :: ForAllTyMap a
  , ForAllTyMap a -> TyMap (ForAllTyMap a)
fatKinded :: TyMap (ForAllTyMap a)
  }
  deriving (a -> ForAllTyMap b -> ForAllTyMap a
(a -> b) -> ForAllTyMap a -> ForAllTyMap b
(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
<$ :: a -> ForAllTyMap b -> ForAllTyMap a
$c<$ :: forall a b. a -> ForAllTyMap b -> ForAllTyMap a
fmap :: (a -> b) -> ForAllTyMap a -> ForAllTyMap b
$cfmap :: forall a b. (a -> b) -> ForAllTyMap a -> ForAllTyMap b
Functor)

instance PatternMap ForAllTyMap where
  type Key ForAllTyMap = ([(RdrName, Maybe (LHsKind GhcPs))], LHsType GhcPs)

  mEmpty :: ForAllTyMap a
  mEmpty :: 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 (m :: * -> *) a. PatternMap m => m a
mEmpty ForAllTyMap a
forall (m :: * -> *) a. PatternMap m => m a
mEmpty TyMap (ForAllTyMap a)
forall (m :: * -> *) a. PatternMap m => m a
mEmpty

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

  mMatch :: MatchEnv -> Key ForAllTyMap -> (Substitution, ForAllTyMap a) -> [(Substitution, a)]
  mMatch :: MatchEnv
-> Key ForAllTyMap
-> (Substitution, ForAllTyMap a)
-> [(Substitution, a)]
mMatch MatchEnv
env ([],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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
ty
  mMatch MatchEnv
env ((v,mbK):rest, ty)
    | Just LHsType GhcPs
k <- Maybe (LHsType 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ([(RdrName, Maybe (LHsType GhcPs))]
rest, LHsType 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env' ([(RdrName, Maybe (LHsType GhcPs))]
rest, LHsType GhcPs
ty)
    where
      env' :: MatchEnv
env' = MatchEnv -> [RdrName] -> MatchEnv
extendMatchEnv MatchEnv
env [RdrName
v]

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

instance PatternMap ForallVisMap where
  type Key ForallVisMap = Bool

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

  mUnion :: ForallVisMap a -> ForallVisMap a -> ForallVisMap a
  mUnion :: 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 :: 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 (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 :: 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 (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env Key BoolMap
Key ForallVisMap
b
#endif