{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Safe #-}
module ReWire.HSE.Fixity
      ( fixLocalOps
      , deuniquifyLocalOps
      , getFixities
      ) where

import ReWire.SYB (transformM)
import ReWire.Error (AstError, mark)
import ReWire.HSE.SrcLoc () -- the `Annotation SrcSpanInfo` instance (for `mark`).

import Control.Monad (void, (>=>))
import Control.Monad.Identity (Identity (..))
import Control.Monad.State (MonadState, StateT, runStateT, get, modify, lift)
import Data.Maybe (fromMaybe)
import Language.Haskell.Exts.Fixity (Fixity (..), applyFixities)
import Language.Haskell.Exts.SrcLoc (SrcSpanInfo)

import Language.Haskell.Exts.Syntax

type FreshT = StateT Int
type OpRenamer = QOp SrcSpanInfo -> QOp SrcSpanInfo

mark' :: MonadState AstError m => SrcSpanInfo -> FreshT m ()
mark' :: forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' = m () -> StateT Int m ()
forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT Int m ())
-> (SrcSpanInfo -> m ()) -> SrcSpanInfo -> StateT Int m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanInfo -> m ()
forall (m :: * -> *) an.
(MonadState AstError m, Annotation an) =>
an -> m ()
mark

fresh :: Monad m => FreshT m (ModuleName ())
fresh :: forall (m :: * -> *). Monad m => FreshT m (ModuleName ())
fresh = do
      x <- StateT Int m Int
forall s (m :: * -> *). MonadState s m => m s
get
      modify (+ 1)
      pure $ ModuleName () $ '$' : show x

enterScope :: ModuleName () -> [Decl SrcSpanInfo] -> OpRenamer -> OpRenamer
enterScope :: ModuleName () -> [Decl SrcSpanInfo] -> OpRenamer -> OpRenamer
enterScope ModuleName ()
m [Decl SrcSpanInfo]
ds OpRenamer
rn QOp SrcSpanInfo
op
      | QOp SrcSpanInfo -> QOp ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void QOp SrcSpanInfo
op QOp () -> [QOp ()] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [QOp ()]
ops = ModuleName () -> OpRenamer
forall a. ModuleName () -> QOp a -> QOp a
qual ModuleName ()
m QOp SrcSpanInfo
op
      | Bool
otherwise          = OpRenamer
rn QOp SrcSpanInfo
op
      where ops :: [QOp ()]
            ops :: [QOp ()]
ops = (Decl SrcSpanInfo -> [QOp ()] -> [QOp ()])
-> [QOp ()] -> [Decl SrcSpanInfo] -> [QOp ()]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ case
                  FunBind SrcSpanInfo
_ (Match SrcSpanInfo
_ Name SrcSpanInfo
n [Pat SrcSpanInfo]
_ Rhs SrcSpanInfo
_ Maybe (Binds SrcSpanInfo)
_:[Match SrcSpanInfo]
_)        -> (:) (QOp () -> [QOp ()] -> [QOp ()]) -> QOp () -> [QOp ()] -> [QOp ()]
forall a b. (a -> b) -> a -> b
$ () -> QName () -> QOp ()
forall l. l -> QName l -> QOp l
QVarOp () (QName () -> QOp ()) -> QName () -> QOp ()
forall a b. (a -> b) -> a -> b
$ () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name SrcSpanInfo
n
                  FunBind SrcSpanInfo
_ (InfixMatch SrcSpanInfo
_ Pat SrcSpanInfo
_ Name SrcSpanInfo
n [Pat SrcSpanInfo]
_ Rhs SrcSpanInfo
_ Maybe (Binds SrcSpanInfo)
_:[Match SrcSpanInfo]
_) -> (:) (QOp () -> [QOp ()] -> [QOp ()]) -> QOp () -> [QOp ()] -> [QOp ()]
forall a b. (a -> b) -> a -> b
$ () -> QName () -> QOp ()
forall l. l -> QName l -> QOp l
QVarOp () (QName () -> QOp ()) -> QName () -> QOp ()
forall a b. (a -> b) -> a -> b
$ () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name SrcSpanInfo
n
                  Decl SrcSpanInfo
_                                    -> [QOp ()] -> [QOp ()]
forall a. a -> a
id) [] [Decl SrcSpanInfo]
ds

            qual :: ModuleName () -> QOp a -> QOp a
            qual :: forall a. ModuleName () -> QOp a -> QOp a
