{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

module Language.Dickinson.Rename ( renameDickinson
                                 , renameDickinsonM
                                 , renameDeclarationsM
                                 , renameDeclarationM
                                 , renameExpressionM
                                 , initRenames
                                 , maxLens
                                 , boundLens
                                 , replaceUnique
                                 , RenameM
                                 , Renames (..)
                                 , HasRenames (..)
                                 ) where

import           Control.Composition           (thread)
import           Control.Monad                 (forM, (<=<))
import           Control.Monad.State           (MonadState, State, runState)
import           Data.Bifunctor                (second)
import           Data.Binary                   (Binary)
import qualified Data.IntMap                   as IM
import qualified Data.List.NonEmpty            as NE
import           Data.Text.Prettyprint.Doc.Ext
import           GHC.Generics                  (Generic)
import           Language.Dickinson.Name
import           Language.Dickinson.Type
import           Language.Dickinson.Unique
import           Lens.Micro                    (Lens')
import           Lens.Micro.Mtl                (modifying, use, (%=), (.=))
import           Prettyprinter                 (Pretty (..), (<+>))

-- | Renamer state passed between various stages of compilation
data Renames = Renames { Renames -> Int
max_ :: Int, Renames -> IntMap Int
bound :: IM.IntMap Int }
    deriving (forall x. Rep Renames x -> Renames
forall x. Renames -> Rep Renames x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Renames x -> Renames
$cfrom :: forall x. Renames -> Rep Renames x
Generic, Get Renames
[Renames] -> Put
Renames -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Renames] -> Put
$cputList :: [Renames] -> Put
get :: Get Renames
$cget :: Get Renames
put :: Renames -> Put
$cput :: Renames -> Put
Binary)

instance Pretty Renames where
    pretty :: forall ann. Renames -> Doc ann
pretty (Renames Int
m IntMap Int
b) = Doc ann
"max:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Int
m forall ann. Doc ann -> Doc ann -> Doc ann
<#> Doc ann
"renames:" forall ann. Doc ann -> Doc ann -> Doc ann
<#*> forall b a. Pretty b => IntMap b -> Doc a
prettyDumpBinds IntMap Int
b

boundLens :: Lens' Renames (IM.IntMap Int)
boundLens :: Lens' Renames (IntMap Int)
boundLens IntMap Int -> f (IntMap Int)
f Renames
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IntMap Int
x -> Renames
s { bound :: IntMap Int
bound = IntMap Int
x }) (IntMap Int -> f (IntMap Int)
f (Renames -> IntMap Int
bound Renames
s))

maxLens :: Lens' Renames Int
maxLens :: Lens' Renames Int
maxLens Int -> f Int
f Renames
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Renames
s { max_ :: Int
max_ = Int
x }) (Int -> f Int
f (Renames -> Int
max_ Renames
s))

-- | @since 0.1.1.0
class HasRenames a where
    rename :: Lens' a Renames

instance HasRenames Renames where
    rename :: Lens' Renames Renames
rename = forall a. a -> a
id

type RenameM = State Renames

initRenames :: Renames
initRenames :: Renames
initRenames = Int -> IntMap Int -> Renames
Renames Int
0 forall a. Monoid a => a
mempty

runRenameM :: Int -> RenameM x -> (x, UniqueCtx)
runRenameM :: forall x. Int -> RenameM x -> (x, Int)
runRenameM Int
i RenameM x
x = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Renames -> Int
max_ (forall s a. State s a -> s -> (a, s)
runState RenameM x
x (Int -> IntMap Int -> Renames
Renames Int
i forall a. Monoid a => a
mempty))

-- Make sure you don't have cycles in the renames map!
replaceUnique :: (MonadState s m, HasRenames s) => Unique -> m Unique
replaceUnique :: forall s (m :: * -> *).
(MonadState s m, HasRenames s) =>
Unique -> m Unique
replaceUnique u :: Unique
u@(Unique Int
i) = do
    IntMap Int
rSt <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall a. HasRenames a => Lens' a Renames
renameforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Renames (IntMap Int)
boundLens)
    case forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
i IntMap Int
rSt of
        Maybe Int
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Unique
u
        Just Int
j  -> forall s (m :: * -> *).
(MonadState s m, HasRenames s) =>
Unique -> m Unique
replaceUnique (Int -> Unique
Unique Int
j)

