-- 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 DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Retrie.Universe
  ( Universe
  , printU
  , Matchable(..)
  , UMap(..)
  ) where

import Control.Monad
import Data.Data

import Retrie.AlphaEnv
import Retrie.ExactPrint
import Retrie.GHC
import Retrie.PatternMap.Class
import Retrie.PatternMap.Instances
import Retrie.Quantifiers
import Retrie.Substitution

-- | A sum type to collect all possible top-level rewritable types.
data Universe
  = ULHsExpr (LHsExpr GhcPs)
  | ULStmt (LStmt GhcPs (LHsExpr GhcPs))
  | ULType (LHsType GhcPs)
  | ULPat (LPat GhcPs)
  deriving (Typeable Universe
Typeable Universe =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Universe -> c Universe)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Universe)
-> (Universe -> Constr)
-> (Universe -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Universe))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Universe))
-> ((forall b. Data b => b -> b) -> Universe -> Universe)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Universe -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Universe -> r)
-> (forall u. (forall d. Data d => d -> u) -> Universe -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Universe -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Universe -> m Universe)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Universe -> m Universe)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Universe -> m Universe)
-> Data Universe
Universe -> Constr
Universe -> DataType
(forall b. Data b => b -> b) -> Universe -> Universe
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Universe -> u
forall u. (forall d. Data d => d -> u) -> Universe -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Universe -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Universe -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Universe
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Universe -> c Universe
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Universe)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Universe)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Universe -> c Universe
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Universe -> c Universe
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Universe
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Universe
$ctoConstr :: Universe -> Constr
toConstr :: Universe -> Constr
$cdataTypeOf :: Universe -> DataType
dataTypeOf :: Universe -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Universe)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Universe)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Universe)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Universe)
$cgmapT :: (forall b. Data b => b -> b) -> Universe -> Universe
gmapT :: (forall b. Data b => b -> b) -> Universe -> Universe
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Universe -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Universe -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Universe -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Universe -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Universe -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Universe -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Universe -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Universe -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Universe -> m Universe
Data)

-- | Exactprint an annotated 'Universe'.
printU :: Annotated Universe -> String
printU :: Annotated Universe -> String
printU Annotated Universe
u = Universe -> String
exactPrintU (Annotated Universe -> Universe
forall ast. Annotated ast -> ast
astA Annotated Universe
u)
    String -> String -> String
forall c. c -> String -> c
`debug` (String
"printU:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Universe -> String
forall a. Data a => a -> String
showAst (Annotated Universe -> Universe
forall ast. Annotated ast -> ast
astA Annotated Universe
u))

-- | Primitive exactprint for 'Universe'.
exactPrintU :: Universe -> String
exactPrintU :: Universe -> String
exactPrintU (ULHsExpr LHsExpr GhcPs
e) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall ast. ExactPrint ast => ast -> String
exactPrint LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
exactPrintU (ULStmt LStmt GhcPs (LHsExpr GhcPs)
s) = GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> String
forall ast. ExactPrint ast => ast -> String
exactPrint LStmt GhcPs (LHsExpr GhcPs)
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
s
exactPrintU (ULType LHsType GhcPs
t) = GenLocated SrcSpanAnnA (HsType GhcPs) -> String
forall ast. ExactPrint ast => ast -> String
exactPrint LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
exactPrintU (ULPat LPat GhcPs
p) = GenLocated SrcSpanAnnA (Pat GhcPs) -> String
forall ast. ExactPrint ast => ast -> String
exactPrint LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p

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

-- | Class of types which can be injected into the 'Universe' type.
class Matchable ast where
  -- | Inject an AST into 'Universe'
  inject :: ast -> Universe

  -- | Project an AST from a 'Universe'.
  -- Can fail if universe contains the wrong type.
  project :: Universe -> ast

  -- | Get the original location of the AST.
  getOrigin :: ast -> SrcSpan

instance Matchable Universe where
  inject :: Universe -> Universe
inject = Universe -> Universe
forall a. a -> a
id
  project :: Universe -> Universe
project = Universe -> Universe
forall a. a -> a
id
  getOrigin :: Universe -> SrcSpan
getOrigin (ULHsExpr LHsExpr GhcPs
e) = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall ast. Matchable ast => ast -> SrcSpan
getOrigin LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
  getOrigin (ULStmt LStmt GhcPs (LHsExpr GhcPs)
s) = GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall ast. Matchable ast => ast -> SrcSpan
getOrigin LStmt GhcPs (LHsExpr GhcPs)
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
s
  getOrigin (ULType LHsType GhcPs
t) = GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall ast. Matchable ast => ast -> SrcSpan
getOrigin LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
  getOrigin (ULPat LPat GhcPs
p) = GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall ast. Matchable ast => ast -> SrcSpan
getOrigin LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p