qual (ModuleName () String
m) (QVarOp a
l1 (UnQual a
l2 Name a
n)) = a -> QName a -> QOp a
forall l. l -> QName l -> QOp l
QVarOp a
l1 (QName a -> QOp a) -> QName a -> QOp a
forall a b. (a -> b) -> a -> b
$ a -> ModuleName a -> Name a -> QName a
forall l. l -> ModuleName l -> Name l -> QName l
Qual a
l2 (a -> String -> ModuleName a
forall l. l -> String -> ModuleName l
ModuleName a
l2 String
m) Name a
n
            qual ModuleName ()
_ QOp a
n                                        = QOp a
n

getFixities' :: ModuleName () -> [Decl a] -> [Fixity]
getFixities' :: forall a. ModuleName () -> [Decl a] -> [Fixity]
getFixities' ModuleName ()
m = (Fixity -> Fixity) -> [Fixity] -> [Fixity]
forall a b. (a -> b) -> [a] -> [b]
map Fixity -> Fixity
qualFixity ([Fixity] -> [Fixity])
-> ([Decl a] -> [Fixity]) -> [Decl a] -> [Fixity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Decl a] -> [Fixity]
forall a. [Decl a] -> [Fixity]
getFixities
      where qualFixity :: Fixity -> Fixity
            qualFixity :: Fixity -> Fixity
qualFixity (Fixity Assoc ()
asc Int
lvl (UnQual () Name ()
n)) = Assoc () -> Int -> QName () -> Fixity
Fixity Assoc ()
asc Int
lvl (() -> ModuleName () -> Name () -> QName ()
forall l. l -> ModuleName l -> Name l -> QName l
Qual () ModuleName ()
m Name ()
n)
            qualFixity Fixity
f                              = Fixity
f

getFixities :: [Decl a] -> [Fixity]
getFixities :: forall a. [Decl a] -> [Fixity]
getFixities = (Decl a -> [Fixity] -> [Fixity])
-> [Fixity] -> [Decl a] -> [Fixity]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Decl a -> [Fixity] -> [Fixity]
forall a. Decl a -> [Fixity] -> [Fixity]
toFixity []
      where toFixity :: Decl a -> [Fixity] -> [Fixity]
            toFixity :: forall a. Decl a -> [Fixity] -> [Fixity]
toFixity (InfixDecl a
_ Assoc a
asc Maybe Int
lvl [Op a]
ops) = [Fixity] -> [Fixity] -> [Fixity]
forall a. Semigroup a => a -> a -> a
(<>) ([Fixity] -> [Fixity] -> [Fixity])
-> [Fixity] -> [Fixity] -> [Fixity]
forall a b. (a -> b) -> a -> b
$ (Op a -> Fixity) -> [Op a] -> [Fixity]
forall a b. (a -> b) -> [a] -> [b]
map (Assoc () -> Int -> QName () -> Fixity
Fixity (Assoc a -> Assoc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Assoc a
asc) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
9 Maybe Int
lvl) (QName () -> Fixity) -> (Op a -> QName ()) -> Op a -> Fixity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> (Op a -> Name ()) -> Op a -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Op a -> Name ()
forall a. Op a -> Name ()
deOp) [Op a]
ops
            toFixity Decl a
_                         = [Fixity] -> [Fixity]
forall a. a -> a
id

            deOp :: Op a -> Name ()
            deOp :: forall a. Op a -> Name ()
deOp = \case
                  VarOp a
_ Name a
n -> Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
n
                  ConOp a
_ Name a
n -> Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Name a
n

-- | Renames local operators and fixes local and file-scope fixities.
--   applyFixities appears to be intended to handle this automatically, but it seems
--   to be buggy and not allow inner fixity declarations to shadow outer ones (on
--   operators with the same name).
--   Note: applyFixities annoyingly fixes the annotation type as SrcSpanInfo.
fixLocalOps :: (MonadState AstError m, MonadFail m) => Module SrcSpanInfo -> m (Module SrcSpanInfo)
fixLocalOps :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
Module SrcSpanInfo -> m (Module SrcSpanInfo)
fixLocalOps = (((Module SrcSpanInfo, Int) -> Module SrcSpanInfo)
-> m (Module SrcSpanInfo, Int) -> m (Module SrcSpanInfo)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Module SrcSpanInfo, Int) -> Module SrcSpanInfo
forall a b. (a, b) -> a
fst (m (Module SrcSpanInfo, Int) -> m (Module SrcSpanInfo))
-> (Module SrcSpanInfo -> m (Module SrcSpanInfo, Int))
-> Module SrcSpanInfo
-> m (Module SrcSpanInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT Int m (Module SrcSpanInfo)
 -> Int -> m (Module SrcSpanInfo, Int))