replaceVar :: (MonadState s m, HasRenames s) => Name a -> m (Name a)
replaceVar :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Name a -> m (Name a)
replaceVar (Name NonEmpty Text
n Unique
u a
l) = {-# SCC "replaceVar" #-} do
    Unique
u' <- forall s (m :: * -> *).
(MonadState s m, HasRenames s) =>
Unique -> m Unique
replaceUnique Unique
u
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty Text -> Unique -> a -> Name a
Name NonEmpty Text
n Unique
u' a
l

-- exported so we can test it alone
renameDickinson :: Int -> Dickinson a -> (Dickinson a, Int)
renameDickinson :: forall a. Int -> Dickinson a -> (Dickinson a, Int)
renameDickinson Int
m Dickinson a
ds = forall x. Int -> RenameM x -> (x, Int)
runRenameM Int
m forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Dickinson a -> m (Dickinson a)
renameDickinsonM Dickinson a
ds

-- | The renamer ensures global uniqueness and is used during evaluation to
-- clone expressions with bound variables.
renameDickinsonM :: (MonadState s m, HasRenames s) => Dickinson a -> m (Dickinson a)
renameDickinsonM :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Dickinson a -> m (Dickinson a)
renameDickinsonM (Dickinson [Import a]
i [Declaration a]
d) = forall a. [Import a] -> [Declaration a] -> Dickinson a
Dickinson [Import a]
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
[Declaration a] -> m [Declaration a]
renameDeclarationsM [Declaration a]
d

renameDeclarationsM :: (MonadState s m, HasRenames s) => [Declaration a] -> m [Declaration a]
renameDeclarationsM :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
[Declaration a] -> m [Declaration a]
renameDeclarationsM = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Declaration a -> m (Declaration a)
renameDeclarationM forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Declaration a -> m (Declaration a)
insDeclM

-- broadcast first... This allows definitions to be declared in any order.
insDeclM :: (MonadState s m, HasRenames s) => Declaration a -> m (Declaration a)
insDeclM :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Declaration a -> m (Declaration a)
insDeclM (Define a
p Name a
n Expression a
e) = do
    (Name a
n', Renames -> Renames
modR) <- forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
Name a -> m (Name a, Renames -> Renames)
withName Name a
n
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
modifying forall a. HasRenames a => Lens' a Renames
rename Renames -> Renames
modR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Name a -> Expression a -> Declaration a
Define a
p Name a
n' Expression a
e
insDeclM d :: Declaration a
d@TyDecl{} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Declaration a
d -- TODO: decide on spec for scoping. (two type decls should be illegal)

renameDeclarationM :: (MonadState s m, HasRenames s) => Declaration a -> m (Declaration a)
renameDeclarationM :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Declaration a -> m (Declaration a)
renameDeclarationM (Define a
p Name a
n Expression a
e) =
    forall a. a -> Name a -> Expression a -> Declaration a
Define a
p Name a
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e
renameDeclarationM d :: Declaration a
d@TyDecl{} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Declaration a
d

-- allows us to work with a temporary change to the renamer state, tracking the
-- max sensibly
withRenames :: (HasRenames s, MonadState s m) => (Renames -> Renames) -> m a -> m a
withRenames :: forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
(Renames -> Renames) -> m a -> m a
withRenames Renames -> Renames
modSt m a
act = do
    Renames
preSt <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. HasRenames a => Lens' a Renames
rename
    forall a. HasRenames a => Lens' a Renames
rename forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Renames -> Renames
modSt
    a
res <- m a
act
    Int
postMax <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall a. HasRenames a => Lens' a Renames
renameforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Renames Int
maxLens)
    forall a. HasRenames a => Lens' a Renames
rename forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> Renames -> Renames
setMax Int
postMax Renames
preSt
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

withName :: (HasRenames s, MonadState s m) => Name a -> m (Name a, Renames -> Renames)
withName :: forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
Name a -> m (Name a, Renames -> Renames)
withName (Name NonEmpty Text
t (Unique Int
i) a
l) = do
    Int
m <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall a. HasRenames a => Lens' a Renames
renameforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Renames Int
maxLens)
    let newUniq :: Int
newUniq = Int
mforall a. Num a => a -> a -> a
+Int
1
    forall a. HasRenames a => Lens' a Renames
renameforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Renames Int
maxLens forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
newUniq
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. NonEmpty Text -> Unique -> a -> Name a
Name NonEmpty Text
t (Int -> Unique
Unique Int
newUniq) a
l, (IntMap Int -> IntMap Int) -> Renames -> Renames
mapBound (forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
i (Int
mforall a. Num a => a -> a -> a
+Int
1)))

mapBound :: (IM.IntMap Int -> IM.IntMap Int) -> Renames -> Renames
mapBound :: (IntMap Int -> IntMap Int) -> Renames -> Renames
mapBound IntMap Int -> IntMap Int
f (Renames Int
m IntMap Int
b) = Int -> IntMap Int -> Renames
Renames Int
m (IntMap Int -> IntMap Int
f IntMap Int
b)