instance Matchable (LocatedA (HsExpr GhcPs)) where
  inject :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Universe
inject = LHsExpr GhcPs -> Universe
GenLocated SrcSpanAnnA (HsExpr GhcPs) -> Universe
ULHsExpr
  project :: Universe -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
project (ULHsExpr LHsExpr GhcPs
x) = LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
x
  project Universe
_ = String -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
forall a. HasCallStack => String -> a
error String
"project LHsExpr"
  getOrigin :: GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
getOrigin GenLocated SrcSpanAnnA (HsExpr GhcPs)
e = GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsExpr GhcPs)
e

instance Matchable (LocatedA (Stmt GhcPs (LocatedA (HsExpr GhcPs)))) where
  inject :: GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Universe
inject = LStmt GhcPs (LHsExpr GhcPs) -> Universe
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> Universe
ULStmt
  project :: Universe
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
project (ULStmt LStmt GhcPs (LHsExpr GhcPs)
x) = LStmt GhcPs (LHsExpr GhcPs)
GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
x
  project Universe
_ = String
-> GenLocated
     SrcSpanAnnA
     (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall a. HasCallStack => String -> a
error String
"project LStmt"
  getOrigin :: GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
getOrigin GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
e = GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated
  SrcSpanAnnA
  (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
e

instance Matchable (LocatedA (HsType GhcPs)) where
  inject :: GenLocated SrcSpanAnnA (HsType GhcPs) -> Universe
inject = LHsType GhcPs -> Universe
GenLocated SrcSpanAnnA (HsType GhcPs) -> Universe
ULType
  project :: Universe -> GenLocated SrcSpanAnnA (HsType GhcPs)
project (ULType LHsType GhcPs
t) = LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
t
  project Universe
_ = String -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a. HasCallStack => String -> a
error String
"project ULType"
  getOrigin :: GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
getOrigin GenLocated SrcSpanAnnA (HsType GhcPs)
e = GenLocated SrcSpanAnnA (HsType GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsType GhcPs)
e

instance Matchable (LocatedA (Pat GhcPs)) where
  inject :: GenLocated SrcSpanAnnA (Pat GhcPs) -> Universe
inject = LPat GhcPs -> Universe
GenLocated SrcSpanAnnA (Pat GhcPs) -> Universe
ULPat
  project :: Universe -> GenLocated SrcSpanAnnA (Pat GhcPs)
project (ULPat LPat GhcPs
p) = LPat GhcPs
GenLocated SrcSpanAnnA (Pat GhcPs)
p
  project Universe
_ = String -> GenLocated SrcSpanAnnA (Pat GhcPs)
forall a. HasCallStack => String -> a
error String
"project ULPat"
  getOrigin :: GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
getOrigin = GenLocated SrcSpanAnnA (Pat GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA

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

-- | The pattern map for 'Universe'.
data UMap a = UMap
  { forall a. UMap a -> EMap a
umExpr :: EMap a
  , forall a. UMap a -> SMap a
umStmt :: SMap a
  , forall a. UMap a -> TyMap a
umType :: TyMap a
  , forall a. UMap a -> PatMap a
umPat  :: PatMap a
  }
  deriving ((forall a b. (a -> b) -> UMap a -> UMap b)
-> (forall a b. a -> UMap b -> UMap a) -> Functor UMap
forall a b. a -> UMap b -> UMap a
forall a b. (a -> b) -> UMap a -> UMap b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> UMap a -> UMap b
fmap :: forall a b. (a -> b) -> UMap a -> UMap b
$c<$ :: forall a b. a -> UMap b -> UMap a
<$ :: forall a b. a -> UMap b -> UMap a
Functor)

instance PatternMap UMap where
  type Key UMap = Universe

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

  mUnion :: UMap a -> UMap a -> UMap a
  mUnion :: forall a. UMap a -> UMap a -> UMap a
mUnion UMap a
m1 UMap a
m2 = EMap a -> SMap a -> TyMap a -> PatMap a -> UMap a
forall a. EMap a -> SMap a -> TyMap a -> PatMap a -> UMap a
UMap
    ((UMap a -> EMap a) -> UMap a -> UMap a -> EMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn UMap a -> EMap a
forall a. UMap a -> EMap a
umExpr UMap a
m1 UMap a
m2)
    ((UMap a -> SMap a) -> UMap a -> UMap a -> SMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn UMap a -> SMap a
forall a. UMap a -> SMap a
umStmt UMap a
m1 UMap a
m2)
    ((UMap a -> TyMap a) -> UMap a -> UMap a -> TyMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn UMap a -> TyMap a
forall a. UMap a -> TyMap a
umType UMap a
m1 UMap a
m2)
    ((UMap a -> PatMap a) -> UMap a -> UMap a -> PatMap a
forall (m :: * -> *) a b.
PatternMap m =>
(a -> m b) -> a -> a -> m b
unionOn UMap a -> PatMap a
forall a. UMap a -> PatMap a
umPat UMap a
m1 UMap a
m2)

  mAlter :: AlphaEnv -> Quantifiers -> Universe -> A a -> UMap a -> UMap a
  mAlter :: forall a.
AlphaEnv -> Quantifiers -> Universe -> A a -> UMap a -> UMap a
mAlter AlphaEnv
env Quantifiers
vs Universe
u A a
f UMap a
m = Universe -> UMap a
go Universe
u
    where
      go :: Universe -> UMap a
go (ULHsExpr LHsExpr GhcPs
e) = UMap a
m { umExpr = mAlter env vs e f (umExpr m) }
      go (ULStmt LStmt GhcPs (LHsExpr GhcPs)
s) = UMap a
m { umStmt = mAlter env vs s f (umStmt m) }
      go (ULType LHsType GhcPs
t) = UMap a
m { umType = mAlter env vs t f (umType m) }
      go (ULPat LPat GhcPs
p) = UMap a
m { umPat  = mAlter env vs (cLPat p) f (umPat m) }

  mMatch :: MatchEnv -> Universe -> (Substitution, UMap a) -> [(Substitution, a)]
  mMatch :: forall a.
MatchEnv
-> Universe -> (Substitution, UMap a) -> [(Substitution, a)]
mMatch MatchEnv
env = Universe -> (Substitution, UMap a) -> [(Substitution, a)]
go
    where
      go :: Universe -> (Substitution, UMap a) -> [(Substitution, a)]
go (ULHsExpr LHsExpr GhcPs
e) = (UMap a -> EMap a)
-> (Substitution, UMap a) -> [(Substitution, EMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor UMap a -> EMap a
forall a. UMap a -> EMap a
umExpr ((Substitution, UMap a) -> [(Substitution, EMap a)])
-> ((Substitution, EMap a) -> [(Substitution, a)])
-> (Substitution, UMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key EMap -> (Substitution, EMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsExpr GhcPs
Key EMap
e
      go (ULStmt LStmt GhcPs (LHsExpr GhcPs)
s) = (UMap a -> SMap a)
-> (Substitution, UMap a) -> [(Substitution, SMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor UMap a -> SMap a
forall a. UMap a -> SMap a
umStmt ((Substitution, UMap a) -> [(Substitution, SMap a)])
-> ((Substitution, SMap a) -> [(Substitution, a)])
-> (Substitution, UMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key SMap -> (Substitution, SMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key SMap -> (Substitution, SMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LStmt GhcPs (LHsExpr GhcPs)
Key SMap
s
      go (ULType LHsType GhcPs
t) = (UMap a -> TyMap a)
-> (Substitution, UMap a) -> [(Substitution, TyMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor UMap a -> TyMap a
forall a. UMap a -> TyMap a
umType ((Substitution, UMap a) -> [(Substitution, TyMap a)])
-> ((Substitution, TyMap a) -> [(Substitution, a)])
-> (Substitution, UMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key TyMap -> (Substitution, TyMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env LHsType GhcPs
Key TyMap
t
      go (ULPat LPat GhcPs
p) = (UMap a -> PatMap a)
-> (Substitution, UMap a) -> [(Substitution, PatMap a)]
forall b c a. (b -> c) -> (a, b) -> [(a, c)]
mapFor UMap a -> PatMap a
forall a. UMap a -> PatMap a
umPat ((Substitution, UMap a) -> [(Substitution, PatMap a)])
-> ((Substitution, PatMap a) -> [(Substitution, a)])
-> (Substitution, UMap a)
-> [(Substitution, a)]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall a.
MatchEnv
-> Key PatMap -> (Substitution, PatMap a) -> [(Substitution, a)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> (Substitution, m a) -> [(Substitution, a)]
mMatch MatchEnv
env (LPat GhcPs -> LPat GhcPs
forall (p :: Pass). LPat (GhcPass p) -> LPat (GhcPass p)
cLPat LPat GhcPs
p)