-> Int
-> StateT Int m (Module SrcSpanInfo)
-> m (Module SrcSpanInfo, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Int m (Module SrcSpanInfo)
-> Int -> m (Module SrcSpanInfo, Int)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Int
0 (StateT Int m (Module SrcSpanInfo) -> m (Module SrcSpanInfo, Int))
-> (Module SrcSpanInfo -> StateT Int m (Module SrcSpanInfo))
-> Module SrcSpanInfo
-> m (Module SrcSpanInfo, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Decl SrcSpanInfo -> StateT Int m (Decl SrcSpanInfo))
-> Module SrcSpanInfo -> StateT Int m (Module SrcSpanInfo)
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
transformM (OpRenamer -> Decl SrcSpanInfo -> StateT Int m (Decl SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Decl SrcSpanInfo -> FreshT m (Decl SrcSpanInfo)
renameDecl OpRenamer
forall a. a -> a
id)) (Module SrcSpanInfo -> m (Module SrcSpanInfo))
-> (Module SrcSpanInfo -> m (Module SrcSpanInfo))
-> Module SrcSpanInfo
-> m (Module SrcSpanInfo)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
Module SrcSpanInfo -> m (Module SrcSpanInfo)
applyGlobFixities
      where applyGlobFixities :: (MonadState AstError m, MonadFail m) => Module SrcSpanInfo -> m (Module SrcSpanInfo)
            applyGlobFixities :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
Module SrcSpanInfo -> m (Module SrcSpanInfo)
applyGlobFixities m :: Module SrcSpanInfo
m@(Module SrcSpanInfo
_ (Just (ModuleHead SrcSpanInfo
_ ModuleName SrcSpanInfo
mn Maybe (WarningText SrcSpanInfo)
_ Maybe (ExportSpecList SrcSpanInfo)
_)) [ModulePragma SrcSpanInfo]
_ [ImportDecl SrcSpanInfo]
_ [Decl SrcSpanInfo]
ds)
                                                          = SrcSpanInfo -> m ()
forall (m :: * -> *) an.
(MonadState AstError m, Annotation an) =>
an -> m ()
mark (Module SrcSpanInfo -> SrcSpanInfo
forall l. Module l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Module SrcSpanInfo
m) m () -> m (Module SrcSpanInfo) -> m (Module SrcSpanInfo)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Fixity] -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (m :: * -> *).
MonadFail m =>
[Fixity] -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (ast :: * -> *) (m :: * -> *).
(AppFixity ast, MonadFail m) =>
[Fixity] -> ast SrcSpanInfo -> m (ast SrcSpanInfo)
applyFixities ([Decl SrcSpanInfo] -> [Fixity]
forall a. [Decl a] -> [Fixity]
getFixities [Decl SrcSpanInfo]
ds [Fixity] -> [Fixity] -> [Fixity]
forall a. Semigroup a => a -> a -> a
<> ModuleName () -> [Decl SrcSpanInfo] -> [Fixity]
forall a. ModuleName () -> [Decl a] -> [Fixity]
getFixities' (ModuleName SrcSpanInfo -> ModuleName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ModuleName SrcSpanInfo
mn) [Decl SrcSpanInfo]
ds) Module SrcSpanInfo
m
            applyGlobFixities m :: Module SrcSpanInfo
m@(Module SrcSpanInfo
_ Maybe (ModuleHead SrcSpanInfo)
Nothing [ModulePragma SrcSpanInfo]
_ [ImportDecl SrcSpanInfo]
_ [Decl SrcSpanInfo]
ds) = SrcSpanInfo -> m ()
forall (m :: * -> *) an.
(MonadState AstError m, Annotation an) =>
an -> m ()
mark (Module SrcSpanInfo -> SrcSpanInfo
forall l. Module l -> l
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Module SrcSpanInfo
m) m () -> m (Module SrcSpanInfo) -> m (Module SrcSpanInfo)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Fixity] -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (m :: * -> *).
MonadFail m =>
[Fixity] -> Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall (ast :: * -> *) (m :: * -> *).
(AppFixity ast, MonadFail m) =>
[Fixity] -> ast SrcSpanInfo -> m (ast SrcSpanInfo)
applyFixities ([Decl SrcSpanInfo] -> [Fixity]
forall a. [Decl a] -> [Fixity]
getFixities [Decl SrcSpanInfo]
ds) Module SrcSpanInfo
m
            applyGlobFixities Module SrcSpanInfo