setMax :: Int -> Renames -> Renames
setMax :: Int -> Renames -> Renames
setMax Int
i (Renames Int
_ IntMap Int
b) = Int -> IntMap Int -> Renames
Renames Int
i IntMap Int
b

renamePatternM :: (MonadState s m, HasRenames s) => Pattern a -> m (Renames -> Renames, Pattern a)
renamePatternM :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Pattern a -> m (Renames -> Renames, Pattern a)
renamePatternM w :: Pattern a
w@Wildcard{}        = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> a
id, Pattern a
w)
renamePatternM (PatternTuple a
l NonEmpty (Pattern a)
ps) = do
    NonEmpty (Renames -> Renames, Pattern a)
ps' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Pattern a -> m (Renames -> Renames, Pattern a)
renamePatternM NonEmpty (Pattern a)
ps
    let modR :: Renames -> Renames
modR = forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Renames -> Renames, Pattern a)
ps')
        ps'' :: NonEmpty (Pattern a)
ps'' = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Renames -> Renames, Pattern a)
ps'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Renames -> Renames
modR, forall a. a -> NonEmpty (Pattern a) -> Pattern a
PatternTuple a
l NonEmpty (Pattern a)
ps'')
renamePatternM (PatternVar a
l Name a
n) = do
    (Name a
n', Renames -> Renames
modR) <- forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
Name a -> m (Name a, Renames -> Renames)
withName Name a
n
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Renames -> Renames
modR, forall a. a -> Name a -> Pattern a
PatternVar a
l Name a
n')
renamePatternM c :: Pattern a
c@PatternCons{}     = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> a
id, Pattern a
c) -- TODO: correct?
renamePatternM (OrPattern a
l NonEmpty (Pattern a)
ps) = do
    NonEmpty (Renames -> Renames, Pattern a)
ps' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Pattern a -> m (Renames -> Renames, Pattern a)
renamePatternM NonEmpty (Pattern a)
ps
    let modR :: Renames -> Renames
modR = forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Renames -> Renames, Pattern a)
ps')
        ps'' :: NonEmpty (Pattern a)
ps'' = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Renames -> Renames, Pattern a)
ps'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Renames -> Renames
modR, forall a. a -> NonEmpty (Pattern a) -> Pattern a
OrPattern a
l NonEmpty (Pattern a)
ps'')

-- | @since 0.1.1.0
renameExpressionM :: (MonadState s m, HasRenames s) => Expression a -> m (Expression a)
renameExpressionM :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM e :: Expression a
e@Literal{} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression a
e
renameExpressionM e :: Expression a
e@StrChunk{} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression a
e
renameExpressionM (Var a
p Name a
n)   = forall a. a -> Name a -> Expression a
Var a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Name a -> m (Name a)
replaceVar Name a
n
renameExpressionM (Choice a
p NonEmpty (Double, Expression a)
branches) = forall a. a -> NonEmpty (Double, Expression a) -> Expression a
Choice a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NonEmpty (Double, Expression a))
branches'
    where branches' :: m (NonEmpty (Double, Expression a))
branches' =
            let ds :: NonEmpty Double
ds = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Double, Expression a)
branches
                in let es :: NonEmpty (Expression a)
es = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd NonEmpty (Double, Expression a)
branches
                    in forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty Double
