{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Retrie.Types
( Direction(..)
, Query(..)
, Matcher(..)
, mkMatcher
, mkLocalMatcher
, runMatcher
, Rewrite
, mkRewrite
, Rewriter
, mkRewriter
, mkLocalRewriter
, runRewriter
, MatchResult(..)
, Template(..)
, MatchResultTransformer
, defaultTransformer
, addRewriteImports
, setRewriteTransformer
, toURewrite
, fromURewrite
, ppRewrite
, rewritesWithDependents
, RewriterResult(..)
, ParentPrec(..)
, Context(..)
) where
import Control.Monad.IO.Class
import Control.Monad.State
import Data.Bifunctor
import qualified Data.IntMap.Strict as I
import Data.Maybe
import Retrie.AlphaEnv
import Retrie.ExactPrint
import Retrie.Fixity
import Retrie.GHC
import Retrie.PatternMap.Class
import Retrie.Quantifiers
import Retrie.Substitution
import Retrie.Universe
data Context = Context
{ Context -> [RdrName]
ctxtBinders :: [RdrName]
, Context -> Rewriter
ctxtDependents :: Rewriter
, Context -> FixityEnv
ctxtFixityEnv :: FixityEnv
, Context -> AlphaEnv
ctxtInScope :: AlphaEnv
, Context -> ParentPrec
ctxtParentPrec :: ParentPrec
, Context -> Rewriter
ctxtRewriter :: Rewriter
, Context -> Maybe Substitution
ctxtSubst :: Maybe Substitution
}
data ParentPrec
= HasPrec Fixity
| IsLhs
| IsHsAppsTy
| NeverParen
data Direction = LeftToRight | RightToLeft
deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq)
data Query ast v = Query
{ Query ast v -> Quantifiers
qQuantifiers :: Quantifiers
, Query ast v -> Annotated ast
qPattern :: Annotated ast
, Query ast v -> v
qResult :: v
}
instance Functor (Query ast) where
fmap :: (a -> b) -> Query ast a -> Query ast b
fmap a -> b
f (Query Quantifiers
qs Annotated ast
ast a
v) = Quantifiers -> Annotated ast -> b -> Query ast b
forall ast v. Quantifiers -> Annotated ast -> v -> Query ast v
Query Quantifiers
qs Annotated ast
ast (a -> b
f a
v)
instance Bifunctor Query where
bimap :: (a -> b) -> (c -> d) -> Query a c -> Query b d
bimap a -> b
f c -> d
g (Query Quantifiers
qs Annotated a
ast c
v) = Quantifiers -> Annotated b -> d -> Query b d
forall ast v. Quantifiers -> Annotated ast -> v -> Query ast v
Query Quantifiers
qs ((a -> b) -> Annotated a -> Annotated b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Annotated a
ast) (c -> d
g c
v)
newtype Matcher a = Matcher (I.IntMap (UMap a))
deriving (a -> Matcher b -> Matcher a
(a -> b) -> Matcher a -> Matcher b
(forall a b. (a -> b) -> Matcher a -> Matcher b)
-> (forall a b. a -> Matcher b -> Matcher a) -> Functor Matcher
forall a b. a -> Matcher b -> Matcher a
forall a b. (a -> b) -> Matcher a -> Matcher b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Matcher b -> Matcher a
$c<$ :: forall a b. a -> Matcher b -> Matcher a
fmap :: (a -> b) -> Matcher a -> Matcher b
$cfmap :: forall a b. (a -> b) -> Matcher a -> Matcher b
Functor)
instance Semigroup (Matcher a) where
<> :: Matcher a -> Matcher a -> Matcher a
(<>) = Matcher a -> Matcher a -> Matcher a
forall a. Monoid a => a -> a -> a
mappend
instance Monoid (Matcher a) where
mempty :: Matcher a
mempty = IntMap (UMap a) -> Matcher a
forall a. IntMap (UMap a) -> Matcher a
Matcher IntMap (UMap a)
forall a. IntMap a
I.empty
mappend :: Matcher a -> Matcher a -> Matcher a
mappend (Matcher IntMap (UMap a)
m1) (Matcher IntMap (UMap a)
m2) = IntMap (UMap a) -> Matcher a
forall a. IntMap (UMap a) -> Matcher a
Matcher ((UMap a -> UMap a -> UMap a)
-> IntMap (UMap a) -> IntMap (UMap a) -> IntMap (UMap a)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
I.unionWith UMap a -> UMap a -> UMap a
forall (m :: * -> *) a. PatternMap m => m a -> m a -> m a
mUnion IntMap (UMap a)
m1 IntMap (UMap a)
m2)
mkMatcher :: Matchable ast => Query ast v -> Matcher v
mkMatcher :: Query ast v -> Matcher v
mkMatcher = AlphaEnv -> Query ast v -> Matcher v
forall ast v. Matchable ast => AlphaEnv -> Query ast v -> Matcher v
mkLocalMatcher AlphaEnv
emptyAlphaEnv
mkLocalMatcher :: Matchable ast => AlphaEnv -> Query ast v -> Matcher v
mkLocalMatcher :: AlphaEnv -> Query ast v -> Matcher v
mkLocalMatcher AlphaEnv
env Query{v
Quantifiers
Annotated ast
qResult :: v
qPattern :: Annotated ast
qQuantifiers :: Quantifiers
qResult :: forall ast v. Query ast v -> v
qPattern :: forall ast v. Query ast v -> Annotated ast
qQuantifiers :: forall ast v. Query ast v -> Quantifiers
..} = IntMap (UMap v) -> Matcher v
forall a. IntMap (UMap a) -> Matcher a
Matcher (IntMap (UMap v) -> Matcher v) -> IntMap (UMap v) -> Matcher v
forall a b. (a -> b) -> a -> b
$
Key -> UMap v -> IntMap (UMap v)
forall a. Key -> a -> IntMap a
I.singleton (AlphaEnv -> Key
alphaEnvOffset AlphaEnv
env) (UMap v -> IntMap (UMap v)) -> UMap v -> IntMap (UMap v)
forall a b. (a -> b) -> a -> b
$
AlphaEnv -> Quantifiers -> Key UMap -> v -> UMap v -> UMap v
forall (m :: * -> *) a.
PatternMap m =>
AlphaEnv -> Quantifiers -> Key m -> a -> m a -> m a
insertMatch
AlphaEnv
emptyAlphaEnv
Quantifiers
qQuantifiers
(ast -> Universe
forall ast. Matchable ast => ast -> Universe
inject (ast -> Universe) -> ast -> Universe
forall a b. (a -> b) -> a -> b
$ Annotated ast -> ast
forall ast. Annotated ast -> ast
astA Annotated ast
qPattern)
v
qResult
UMap v
forall (m :: * -> *) a. PatternMap m => m a
mEmpty
runMatcher
:: (Matchable ast, MonadIO m)
=> Context
-> Matcher v
-> ast
-> TransformT m [(Substitution, v)]
runMatcher :: Context -> Matcher v -> ast -> TransformT m [(Substitution, v)]
runMatcher Context{[RdrName]
Maybe Substitution
FixityEnv
AlphaEnv
Rewriter
ParentPrec
ctxtSubst :: Maybe Substitution
ctxtRewriter :: Rewriter
ctxtParentPrec :: ParentPrec
ctxtInScope :: AlphaEnv
ctxtFixityEnv :: FixityEnv
ctxtDependents :: Rewriter
ctxtBinders :: [RdrName]
ctxtSubst :: Context -> Maybe Substitution
ctxtRewriter :: Context -> Rewriter
ctxtParentPrec :: Context -> ParentPrec
ctxtInScope :: Context -> AlphaEnv
ctxtFixityEnv :: Context -> FixityEnv
ctxtDependents :: Context -> Rewriter
ctxtBinders :: Context -> [RdrName]
..} (Matcher IntMap (UMap v)
m) ast
ast = do
(Anns
anns, Key
seed) <- TransformT m (Anns, Key)
forall s (m :: * -> *). MonadState s m => m s
get
let
matchEnv :: MatchEnv
matchEnv = AlphaEnv -> (forall a. a -> Annotated a) -> MatchEnv
ME AlphaEnv
ctxtInScope (\a
x -> a -> Anns -> Key -> Annotated a
forall ast. ast -> Anns -> Key -> Annotated ast
unsafeMkA a
x Anns
anns Key
seed)
uast :: Universe
uast = ast -> Universe
forall ast. Matchable ast => ast -> Universe
inject ast
ast
[(Substitution, v)] -> TransformT m [(Substitution, v)]
forall (m :: * -> *) a. Monad m => a -> m a
return
[ (Substitution, v)
match
| (Key
lvl, UMap v
umap) <- IntMap (UMap v) -> [(Key, UMap v)]
forall a. IntMap a -> [(Key, a)]
I.toAscList IntMap (UMap v)
m
, (Substitution, v)
match <- MatchEnv -> Key UMap -> UMap v -> [(Substitution, v)]
forall (m :: * -> *) a.
PatternMap m =>
MatchEnv -> Key m -> m a -> [(Substitution, a)]
findMatch (Key -> MatchEnv -> MatchEnv
pruneMatchEnv Key
lvl MatchEnv
matchEnv) Key UMap
Universe
uast UMap v
umap
]
type Rewrite ast = Query ast (Template ast, MatchResultTransformer)
mkRewrite :: Quantifiers -> Annotated ast -> Annotated ast -> Rewrite ast
mkRewrite :: Quantifiers -> Annotated ast -> Annotated ast -> Rewrite ast
mkRewrite Quantifiers
qQuantifiers Annotated ast
qPattern Annotated ast
tTemplate = Query :: forall ast v. Quantifiers -> Annotated ast -> v -> Query ast v
Query{(Template ast, MatchResultTransformer)
Quantifiers
Annotated ast
qResult :: (Template ast, MatchResultTransformer)
qPattern :: Annotated ast
qQuantifiers :: Quantifiers
qResult :: (Template ast, MatchResultTransformer)
qPattern :: Annotated ast
qQuantifiers :: Quantifiers
..}
where
tImports :: AnnotatedImports
tImports = AnnotatedImports
forall a. Monoid a => a
mempty
tDependents :: Maybe a
tDependents = Maybe a
forall a. Maybe a
Nothing
qResult :: (Template ast, MatchResultTransformer)
qResult = (Template :: forall ast.
Annotated ast
-> AnnotatedImports -> Maybe [Rewrite Universe] -> Template ast
Template{Maybe [Rewrite Universe]
Annotated ast
AnnotatedImports
forall a. Maybe a
tDependents :: Maybe [Rewrite Universe]
tImports :: AnnotatedImports
tTemplate :: Annotated ast
tDependents :: forall a. Maybe a
tImports :: AnnotatedImports
tTemplate :: Annotated ast
..}, MatchResultTransformer
defaultTransformer)
addRewriteImports :: AnnotatedImports -> Rewrite ast -> Rewrite ast
addRewriteImports :: AnnotatedImports -> Rewrite ast -> Rewrite ast
addRewriteImports AnnotatedImports
imports Rewrite ast
q = Rewrite ast
q { qResult :: (Template ast, MatchResultTransformer)
qResult = (Template ast
newTemplate, MatchResultTransformer
transformer) }
where
(Template ast
template, MatchResultTransformer
transformer) = Rewrite ast -> (Template ast, MatchResultTransformer)
forall ast v. Query ast v -> v
qResult Rewrite ast
q
newTemplate :: Template ast
newTemplate = Template ast
template { tImports :: AnnotatedImports
tImports = AnnotatedImports
imports AnnotatedImports -> AnnotatedImports -> AnnotatedImports
forall a. Semigroup a => a -> a -> a
<> Template ast -> AnnotatedImports
forall ast. Template ast -> AnnotatedImports
tImports Template ast
template }
setRewriteTransformer :: MatchResultTransformer -> Rewrite ast -> Rewrite ast
setRewriteTransformer :: MatchResultTransformer -> Rewrite ast -> Rewrite ast
setRewriteTransformer MatchResultTransformer
transformer Rewrite ast
q =
Rewrite ast
q { qResult :: (Template ast, MatchResultTransformer)
qResult = (MatchResultTransformer -> MatchResultTransformer)
-> (Template ast, MatchResultTransformer)
-> (Template ast, MatchResultTransformer)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (MatchResultTransformer
-> MatchResultTransformer -> MatchResultTransformer
forall a b. a -> b -> a
const MatchResultTransformer
transformer) (Rewrite ast -> (Template ast, MatchResultTransformer)
forall ast v. Query ast v -> v
qResult Rewrite ast
q) }
type Rewriter = Matcher (RewriterResult Universe)
mkRewriter :: Matchable ast => Rewrite ast -> Rewriter
mkRewriter :: Rewrite ast -> Rewriter
mkRewriter = AlphaEnv -> Rewrite ast -> Rewriter
forall ast. Matchable ast => AlphaEnv -> Rewrite ast -> Rewriter
mkLocalRewriter AlphaEnv
emptyAlphaEnv
mkLocalRewriter :: Matchable ast => AlphaEnv -> Rewrite ast -> Rewriter
mkLocalRewriter :: AlphaEnv -> Rewrite ast -> Rewriter
mkLocalRewriter AlphaEnv
env q :: Rewrite ast
q@Query{(Template ast, MatchResultTransformer)
Quantifiers
Annotated ast
qResult :: (Template ast, MatchResultTransformer)
qPattern :: Annotated ast
qQuantifiers :: Quantifiers
qResult :: forall ast v. Query ast v -> v
qPattern :: forall ast v. Query ast v -> Annotated ast
qQuantifiers :: forall ast v. Query ast v -> Quantifiers
..} =
AlphaEnv -> Query ast (RewriterResult Universe) -> Rewriter
forall ast v. Matchable ast => AlphaEnv -> Query ast v -> Matcher v
mkLocalMatcher AlphaEnv
env Rewrite ast
q { qResult :: RewriterResult Universe
qResult = RewriterResult :: forall ast.
SrcSpan
-> Quantifiers
-> MatchResultTransformer
-> Template ast
-> RewriterResult ast
RewriterResult{SrcSpan
Quantifiers
Template Universe
MatchResultTransformer
rrTemplate :: Template Universe
rrTransformer :: MatchResultTransformer
rrQuantifiers :: Quantifiers
rrOrigin :: SrcSpan
rrTransformer :: MatchResultTransformer
rrTemplate :: Template Universe
rrQuantifiers :: Quantifiers
rrOrigin :: SrcSpan
..} }
where
rrOrigin :: SrcSpan
rrOrigin = ast -> SrcSpan
forall ast. Matchable ast => ast -> SrcSpan
getOrigin (ast -> SrcSpan) -> ast -> SrcSpan
forall a b. (a -> b) -> a -> b
$ Annotated ast -> ast
forall ast. Annotated ast -> ast
astA Annotated ast
qPattern
rrQuantifiers :: Quantifiers
rrQuantifiers = Quantifiers
qQuantifiers
(Template Universe
rrTemplate, MatchResultTransformer
rrTransformer) = (Template ast -> Template Universe)
-> (Template ast, MatchResultTransformer)
-> (Template Universe, MatchResultTransformer)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ast -> Universe) -> Template ast -> Template Universe
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ast -> Universe
forall ast. Matchable ast => ast -> Universe
inject) (Template ast, MatchResultTransformer)
qResult
data RewriterResult ast = RewriterResult
{ RewriterResult ast -> SrcSpan
rrOrigin :: SrcSpan
, RewriterResult ast -> Quantifiers
rrQuantifiers :: Quantifiers
, RewriterResult ast -> MatchResultTransformer
rrTransformer :: MatchResultTransformer
, RewriterResult ast -> Template ast
rrTemplate :: Template ast
}
deriving (a -> RewriterResult b -> RewriterResult a
(a -> b) -> RewriterResult a -> RewriterResult b
(forall a b. (a -> b) -> RewriterResult a -> RewriterResult b)
-> (forall a b. a -> RewriterResult b -> RewriterResult a)
-> Functor RewriterResult
forall a b. a -> RewriterResult b -> RewriterResult a
forall a b. (a -> b) -> RewriterResult a -> RewriterResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RewriterResult b -> RewriterResult a
$c<$ :: forall a b. a -> RewriterResult b -> RewriterResult a
fmap :: (a -> b) -> RewriterResult a -> RewriterResult b
$cfmap :: forall a b. (a -> b) -> RewriterResult a -> RewriterResult b
Functor)
type MatchResultTransformer =
Context -> MatchResult Universe -> IO (MatchResult Universe)
defaultTransformer :: MatchResultTransformer
defaultTransformer :: MatchResultTransformer
defaultTransformer = (MatchResult Universe -> IO (MatchResult Universe))
-> MatchResultTransformer
forall a b. a -> b -> a
const MatchResult Universe -> IO (MatchResult Universe)
forall (m :: * -> *) a. Monad m => a -> m a
return
data Template ast = Template
{ Template ast -> Annotated ast
tTemplate :: Annotated ast
, Template ast -> AnnotatedImports
tImports :: AnnotatedImports
, Template ast -> Maybe [Rewrite Universe]
tDependents :: Maybe [Rewrite Universe]
}
instance Functor Template where
fmap :: (a -> b) -> Template a -> Template b
fmap a -> b
f Template{Maybe [Rewrite Universe]
Annotated a
AnnotatedImports
tDependents :: Maybe [Rewrite Universe]
tImports :: AnnotatedImports
tTemplate :: Annotated a
tDependents :: forall ast. Template ast -> Maybe [Rewrite Universe]
tImports :: forall ast. Template ast -> AnnotatedImports
tTemplate :: forall ast. Template ast -> Annotated ast
..} = Template :: forall ast.
Annotated ast
-> AnnotatedImports -> Maybe [Rewrite Universe] -> Template ast
Template { tTemplate :: Annotated b
tTemplate = (a -> b) -> Annotated a -> Annotated b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Annotated a
tTemplate, Maybe [Rewrite Universe]
AnnotatedImports
tDependents :: Maybe [Rewrite Universe]
tImports :: AnnotatedImports
tDependents :: Maybe [Rewrite Universe]
tImports :: AnnotatedImports
..}
data MatchResult ast
= MatchResult Substitution (Template ast)
| NoMatch
instance Functor MatchResult where
fmap :: (a -> b) -> MatchResult a -> MatchResult b
fmap a -> b
f (MatchResult Substitution
s Template a
t) = Substitution -> Template b -> MatchResult b
forall ast. Substitution -> Template ast -> MatchResult ast
MatchResult Substitution
s (a -> b
f (a -> b) -> Template a -> Template b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Template a
t)
fmap a -> b
_ MatchResult a
NoMatch = MatchResult b
forall ast. MatchResult ast
NoMatch
runRewriter
:: forall ast m. (Matchable ast, MonadIO m)
=> (RewriterResult Universe -> RewriterResult Universe)
-> Context
-> Rewriter
-> ast
-> TransformT m (MatchResult ast)
runRewriter :: (RewriterResult Universe -> RewriterResult Universe)
-> Context -> Rewriter -> ast -> TransformT m (MatchResult ast)
runRewriter RewriterResult Universe -> RewriterResult Universe
f Context
ctxt Rewriter
rewriter =
Context
-> Rewriter
-> ast
-> TransformT m [(Substitution, RewriterResult Universe)]
forall ast (m :: * -> *) v.
(Matchable ast, MonadIO m) =>
Context -> Matcher v -> ast -> TransformT m [(Substitution, v)]
runMatcher Context
ctxt Rewriter
rewriter (ast -> TransformT m [(Substitution, RewriterResult Universe)])
-> ([(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast))
-> ast
-> TransformT m (MatchResult ast)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Context
-> [(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast)
forall ast (m :: * -> *).
(Matchable ast, MonadIO m) =>
Context
-> [(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast)
firstMatch Context
ctxt ([(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast))
-> ([(Substitution, RewriterResult Universe)]
-> [(Substitution, RewriterResult Universe)])
-> [(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Substitution, RewriterResult Universe)
-> (Substitution, RewriterResult Universe))
-> [(Substitution, RewriterResult Universe)]
-> [(Substitution, RewriterResult Universe)]
forall a b. (a -> b) -> [a] -> [b]
map ((RewriterResult Universe -> RewriterResult Universe)
-> (Substitution, RewriterResult Universe)
-> (Substitution, RewriterResult Universe)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second RewriterResult Universe -> RewriterResult Universe
f)
firstMatch
:: (Matchable ast, MonadIO m)
=> Context
-> [(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast)
firstMatch :: Context
-> [(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast)
firstMatch Context
_ [] = MatchResult ast -> TransformT m (MatchResult ast)
forall (m :: * -> *) a. Monad m => a -> m a
return MatchResult ast
forall ast. MatchResult ast
NoMatch
firstMatch Context
ctxt ((Substitution
sub, RewriterResult{SrcSpan
Quantifiers
Template Universe
MatchResultTransformer
rrTemplate :: Template Universe
rrTransformer :: MatchResultTransformer
rrQuantifiers :: Quantifiers
rrOrigin :: SrcSpan
rrTemplate :: forall ast. RewriterResult ast -> Template ast
rrTransformer :: forall ast. RewriterResult ast -> MatchResultTransformer
rrQuantifiers :: forall ast. RewriterResult ast -> Quantifiers
rrOrigin :: forall ast. RewriterResult ast -> SrcSpan
..}):[(Substitution, RewriterResult Universe)]
matchResults) = do
MatchResult Universe
matchResult <- m (MatchResult Universe) -> TransformT m (MatchResult Universe)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (MatchResult Universe) -> TransformT m (MatchResult Universe))
-> m (MatchResult Universe) -> TransformT m (MatchResult Universe)
forall a b. (a -> b) -> a -> b
$ IO (MatchResult Universe) -> m (MatchResult Universe)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MatchResult Universe) -> m (MatchResult Universe))
-> IO (MatchResult Universe) -> m (MatchResult Universe)
forall a b. (a -> b) -> a -> b
$ MatchResultTransformer
rrTransformer Context
ctxt (Substitution -> Template Universe -> MatchResult Universe
forall ast. Substitution -> Template ast -> MatchResult ast
MatchResult Substitution
sub Template Universe
rrTemplate)
case MatchResult Universe
matchResult of
MatchResult Substitution
sub' Template Universe
_
| Maybe [HoleVal] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [HoleVal] -> Bool) -> Maybe [HoleVal] -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe HoleVal] -> Maybe [HoleVal]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ FastString -> Substitution -> Maybe HoleVal
lookupSubst FastString
q Substitution
sub' | FastString
q <- Quantifiers -> [FastString]
qList Quantifiers
rrQuantifiers ] ->
MatchResult ast -> TransformT m (MatchResult ast)
forall (m :: * -> *) a. Monad m => a -> m a
return (MatchResult ast -> TransformT m (MatchResult ast))
-> MatchResult ast -> TransformT m (MatchResult ast)
forall a b. (a -> b) -> a -> b
$ Universe -> ast
forall ast. Matchable ast => Universe -> ast
project (Universe -> ast) -> MatchResult Universe -> MatchResult ast
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MatchResult Universe
matchResult
MatchResult Universe
_ -> Context
-> [(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast)
forall ast (m :: * -> *).
(Matchable ast, MonadIO m) =>
Context
-> [(Substitution, RewriterResult Universe)]
-> TransformT m (MatchResult ast)
firstMatch Context
ctxt [(Substitution, RewriterResult Universe)]
matchResults
ppRewrite :: Rewrite Universe -> String
ppRewrite :: Rewrite Universe -> String
ppRewrite Query{(Template Universe, MatchResultTransformer)
Quantifiers
Annotated Universe
qResult :: (Template Universe, MatchResultTransformer)
qPattern :: Annotated Universe
qQuantifiers :: Quantifiers
qResult :: forall ast v. Query ast v -> v
qPattern :: forall ast v. Query ast v -> Annotated ast
qQuantifiers :: forall ast v. Query ast v -> Quantifiers
..} =
[FastString] -> String
forall a. Show a => a -> String
show (Quantifiers -> [FastString]
qList Quantifiers
qQuantifiers) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Annotated Universe -> String
printU Annotated Universe
qPattern String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n==>\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Annotated Universe -> String
printU (Template Universe -> Annotated Universe
forall ast. Template ast -> Annotated ast
tTemplate (Template Universe -> Annotated Universe)
-> Template Universe -> Annotated Universe
forall a b. (a -> b) -> a -> b
$ (Template Universe, MatchResultTransformer) -> Template Universe
forall a b. (a, b) -> a
fst (Template Universe, MatchResultTransformer)
qResult)
toURewrite :: Matchable ast => Rewrite ast -> Rewrite Universe
toURewrite :: Rewrite ast -> Rewrite Universe
toURewrite = (ast -> Universe)
-> ((Template ast, MatchResultTransformer)
-> (Template Universe, MatchResultTransformer))
-> Rewrite ast
-> Rewrite Universe
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ast -> Universe
forall ast. Matchable ast => ast -> Universe
inject ((Template ast -> Template Universe)
-> (Template ast, MatchResultTransformer)
-> (Template Universe, MatchResultTransformer)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((ast -> Universe) -> Template ast -> Template Universe
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ast -> Universe
forall ast. Matchable ast => ast -> Universe
inject))
fromURewrite :: Matchable ast => Rewrite Universe -> Rewrite ast
fromURewrite :: Rewrite Universe -> Rewrite ast
fromURewrite = (Universe -> ast)
-> ((Template Universe, MatchResultTransformer)
-> (Template ast, MatchResultTransformer))
-> Rewrite Universe
-> Rewrite ast
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Universe -> ast
forall ast. Matchable ast => Universe -> ast
project ((Template Universe -> Template ast)
-> (Template Universe, MatchResultTransformer)
-> (Template ast, MatchResultTransformer)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Universe -> ast) -> Template Universe -> Template ast
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Universe -> ast
forall ast. Matchable ast => Universe -> ast
project))
rewritesWithDependents :: [Rewrite ast] -> [Rewrite ast]
rewritesWithDependents :: [Rewrite ast] -> [Rewrite ast]
rewritesWithDependents = (Rewrite ast -> Bool) -> [Rewrite ast] -> [Rewrite ast]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe [Rewrite Universe] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Rewrite Universe] -> Bool)
-> (Rewrite ast -> Maybe [Rewrite Universe]) -> Rewrite ast -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template ast -> Maybe [Rewrite Universe]
forall ast. Template ast -> Maybe [Rewrite Universe]
tDependents (Template ast -> Maybe [Rewrite Universe])
-> (Rewrite ast -> Template ast)
-> Rewrite ast
-> Maybe [Rewrite Universe]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Template ast, MatchResultTransformer) -> Template ast
forall a b. (a, b) -> a
fst ((Template ast, MatchResultTransformer) -> Template ast)
-> (Rewrite ast -> (Template ast, MatchResultTransformer))
-> Rewrite ast
-> Template ast
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rewrite ast -> (Template ast, MatchResultTransformer)
forall ast v. Query ast v -> v
qResult)