m                           = Module SrcSpanInfo -> m (Module SrcSpanInfo)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Module SrcSpanInfo
m

deuniquifyLocalOps :: Module SrcSpanInfo -> Module SrcSpanInfo
deuniquifyLocalOps :: Module SrcSpanInfo -> Module SrcSpanInfo
deuniquifyLocalOps = Identity (Module SrcSpanInfo) -> Module SrcSpanInfo
forall a. Identity a -> a
runIdentity (Identity (Module SrcSpanInfo) -> Module SrcSpanInfo)
-> (Module SrcSpanInfo -> Identity (Module SrcSpanInfo))
-> Module SrcSpanInfo
-> Module SrcSpanInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QOp SrcSpanInfo -> Identity (QOp SrcSpanInfo))
-> Module SrcSpanInfo -> Identity (Module SrcSpanInfo)
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
transformM (\ case
      QVarOp SrcSpanInfo
l1 (Qual SrcSpanInfo
l2 (ModuleName SrcSpanInfo
_ (Char
'$' : String
_)) Name SrcSpanInfo
n) -> QOp SrcSpanInfo -> Identity (QOp SrcSpanInfo)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QOp SrcSpanInfo -> Identity (QOp SrcSpanInfo))
-> QOp SrcSpanInfo -> Identity (QOp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> QName SrcSpanInfo -> QOp SrcSpanInfo
forall l. l -> QName l -> QOp l
QVarOp SrcSpanInfo
l1 (QName SrcSpanInfo -> QOp SrcSpanInfo)
-> QName SrcSpanInfo -> QOp SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> Name l -> QName l
UnQual SrcSpanInfo
l2 Name SrcSpanInfo
n
      (QOp SrcSpanInfo
x :: QOp SrcSpanInfo)                         -> QOp SrcSpanInfo -> Identity (QOp SrcSpanInfo)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QOp SrcSpanInfo
x)

renameDecl :: (MonadState AstError m, MonadFail m) => OpRenamer -> Decl SrcSpanInfo -> FreshT m (Decl SrcSpanInfo)
renameDecl :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Decl SrcSpanInfo -> FreshT m (Decl SrcSpanInfo)
renameDecl OpRenamer
rn = \ case
      PatBind SrcSpanInfo