ds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM NonEmpty (Expression a)
es
renameExpressionM (Interp a
p [Expression a]
es) = forall a. a -> [Expression a] -> Expression a
Interp a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM [Expression a]
es
renameExpressionM (MultiInterp a
p [Expression a]
es) = forall a. a -> [Expression a] -> Expression a
MultiInterp a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM [Expression a]
es
renameExpressionM (Concat a
p [Expression a]
es) = forall a. a -> [Expression a] -> Expression a
Concat a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM [Expression a]
es
renameExpressionM (Tuple a
p NonEmpty (Expression a)
es)  = forall a. a -> NonEmpty (Expression a) -> Expression a
Tuple a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM NonEmpty (Expression a)
es
renameExpressionM (Apply a
p Expression a
e Expression a
e') = forall a. a -> Expression a -> Expression a -> Expression a
Apply a
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e'
renameExpressionM (Lambda a
p Name a
n DickinsonTy a
ty Expression a
e) = do
    (Name a
n', Renames -> Renames
modR) <- forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
Name a -> m (Name a, Renames -> Renames)
withName Name a
n
    forall a.
a -> Name a -> DickinsonTy a -> Expression a -> Expression a
Lambda a
p Name a
n' DickinsonTy a
ty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
(Renames -> Renames) -> m a -> m a
withRenames Renames -> Renames
modR (forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e)
renameExpressionM (Match a
l Expression a
e NonEmpty (Pattern a, Expression a)
brs) = do
    Expression a
preE <- forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e
    NonEmpty (Pattern a, Expression a)
brs' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM NonEmpty (Pattern a, Expression a)
brs forall a b. (a -> b) -> a -> b
$ \(Pattern a
p, Expression a
e') -> do
        (Renames -> Renames
modP, Pattern a
p') <- forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Pattern a -> m (Renames -> Renames, Pattern a)
renamePatternM Pattern a
p
        (Pattern a
p' ,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
(Renames -> Renames) -> m a -> m a
withRenames Renames -> Renames
modP (forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e')
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
a
-> Expression a
-> NonEmpty (Pattern a, Expression a)
-> Expression a
Match a
l Expression a
preE NonEmpty (Pattern a, Expression a)
brs'
renameExpressionM (Bind a
p NonEmpty (Name a, Expression a)
bs Expression a
e) = forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
(a
 -> NonEmpty (Name a, Expression a) -> Expression a -> Expression a)
-> a
-> NonEmpty (Name a, Expression a)
-> Expression a
-> m (Expression a)
renameLet forall a.
a
-> NonEmpty (Name a, Expression a) -> Expression a -> Expression a
Bind a
p NonEmpty (Name a, Expression a)
bs Expression a
e
renameExpressionM (Let a
p NonEmpty (Name a, Expression a)
bs Expression a
e) = forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
(a
 -> NonEmpty (Name a, Expression a) -> Expression a -> Expression a)
-> a
-> NonEmpty (Name a, Expression a)
-> Expression a
-> m (Expression a)
renameLet forall a.
a
-> NonEmpty (Name a, Expression a) -> Expression a -> Expression a
Let a
p NonEmpty (Name a, Expression a)
bs Expression a
e
renameExpressionM (Flatten a
l Expression a
e) =
    forall a. a -> Expression a -> Expression a
Flatten a
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e
renameExpressionM (Annot a
l Expression a
e DickinsonTy a
ty) =
    forall a. a -> Expression a -> DickinsonTy a -> Expression a
Annot a
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure DickinsonTy a
ty
renameExpressionM c :: Expression a
c@Constructor{} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression a
c
renameExpressionM c :: Expression a
c@BuiltinFn{} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression a
c
renameExpressionM c :: Expression a
c@Random{} = forall (f :: * -> *) a. Applicative f => a -> f a
pure Expression a
c

-- since bind/let are the same at this stage
renameLet :: (MonadState s m, HasRenames s)
          => (a -> NE.NonEmpty (Name a, Expression a) -> Expression a -> Expression a)
          -> a
          -> NE.NonEmpty (Name a, Expression a)
          -> Expression a
          -> m (Expression a)
renameLet :: forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
(a
 -> NonEmpty (Name a, Expression a) -> Expression a -> Expression a)
-> a
-> NonEmpty (Name a, Expression a)
-> Expression a
-> m (Expression a)
renameLet a
-> NonEmpty (Name a, Expression a) -> Expression a -> Expression a
constructor a
p NonEmpty (Name a, Expression a)
bs Expression a
e = do
    NonEmpty (Name a, Renames -> Renames)
newBs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
Name a -> m (Name a, Renames -> Renames)
withName (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
bs)
    let localRenames :: NonEmpty (Renames -> Renames)
localRenames = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Renames -> Renames)
newBs
        newBinds :: Renames -> Renames
newBinds = forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread NonEmpty (Renames -> Renames)
localRenames
        newNames :: NonEmpty (Name a)
newNames = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Renames -> Renames)
newBs
        preNewBound :: NonEmpty (Expression a)
preNewBound = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Name a, Expression a)
bs
    NonEmpty (Expression a)
newBound <-
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM NonEmpty (Expression a)
preNewBound
    forall s (m :: * -> *) a.
(HasRenames s, MonadState s m) =>
(Renames -> Renames) -> m a -> m a
withRenames Renames -> Renames
newBinds forall a b. (a -> b) -> a -> b
$
        a
-> NonEmpty (Name a, Expression a) -> Expression a -> Expression a
constructor a
p (forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty (Name a)
newNames NonEmpty (Expression a)
newBound) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a.
(MonadState s m, HasRenames s) =>
Expression a -> m (Expression a)
renameExpressionM Expression a
e