l1 Pat SrcSpanInfo
p (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) Maybe (Binds SrcSpanInfo)
Nothing -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            e' <- OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
            pure $ PatBind l1 p (UnGuardedRhs l2 e') Nothing
      PatBind SrcSpanInfo
l1 Pat SrcSpanInfo
p (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) (Just (BDecls SrcSpanInfo
l3 [Decl SrcSpanInfo]
ds)) -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            (e', ds') <- OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
renameExpInScope OpRenamer
rn [Decl SrcSpanInfo]
ds Exp SrcSpanInfo
e
            pure $ PatBind l1 p (UnGuardedRhs l2 e') $ Just (BDecls l3 ds')
      FunBind SrcSpanInfo
l [Match SrcSpanInfo]
ms -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l
            SrcSpanInfo -> [Match SrcSpanInfo] -> Decl SrcSpanInfo
forall l. l -> [Match l] -> Decl l
FunBind SrcSpanInfo
l ([Match SrcSpanInfo] -> Decl SrcSpanInfo)
-> StateT Int m [Match SrcSpanInfo] -> FreshT m (Decl SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Match SrcSpanInfo -> StateT Int m (Match SrcSpanInfo))
-> [Match SrcSpanInfo] -> StateT Int m [Match SrcSpanInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (OpRenamer -> Match SrcSpanInfo -> StateT Int m (Match SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Match SrcSpanInfo -> FreshT m (Match SrcSpanInfo)
renameMatch OpRenamer
rn) [Match SrcSpanInfo]
ms
      Decl SrcSpanInfo
d -> Decl SrcSpanInfo -> FreshT m (Decl SrcSpanInfo)
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Decl SrcSpanInfo
d

renameMatch :: (MonadState AstError m, MonadFail m) => OpRenamer -> Match SrcSpanInfo -> FreshT m (Match SrcSpanInfo)
renameMatch :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Match SrcSpanInfo -> FreshT m (Match SrcSpanInfo)
renameMatch OpRenamer
rn = \ case
      Match SrcSpanInfo
l1 Name SrcSpanInfo
n [Pat SrcSpanInfo]
ps (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) Maybe (Binds SrcSpanInfo)
Nothing -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            e' <- OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
            pure $ Match l1 n ps (UnGuardedRhs l2 e') Nothing
      Match SrcSpanInfo
l1 Name SrcSpanInfo
n [Pat SrcSpanInfo]
ps (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) (Just (BDecls SrcSpanInfo
l3 [Decl SrcSpanInfo]
ds)) -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            (e', ds') <- OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
renameExpInScope OpRenamer
rn [Decl SrcSpanInfo]
ds Exp SrcSpanInfo
e

            pure $ Match l1 n ps (UnGuardedRhs l2 e') $ Just (BDecls l3 ds')
      InfixMatch SrcSpanInfo
l1 Pat SrcSpanInfo
p Name SrcSpanInfo
n [Pat SrcSpanInfo]
ps (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) Maybe (Binds SrcSpanInfo)
Nothing -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            e' <- OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
            pure $ InfixMatch l1 p n ps (UnGuardedRhs l2 e') Nothing
      InfixMatch SrcSpanInfo
l1 Pat SrcSpanInfo
p Name SrcSpanInfo
n [Pat SrcSpanInfo]
ps (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) (Just (BDecls SrcSpanInfo
l3 [Decl SrcSpanInfo]
ds)) -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            (e', ds') <- OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
renameExpInScope OpRenamer
rn [Decl SrcSpanInfo]
ds Exp SrcSpanInfo
e
            pure $ InfixMatch l1 p n ps (UnGuardedRhs l2 e') $ Just (BDecls l3 ds')
      Match SrcSpanInfo
m -> Match SrcSpanInfo -> FreshT m (Match SrcSpanInfo)
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Match SrcSpanInfo
m

renameExp :: (MonadState AstError m, MonadFail m) => OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn = \ case
      InfixApp SrcSpanInfo
l Exp SrcSpanInfo
e1 QOp SrcSpanInfo
op Exp SrcSpanInfo
e2     -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l
            e1' <- OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e1
            e2' <- renameExp rn e2
            pure $ InfixApp l e1' (rn op) e2'
      App SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2             -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo
-> Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l -> Exp l
App SrcSpanInfo
l (Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo)
-> StateT Int m (Exp SrcSpanInfo -> Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e1 StateT Int m (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e2
      NegApp SrcSpanInfo
l Exp SrcSpanInfo
e              -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l
NegApp SrcSpanInfo
l (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
      Lambda SrcSpanInfo
l [Pat SrcSpanInfo]
ps Exp SrcSpanInfo
e           -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo
-> [Pat SrcSpanInfo] -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda SrcSpanInfo
l [Pat SrcSpanInfo]
ps (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
      Let SrcSpanInfo
l1 (BDecls SrcSpanInfo
l2 [Decl SrcSpanInfo]
ds) Exp SrcSpanInfo
e -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            (e', ds') <- OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
renameExpInScope OpRenamer
rn [Decl SrcSpanInfo]
ds Exp SrcSpanInfo
e
            pure $ Let l1 (BDecls l2 ds') e'
      If SrcSpanInfo
l Exp SrcSpanInfo
e1 Exp SrcSpanInfo
e2 Exp SrcSpanInfo
e3           -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo
-> Exp SrcSpanInfo
-> Exp SrcSpanInfo
-> Exp SrcSpanInfo
-> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l -> Exp l -> Exp l
If SrcSpanInfo
l (Exp SrcSpanInfo
 -> Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo)
-> StateT
     Int m (Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e1 StateT
  Int m (Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo)
-> StateT Int m (Exp SrcSpanInfo -> Exp SrcSpanInfo)
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e2 StateT Int m (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e3
      Case SrcSpanInfo
l Exp SrcSpanInfo
e [Alt SrcSpanInfo]
alts           -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo
-> Exp SrcSpanInfo -> [Alt SrcSpanInfo] -> Exp SrcSpanInfo
forall l. l -> Exp l -> [Alt l] -> Exp l
Case SrcSpanInfo
l (Exp SrcSpanInfo -> [Alt SrcSpanInfo] -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo)
-> StateT Int m ([Alt SrcSpanInfo] -> Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e StateT Int m ([Alt SrcSpanInfo] -> Exp SrcSpanInfo)
-> StateT Int m [Alt SrcSpanInfo] -> FreshT m (Exp SrcSpanInfo)
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Alt SrcSpanInfo -> StateT Int m (Alt SrcSpanInfo))
-> [Alt SrcSpanInfo] -> StateT Int m [Alt SrcSpanInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (OpRenamer -> Alt SrcSpanInfo -> StateT Int m (Alt SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Alt SrcSpanInfo -> FreshT m (Alt SrcSpanInfo)
renameAlt OpRenamer
rn) [Alt SrcSpanInfo]
alts
      Do SrcSpanInfo
l [Stmt SrcSpanInfo]
stmts              -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo -> [Stmt SrcSpanInfo] -> Exp SrcSpanInfo
forall l. l -> [Stmt l] -> Exp l
Do SrcSpanInfo
l ([Stmt SrcSpanInfo] -> Exp SrcSpanInfo)
-> StateT Int m [Stmt SrcSpanInfo] -> FreshT m (Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> [Stmt SrcSpanInfo] -> StateT Int m [Stmt SrcSpanInfo]
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> [Stmt SrcSpanInfo] -> FreshT m [Stmt SrcSpanInfo]
renameStmts OpRenamer
rn [Stmt SrcSpanInfo]
stmts
      Tuple SrcSpanInfo
l Boxed
b [Exp SrcSpanInfo]
es            -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo -> Boxed -> [Exp SrcSpanInfo] -> Exp SrcSpanInfo
forall l. l -> Boxed -> [Exp l] -> Exp l
Tuple SrcSpanInfo
l Boxed
b ([Exp SrcSpanInfo] -> Exp SrcSpanInfo)
-> StateT Int m [Exp SrcSpanInfo] -> FreshT m (Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo))
-> [Exp SrcSpanInfo] -> StateT Int m [Exp SrcSpanInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn) [Exp SrcSpanInfo]
es
      List SrcSpanInfo
l [Exp SrcSpanInfo]
es               -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo -> [Exp SrcSpanInfo] -> Exp SrcSpanInfo
forall l. l -> [Exp l] -> Exp l
List SrcSpanInfo
l ([Exp SrcSpanInfo] -> Exp SrcSpanInfo)
-> StateT Int m [Exp SrcSpanInfo] -> FreshT m (Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo))
-> [Exp SrcSpanInfo] -> StateT Int m [Exp SrcSpanInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn) [Exp SrcSpanInfo]
es
      Paren SrcSpanInfo
l Exp SrcSpanInfo
e               -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l
Paren SrcSpanInfo
l (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
      LeftSection SrcSpanInfo
l Exp SrcSpanInfo
e QOp SrcSpanInfo
op      -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo
-> Exp SrcSpanInfo -> QOp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> QOp l -> Exp l
LeftSection SrcSpanInfo
l (Exp SrcSpanInfo -> QOp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo)
-> StateT Int m (QOp SrcSpanInfo -> Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e StateT Int m (QOp SrcSpanInfo -> Exp SrcSpanInfo)
-> StateT Int m (QOp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b.
StateT Int m (a -> b) -> StateT Int m a -> StateT Int m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> QOp SrcSpanInfo -> StateT Int m (QOp SrcSpanInfo)
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure QOp SrcSpanInfo
op
      RightSection SrcSpanInfo
l QOp SrcSpanInfo
op Exp SrcSpanInfo
e     -> SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l FreshT m ()
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall a b. StateT Int m a -> StateT Int m b -> StateT Int m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SrcSpanInfo
-> QOp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> QOp l -> Exp l -> Exp l
RightSection SrcSpanInfo
l QOp SrcSpanInfo
op (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> FreshT m (Exp SrcSpanInfo) -> FreshT m (Exp SrcSpanInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
      Exp SrcSpanInfo
e                       -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp SrcSpanInfo
e

renameAlt :: (MonadState AstError m, MonadFail m) => OpRenamer -> Alt SrcSpanInfo -> FreshT m (Alt SrcSpanInfo)
renameAlt :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Alt SrcSpanInfo -> FreshT m (Alt SrcSpanInfo)
renameAlt OpRenamer
rn = \ case
      Alt SrcSpanInfo
l1 Pat SrcSpanInfo
p (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) Maybe (Binds SrcSpanInfo)
Nothing -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            e' <- OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
            pure $ Alt l1 p (UnGuardedRhs l2 e') Nothing
      Alt SrcSpanInfo
l1 Pat SrcSpanInfo
p (UnGuardedRhs SrcSpanInfo
l2 Exp SrcSpanInfo
e) (Just (BDecls SrcSpanInfo
l3 [Decl SrcSpanInfo]
ds)) -> do
            SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
            (e', ds') <- OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
renameExpInScope OpRenamer
rn [Decl SrcSpanInfo]
ds Exp SrcSpanInfo
e
            pure $ Alt l1 p (UnGuardedRhs l2 e') $ Just $ BDecls l3 ds'
      Alt SrcSpanInfo
a                                  -> Alt SrcSpanInfo -> FreshT m (Alt SrcSpanInfo)
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alt SrcSpanInfo
a

renameStmts :: (MonadState AstError m, MonadFail m) => OpRenamer -> [Stmt SrcSpanInfo] -> FreshT m [Stmt SrcSpanInfo]
renameStmts :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> [Stmt SrcSpanInfo] -> FreshT m [Stmt SrcSpanInfo]
renameStmts OpRenamer
_ [] = [Stmt SrcSpanInfo] -> StateT Int m [Stmt SrcSpanInfo]
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
renameStmts OpRenamer
rn (Generator SrcSpanInfo
l Pat SrcSpanInfo
p Exp SrcSpanInfo
e : [Stmt SrcSpanInfo]
stmts) = do
      SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l
      e'     <- OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
      stmts' <- renameStmts rn stmts
      pure $ Generator l p e' : stmts'
renameStmts OpRenamer
rn (Qualifier SrcSpanInfo
l Exp SrcSpanInfo
e : [Stmt SrcSpanInfo]
stmts) = do
      SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l
      e'     <- OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo)
renameExp OpRenamer
rn Exp SrcSpanInfo
e
      stmts' <- renameStmts rn stmts
      pure $ Qualifier l e' : stmts'
renameStmts OpRenamer
rn (LetStmt SrcSpanInfo
l1 (BDecls SrcSpanInfo
l2 [Decl SrcSpanInfo]
ds) : [Stmt SrcSpanInfo]
stmts) = do
      SrcSpanInfo -> FreshT m ()
forall (m :: * -> *).
MonadState AstError m =>
SrcSpanInfo -> FreshT m ()
mark' SrcSpanInfo
l1
      m       <- FreshT m (ModuleName ())
forall (m :: * -> *). Monad m => FreshT m (ModuleName ())
fresh
      stmts'  <- renameStmts (enterScope m ds rn) stmts
      stmts'' <- mapM (applyFixities $ getFixities' m ds) stmts'
      ds'     <- mapM (renameDecl $ enterScope m ds rn) ds
      ds''    <- mapM (applyFixities $ getFixities' m ds) ds'
      pure $ LetStmt l1 (BDecls l2 ds'') : stmts''
renameStmts OpRenamer
_ [Stmt SrcSpanInfo]
stmts = [Stmt SrcSpanInfo] -> StateT Int m [Stmt SrcSpanInfo]
forall a. a -> StateT Int m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Stmt SrcSpanInfo]
stmts

renameExpInScope :: (MonadState AstError m, MonadFail m) => OpRenamer -> [Decl SrcSpanInfo] -> Exp SrcSpanInfo -> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
renameExpInScope :: forall (m :: * -> *).
(MonadState AstError m, MonadFail m) =>
OpRenamer
-> [Decl SrcSpanInfo]
-> Exp SrcSpanInfo
-> FreshT m (Exp SrcSpanInfo, [Decl SrcSpanInfo])
renameExpInScope OpRenamer
rn [Decl SrcSpanInfo]
ds Exp SrcSpanInfo
e = do
      m    <- FreshT m (ModuleName ())
forall (m :: * -> *). Monad m => FreshT m (ModuleName ())
fresh
      e'   <- renameExp (enterScope m ds rn) e
      e''  <- applyFixities (getFixities' m ds) e'
      ds'  <- mapM (renameDecl $ enterScope m ds rn) ds
      ds'' <- mapM (applyFixities $ getFixities' m ds) ds'
      pure (e'', ds'')