{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

{- | Mangle all variable names in a program to ensure global uniqueness.

Also populate symbol table with information about those (now unique) names.

This module also exports 'pickId', which other passes can use to create fresh
variable names given some symbol table.
-}
module IR.MangleNames (mangleProgram, normalizeId, pickId) where

import qualified Common.Compiler as Compiler
import Common.Identifiers (Identifiable (..), IsString (..))
import qualified IR.IR as I

import Control.Monad (forM)
import Control.Monad.Except (MonadError (..))
import Control.Monad.State (MonadState, StateT (..), evalStateT, gets, modify)
import qualified Data.Map as M
import Data.Maybe (mapMaybe)


type OriginId = I.VarId
type MangledId = I.VarId


-- | Normalize an identifier (remove things like backticks etc.)
normalizeId :: Identifiable i => i -> i
normalizeId :: i -> i
normalizeId = String -> i
forall a. IsString a => String -> a
fromString (String -> i) -> (i -> String) -> i -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr (String -> String) -> (i -> String) -> i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> String
forall i. Identifiable i => i -> String
ident
 where
  tr :: Char -> Char
tr Char
'\'' = Char
'_'
  tr Char
a = Char
a


-- | Given a symbol table and a name, pick a new name that is globally unique.
pickId :: M.Map MangledId t -> OriginId -> MangledId
pickId :: Map MangledId t -> MangledId -> MangledId
pickId Map MangledId t
globals MangledId
v = if MangledId -> Bool
alreadyInUse MangledId
v' then Int -> MangledId
pick Int
1 else MangledId
v'
 where
  v' :: MangledId
  v' :: MangledId
v' = MangledId -> MangledId
forall i. Identifiable i => i -> i
normalizeId MangledId
v

  pick :: Int -> MangledId
  pick :: Int -> MangledId
pick Int
i =
    let v'' :: MangledId
v'' = MangledId -> MangledId
forall i. Identifiable i => i -> i
normalizeId (MangledId
v MangledId -> MangledId -> MangledId
forall a. Semigroup a => a -> a -> a
<> MangledId
"__" MangledId -> MangledId -> MangledId
forall a. Semigroup a => a -> a -> a
<> String -> MangledId
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show Int
i))
     in if MangledId -> Bool
alreadyInUse MangledId
v'' then Int -> MangledId
pick (Int -> MangledId) -> Int -> MangledId
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else MangledId
v''

  alreadyInUse :: I.VarId -> Bool
  alreadyInUse :: MangledId -> Bool
alreadyInUse = (MangledId -> Map MangledId t -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map MangledId t
globals)


data MangleCtx = MangleCtx
  { MangleCtx -> Map MangledId MangledId
localScope :: M.Map OriginId MangledId
  , MangleCtx -> SymTable Type
globalScope :: I.SymTable I.Type
  }


-- | Mangling monad
newtype Mangle a = Mangle (StateT MangleCtx Compiler.Pass a)
  deriving (a -> Mangle b -> Mangle a
(a -> b) -> Mangle a -> Mangle b
(forall a b. (a -> b) -> Mangle a -> Mangle b)
-> (forall a b. a -> Mangle b -> Mangle a) -> Functor Mangle
forall a b. a -> Mangle b -> Mangle a
forall a b. (a -> b) -> Mangle a -> Mangle b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Mangle b -> Mangle a
$c<$ :: forall a b. a -> Mangle b -> Mangle a
fmap :: (a -> b) -> Mangle a -> Mangle b
$cfmap :: forall a b. (a -> b) -> Mangle a -> Mangle b
Functor) via (StateT MangleCtx Compiler.Pass)
  deriving (Functor Mangle
a -> Mangle a
Functor Mangle
-> (forall a. a -> Mangle a)
-> (forall a b. Mangle (a -> b) -> Mangle a -> Mangle b)
-> (forall a b c.
    (a -> b -> c) -> Mangle a -> Mangle b -> Mangle c)
-> (forall a b. Mangle a -> Mangle b -> Mangle b)
-> (forall a b. Mangle a -> Mangle b -> Mangle a)
-> Applicative Mangle
Mangle a -> Mangle b -> Mangle b
Mangle a -> Mangle b -> Mangle a
Mangle (a -> b) -> Mangle a -> Mangle b
(a -> b -> c) -> Mangle a -> Mangle b -> Mangle c
forall a. a -> Mangle a
forall a b. Mangle a -> Mangle b -> Mangle a
forall a b. Mangle a -> Mangle b -> Mangle b
forall a b. Mangle (a -> b) -> Mangle a -> Mangle b
forall a b c. (a -> b -> c) -> Mangle a -> Mangle b -> Mangle c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Mangle a -> Mangle b -> Mangle a
$c<* :: forall a b. Mangle a -> Mangle b -> Mangle a
*> :: Mangle a -> Mangle b -> Mangle b
$c*> :: forall a b. Mangle a -> Mangle b -> Mangle b
liftA2 :: (a -> b -> c) -> Mangle a -> Mangle b -> Mangle c
$cliftA2 :: forall a b c. (a -> b -> c) -> Mangle a -> Mangle b -> Mangle c
<*> :: Mangle (a -> b) -> Mangle a -> Mangle b
$c<*> :: forall a b. Mangle (a -> b) -> Mangle a -> Mangle b
pure :: a -> Mangle a
$cpure :: forall a. a -> Mangle a
$cp1Applicative :: Functor Mangle
Applicative) via (StateT MangleCtx Compiler.Pass)
  deriving (Applicative Mangle
a -> Mangle a
Applicative Mangle
-> (forall a b. Mangle a -> (a -> Mangle b) -> Mangle b)
-> (forall a b. Mangle a -> Mangle b -> Mangle b)
-> (forall a. a -> Mangle a)
-> Monad Mangle
Mangle a -> (a -> Mangle b) -> Mangle b
Mangle a -> Mangle b -> Mangle b
forall a. a -> Mangle a
forall a b. Mangle a -> Mangle b -> Mangle b
forall a b. Mangle a -> (a -> Mangle b) -> Mangle b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Mangle a
$creturn :: forall a. a -> Mangle a
>> :: Mangle a -> Mangle b -> Mangle b
$c>> :: forall a b. Mangle a -> Mangle b -> Mangle b
>>= :: Mangle a -> (a -> Mangle b) -> Mangle b
$c>>= :: forall a b. Mangle a -> (a -> Mangle b) -> Mangle b
$cp1Monad :: Applicative Mangle
Monad) via (StateT MangleCtx Compiler.Pass)
  deriving (Monad Mangle
Monad Mangle -> (forall a. String -> Mangle a) -> MonadFail Mangle
String -> Mangle a
forall a. String -> Mangle a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> Mangle a
$cfail :: forall a. String -> Mangle a
$cp1MonadFail :: Monad Mangle
MonadFail) via (StateT MangleCtx Compiler.Pass)
  deriving (MonadError Compiler.Error) via (StateT MangleCtx Compiler.Pass)
  deriving (MonadState MangleCtx) via (StateT MangleCtx Compiler.Pass)


runMangle :: Mangle a -> Compiler.Pass a
runMangle :: Mangle a -> Pass a
runMangle (Mangle StateT MangleCtx Pass a
m) =
  StateT MangleCtx Pass a -> MangleCtx -> Pass a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT MangleCtx Pass a
m MangleCtx :: Map MangledId MangledId -> SymTable Type -> MangleCtx
MangleCtx{localScope :: Map MangledId MangledId
localScope = Map MangledId MangledId
forall k a. Map k a
M.empty, globalScope :: SymTable Type
globalScope = SymTable Type
forall k a. Map k a
M.empty}


withLocals :: [(OriginId, MangledId)] -> Mangle a -> Mangle a
withLocals :: [(MangledId, MangledId)] -> Mangle a -> Mangle a
withLocals [(MangledId, MangledId)]
vs Mangle a
m = do
  Map MangledId MangledId
locals <- (MangleCtx -> Map MangledId MangledId)
-> Mangle (Map MangledId MangledId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MangleCtx -> Map MangledId MangledId
localScope
  (MangleCtx -> MangleCtx) -> Mangle ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MangleCtx -> MangleCtx) -> Mangle ())
-> (MangleCtx -> MangleCtx) -> Mangle ()
forall a b. (a -> b) -> a -> b
$ \MangleCtx
st -> MangleCtx
st{localScope :: Map MangledId MangledId
localScope = [(MangledId, MangledId)] -> Map MangledId MangledId
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(MangledId, MangledId)]
vs Map MangledId MangledId
-> Map MangledId MangledId -> Map MangledId MangledId
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MangledId MangledId
locals}
  a
a <- Mangle a
m
  (MangleCtx -> MangleCtx) -> Mangle ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MangleCtx -> MangleCtx) -> Mangle ())
-> (MangleCtx -> MangleCtx) -> Mangle ()
forall a b. (a -> b) -> a -> b
$ \MangleCtx
st -> MangleCtx
st{localScope :: Map MangledId MangledId
localScope = Map MangledId MangledId
locals}
  a -> Mangle a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a


tellGlobal :: I.VarId -> I.SymInfo I.Type -> Mangle ()
tellGlobal :: MangledId -> SymInfo Type -> Mangle ()
tellGlobal MangledId
v SymInfo Type
i = do
  (MangleCtx -> MangleCtx) -> Mangle ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MangleCtx -> MangleCtx) -> Mangle ())
-> (MangleCtx -> MangleCtx) -> Mangle ()
forall a b. (a -> b) -> a -> b
$ \MangleCtx
st -> MangleCtx
st{globalScope :: SymTable Type
globalScope = MangledId -> SymInfo Type -> SymTable Type -> SymTable Type
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert MangledId
v SymInfo Type
i (SymTable Type -> SymTable Type) -> SymTable Type -> SymTable Type
forall a b. (a -> b) -> a -> b
$ MangleCtx -> SymTable Type
globalScope MangleCtx
st}


withMangled :: [I.Binder I.Type] -> Mangle a -> Mangle ([I.Binder I.Type], a)
withMangled :: [Binder Type] -> Mangle a -> Mangle ([Binder Type], a)
withMangled [Binder Type]
vs Mangle a
m = do
  [(Binder Type, Maybe (SymInfo Type))]
vs' <- (Binder Type -> Mangle (Binder Type, Maybe (SymInfo Type)))
-> [Binder Type] -> Mangle [(Binder Type, Maybe (SymInfo Type))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Binder Type -> Mangle (Binder Type, Maybe (SymInfo Type))
pickBinder [Binder Type]
vs
  [(MangledId, MangledId)]
-> Mangle ([Binder Type], a) -> Mangle ([Binder Type], a)
forall a. [(MangledId, MangledId)] -> Mangle a -> Mangle a
withLocals (((Binder Type, Maybe (SymInfo Type))
 -> Maybe (MangledId, MangledId))
-> [(Binder Type, Maybe (SymInfo Type))]
-> [(MangledId, MangledId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Binder Type, Maybe (SymInfo Type)) -> Maybe (MangledId, MangledId)
toLocal [(Binder Type, Maybe (SymInfo Type))]
vs') (Mangle ([Binder Type], a) -> Mangle ([Binder Type], a))
-> Mangle ([Binder Type], a) -> Mangle ([Binder Type], a)
forall a b. (a -> b) -> a -> b
$ do
    a
a <- Mangle a
m
    ([Binder Type], a) -> Mangle ([Binder Type], a)
forall (m :: * -> *) a. Monad m => a -> m a
return (((Binder Type, Maybe (SymInfo Type)) -> Binder Type)
-> [(Binder Type, Maybe (SymInfo Type))] -> [Binder Type]
forall a b. (a -> b) -> [a] -> [b]
map (Binder Type, Maybe (SymInfo Type)) -> Binder Type
forall a b. (a, b) -> a
fst [(Binder Type, Maybe (SymInfo Type))]
vs', a
a)
 where
  pickBinder :: I.Binder I.Type -> Mangle (I.Binder I.Type, Maybe (I.SymInfo I.Type))
  pickBinder :: Binder Type -> Mangle (Binder Type, Maybe (SymInfo Type))
pickBinder (I.BindVar MangledId
v Type
t) = do
    SymTable Type
globals <- (MangleCtx -> SymTable Type) -> Mangle (SymTable Type)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MangleCtx -> SymTable Type
globalScope
    let v' :: MangledId
v' = SymTable Type -> MangledId -> MangledId
forall t. Map MangledId t -> MangledId -> MangledId
pickId SymTable Type
globals MangledId
v
        info :: SymInfo Type
info = SymInfo :: forall t. MangledId -> t -> SymInfo t
I.SymInfo{symOrigin :: MangledId
I.symOrigin = MangledId
v, symType :: Type
I.symType = Type
t}
    MangledId -> SymInfo Type -> Mangle ()
tellGlobal MangledId
v' SymInfo Type
info
    (Binder Type, Maybe (SymInfo Type))
-> Mangle (Binder Type, Maybe (SymInfo Type))
forall (m :: * -> *) a. Monad m => a -> m a
return (MangledId -> Type -> Binder Type
forall t. MangledId -> t -> Binder t
I.BindVar MangledId
v' Type
t, SymInfo Type -> Maybe (SymInfo Type)
forall a. a -> Maybe a
Just SymInfo Type
info)
  pickBinder Binder Type
b = (Binder Type, Maybe (SymInfo Type))
-> Mangle (Binder Type, Maybe (SymInfo Type))
forall (m :: * -> *) a. Monad m => a -> m a
return (Binder Type
b, Maybe (SymInfo Type)
forall a. Maybe a
Nothing)

  toLocal :: (I.Binder I.Type, Maybe (I.SymInfo I.Type)) -> Maybe (OriginId, MangledId)
  toLocal :: (Binder Type, Maybe (SymInfo Type)) -> Maybe (MangledId, MangledId)
toLocal (I.BindVar MangledId
v Type
_, Just SymInfo Type
info) = (MangledId, MangledId) -> Maybe (MangledId, MangledId)
forall a. a -> Maybe a
Just (SymInfo Type -> MangledId
forall t. SymInfo t -> MangledId
I.symOrigin SymInfo Type
info, MangledId
v)
  toLocal (Binder Type, Maybe (SymInfo Type))
_ = Maybe (MangledId, MangledId)
forall a. Maybe a
Nothing


mangleProgram :: I.Program I.Type -> Compiler.Pass (I.Program I.Type)
mangleProgram :: Program Type -> Pass (Program Type)
mangleProgram Program Type
p = Mangle (Program Type) -> Pass (Program Type)
forall a. Mangle a -> Pass a
runMangle (Mangle (Program Type) -> Pass (Program Type))
-> Mangle (Program Type) -> Pass (Program Type)
forall a b. (a -> b) -> a -> b
$ do
  [(MangledId, MangledId)]
eds <- [(MangledId, Type)]
-> ((MangledId, Type) -> Mangle (MangledId, MangledId))
-> Mangle [(MangledId, MangledId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Program Type -> [(MangledId, Type)]
forall t. Program t -> [(MangledId, Type)]
I.externDecls Program Type
p) (((MangledId, Type) -> Mangle (MangledId, MangledId))
 -> Mangle [(MangledId, MangledId)])
-> ((MangledId, Type) -> Mangle (MangledId, MangledId))
-> Mangle [(MangledId, MangledId)]
forall a b. (a -> b) -> a -> b
$ \(MangledId
v, Type
t) -> do
    let info :: SymInfo Type
info = SymInfo :: forall t. MangledId -> t -> SymInfo t
I.SymInfo{symOrigin :: MangledId
I.symOrigin = MangledId
v, symType :: Type
I.symType = Type
t}
    MangledId -> SymInfo Type -> Mangle ()
tellGlobal MangledId
v SymInfo Type
info
    (MangledId, MangledId) -> Mangle (MangledId, MangledId)
forall (m :: * -> *) a. Monad m => a -> m a
return (MangledId
v, MangledId
v)
  [(MangledId, MangledId)]
-> Mangle (Program Type) -> Mangle (Program Type)
forall a. [(MangledId, MangledId)] -> Mangle a -> Mangle a
withLocals [(MangledId, MangledId)]
eds (Mangle (Program Type) -> Mangle (Program Type))
-> Mangle (Program Type) -> Mangle (Program Type)
forall a b. (a -> b) -> a -> b
$ do
    let ([Binder Type]
tvs, [Expr Type]
tes) = [(Binder Type, Expr Type)] -> ([Binder Type], [Expr Type])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Binder Type, Expr Type)] -> ([Binder Type], [Expr Type]))
-> [(Binder Type, Expr Type)] -> ([Binder Type], [Expr Type])
forall a b. (a -> b) -> a -> b
$ Program Type -> [(Binder Type, Expr Type)]
forall t. Program t -> [(Binder t, Expr t)]
I.programDefs Program Type
p
    ([Binder Type]
tvs', [Expr Type]
tes') <- [Binder Type]
-> Mangle [Expr Type] -> Mangle ([Binder Type], [Expr Type])
forall a. [Binder Type] -> Mangle a -> Mangle ([Binder Type], a)
withMangled [Binder Type]
tvs (Mangle [Expr Type] -> Mangle ([Binder Type], [Expr Type]))
-> Mangle [Expr Type] -> Mangle ([Binder Type], [Expr Type])
forall a b. (a -> b) -> a -> b
$ (Expr Type -> Mangle (Expr Type))
-> [Expr Type] -> Mangle [Expr Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Type -> Mangle (Expr Type)
mangleExpr [Expr Type]
tes
    SymTable Type
names <- (MangleCtx -> SymTable Type) -> Mangle (SymTable Type)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MangleCtx -> SymTable Type
globalScope
    Program Type -> Mangle (Program Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Program Type
p{programDefs :: [(Binder Type, Expr Type)]
I.programDefs = [Binder Type] -> [Expr Type] -> [(Binder Type, Expr Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Binder Type]
tvs' [Expr Type]
tes', symTable :: SymTable Type
I.symTable = SymTable Type
names}


mangleExpr :: I.Expr I.Type -> Mangle (I.Expr I.Type)
mangleExpr :: Expr Type -> Mangle (Expr Type)
mangleExpr (I.Var MangledId
i Type
t) = do
  Maybe MangledId
mv <- (MangleCtx -> Maybe MangledId) -> Mangle (Maybe MangledId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (MangledId -> Map MangledId MangledId -> Maybe MangledId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MangledId
i (Map MangledId MangledId -> Maybe MangledId)
-> (MangleCtx -> Map MangledId MangledId)
-> MangleCtx
-> Maybe MangledId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MangleCtx -> Map MangledId MangledId
localScope)
  MangledId -> Type -> Expr Type
forall t. MangledId -> t -> Expr t
I.Var (MangledId -> Type -> Expr Type)
-> Mangle MangledId -> Mangle (Type -> Expr Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mangle MangledId
-> (MangledId -> Mangle MangledId)
-> Maybe MangledId
-> Mangle MangledId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mangle MangledId
forall a. Mangle a
err MangledId -> Mangle MangledId
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MangledId
mv Mangle (Type -> Expr Type) -> Mangle Type -> Mangle (Expr Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Mangle Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
 where
  err :: Mangle a
err = String -> Mangle a
forall (m :: * -> *) a. MonadError Error m => String -> m a
Compiler.unexpected (String -> Mangle a) -> String -> Mangle a
forall a b. (a -> b) -> a -> b
$ String
"MangleNames: Could not find I.Var " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> MangledId -> String
forall a. Show a => a -> String
show MangledId
i
mangleExpr e :: Expr Type
e@(I.Data DConId
_ Type
_) = Expr Type -> Mangle (Expr Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Type
e
mangleExpr e :: Expr Type
e@(I.Lit Literal
_ Type
_) = Expr Type -> Mangle (Expr Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Type
e
mangleExpr (I.App Expr Type
f Expr Type
a Type
t) = Expr Type -> Expr Type -> Type -> Expr Type
forall t. Expr t -> Expr t -> t -> Expr t
I.App (Expr Type -> Expr Type -> Type -> Expr Type)
-> Mangle (Expr Type) -> Mangle (Expr Type -> Type -> Expr Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Type -> Mangle (Expr Type)
mangleExpr Expr Type
f Mangle (Expr Type -> Type -> Expr Type)
-> Mangle (Expr Type) -> Mangle (Type -> Expr Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Type -> Mangle (Expr Type)
mangleExpr Expr Type
a Mangle (Type -> Expr Type) -> Mangle Type -> Mangle (Expr Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Mangle Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
mangleExpr (I.Let ([(Binder Type, Expr Type)] -> ([Binder Type], [Expr Type])
forall a b. [(a, b)] -> ([a], [b])
unzip -> ([Binder Type]
vs, [Expr Type]
ds)) Expr Type
b Type
t) = do
  ([Binder Type]
vs', ([Expr Type]
ds', Expr Type
b')) <-
    [Binder Type]
-> Mangle ([Expr Type], Expr Type)
-> Mangle ([Binder Type], ([Expr Type], Expr Type))
forall a. [Binder Type] -> Mangle a -> Mangle ([Binder Type], a)
withMangled [Binder Type]
vs (Mangle ([Expr Type], Expr Type)
 -> Mangle ([Binder Type], ([Expr Type], Expr Type)))
-> Mangle ([Expr Type], Expr Type)
-> Mangle ([Binder Type], ([Expr Type], Expr Type))
forall a b. (a -> b) -> a -> b
$ (,) ([Expr Type] -> Expr Type -> ([Expr Type], Expr Type))
-> Mangle [Expr Type]
-> Mangle (Expr Type -> ([Expr Type], Expr Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr Type -> Mangle (Expr Type))
-> [Expr Type] -> Mangle [Expr Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Type -> Mangle (Expr Type)
mangleExpr [Expr Type]
ds Mangle (Expr Type -> ([Expr Type], Expr Type))
-> Mangle (Expr Type) -> Mangle ([Expr Type], Expr Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Type -> Mangle (Expr Type)
mangleExpr Expr Type
b
  Expr Type -> Mangle (Expr Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Type -> Mangle (Expr Type))
-> Expr Type -> Mangle (Expr Type)
forall a b. (a -> b) -> a -> b
$ [(Binder Type, Expr Type)] -> Expr Type -> Type -> Expr Type
forall t. [(Binder t, Expr t)] -> Expr t -> t -> Expr t
I.Let ([Binder Type] -> [Expr Type] -> [(Binder Type, Expr Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Binder Type]
vs' [Expr Type]
ds') Expr Type
b' Type
t
mangleExpr (I.Lambda Binder Type
i Expr Type
b Type
t) = do
  ([Binder Type
i'], Expr Type
b') <- [Binder Type]
-> Mangle (Expr Type) -> Mangle ([Binder Type], Expr Type)
forall a. [Binder Type] -> Mangle a -> Mangle ([Binder Type], a)
withMangled [Binder Type
i] (Mangle (Expr Type) -> Mangle ([Binder Type], Expr Type))
-> Mangle (Expr Type) -> Mangle ([Binder Type], Expr Type)
forall a b. (a -> b) -> a -> b
$ Expr Type -> Mangle (Expr Type)
mangleExpr Expr Type
b
  Expr Type -> Mangle (Expr Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Type -> Mangle (Expr Type))
-> Expr Type -> Mangle (Expr Type)
forall a b. (a -> b) -> a -> b
$ Binder Type -> Expr Type -> Type -> Expr Type
forall t. Binder t -> Expr t -> t -> Expr t
I.Lambda Binder Type
i' Expr Type
b' Type
t
mangleExpr (I.Match Expr Type
s [(Alt Type, Expr Type)]
as Type
t) = do
  Expr Type
s' <- Expr Type -> Mangle (Expr Type)
mangleExpr Expr Type
s
  [(Alt Type, Expr Type)]
as' <- ((Alt Type, Expr Type) -> Mangle (Alt Type, Expr Type))
-> [(Alt Type, Expr Type)] -> Mangle [(Alt Type, Expr Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Alt Type, Expr Type) -> Mangle (Alt Type, Expr Type)
mangleArm [(Alt Type, Expr Type)]
as
  Expr Type -> Mangle (Expr Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Type -> Mangle (Expr Type))
-> Expr Type -> Mangle (Expr Type)
forall a b. (a -> b) -> a -> b
$ Expr Type -> [(Alt Type, Expr Type)] -> Type -> Expr Type
forall t. Expr t -> [(Alt t, Expr t)] -> t -> Expr t
I.Match Expr Type
s' [(Alt Type, Expr Type)]
as' Type
t
mangleExpr (I.Prim Primitive
p [Expr Type]
es Type
t) = Primitive -> [Expr Type] -> Type -> Expr Type
forall t. Primitive -> [Expr t] -> t -> Expr t
I.Prim Primitive
p ([Expr Type] -> Type -> Expr Type)
-> Mangle [Expr Type] -> Mangle (Type -> Expr Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr Type -> Mangle (Expr Type))
-> [Expr Type] -> Mangle [Expr Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr Type -> Mangle (Expr Type)
mangleExpr [Expr Type]
es Mangle (Type -> Expr Type) -> Mangle Type -> Mangle (Expr Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Mangle Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
mangleExpr e :: Expr Type
e@I.Exception{} = Expr Type -> Mangle (Expr Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Expr Type
e


mangleArm :: (I.Alt I.Type, I.Expr I.Type) -> Mangle (I.Alt I.Type, I.Expr I.Type)
mangleArm :: (Alt Type, Expr Type) -> Mangle (Alt Type, Expr Type)
mangleArm (Alt Type
alt, Expr Type
ex) = do
  ([Binder Type], (Alt Type, Expr Type)) -> (Alt Type, Expr Type)
forall a b. (a, b) -> b
snd
    (([Binder Type], (Alt Type, Expr Type)) -> (Alt Type, Expr Type))
-> Mangle ([Binder Type], (Alt Type, Expr Type))
-> Mangle (Alt Type, Expr Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binder Type]
-> Mangle (Alt Type, Expr Type)
-> Mangle ([Binder Type], (Alt Type, Expr Type))
forall a. [Binder Type] -> Mangle a -> Mangle ([Binder Type], a)
withMangled
      (Alt Type -> [Binder Type]
forall t. Alt t -> [Binder t]
I.altBinders Alt Type
alt)
      ((,) (Alt Type -> Expr Type -> (Alt Type, Expr Type))
-> Mangle (Alt Type) -> Mangle (Expr Type -> (Alt Type, Expr Type))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Alt Type -> Mangle (Alt Type)
mangleAlt Alt Type
alt Mangle (Expr Type -> (Alt Type, Expr Type))
-> Mangle (Expr Type) -> Mangle (Alt Type, Expr Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Type -> Mangle (Expr Type)
mangleExpr Expr Type
ex)
 where
  mangleAlt :: Alt Type -> Mangle (Alt Type)
mangleAlt (I.AltData DConId
d [Alt Type]
bs Type
t) = DConId -> [Alt Type] -> Type -> Alt Type
forall t. DConId -> [Alt t] -> t -> Alt t
I.AltData DConId
d ([Alt Type] -> Type -> Alt Type)
-> Mangle [Alt Type] -> Mangle (Type -> Alt Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Alt Type -> Mangle (Alt Type)) -> [Alt Type] -> Mangle [Alt Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Alt Type -> Mangle (Alt Type)
mangleAlt [Alt Type]
bs Mangle (Type -> Alt Type) -> Mangle Type -> Mangle (Alt Type)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> Mangle Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
t
  mangleAlt a :: Alt Type
a@(I.AltLit Literal
_ Type
_) = Alt Type -> Mangle (Alt Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Alt Type
a
  mangleAlt (I.AltBinder Binder Type
b) = Binder Type -> Alt Type
forall t. Binder t -> Alt t
I.AltBinder (Binder Type -> Alt Type)
-> Mangle (Binder Type) -> Mangle (Alt Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Binder Type -> Mangle (Binder Type)
lookupBinder Binder Type
b

  lookupBinder :: I.Binder I.Type -> Mangle (I.Binder I.Type)
  lookupBinder :: Binder Type -> Mangle (Binder Type)
lookupBinder (I.BindVar MangledId
i Type
t) = do
    Maybe MangledId
mi' <- (MangleCtx -> Maybe MangledId) -> Mangle (Maybe MangledId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((MangleCtx -> Maybe MangledId) -> Mangle (Maybe MangledId))
-> (MangleCtx -> Maybe MangledId) -> Mangle (Maybe MangledId)
forall a b. (a -> b) -> a -> b
$ MangledId -> Map MangledId MangledId -> Maybe MangledId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MangledId
i (Map MangledId MangledId -> Maybe MangledId)
-> (MangleCtx -> Map MangledId MangledId)
-> MangleCtx
-> Maybe MangledId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MangleCtx -> Map MangledId MangledId
localScope
    MangledId
i' <- Mangle MangledId
-> (MangledId -> Mangle MangledId)
-> Maybe MangledId
-> Mangle MangledId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mangle MangledId
forall a. Mangle a
err MangledId -> Mangle MangledId
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MangledId
mi'
    Binder Type -> Mangle (Binder Type)
forall (m :: * -> *) a. Monad m => a -> m a
return (Binder Type -> Mangle (Binder Type))
-> Binder Type -> Mangle (Binder Type)
forall a b. (a -> b) -> a -> b
$ MangledId -> Type -> Binder Type
forall t. MangledId -> t -> Binder t
I.BindVar MangledId
i' Type
t
   where
    err :: Mangle a
err = String -> Mangle a
forall (m :: * -> *) a. MonadError Error m => String -> m a
Compiler.unexpected (String -> Mangle a) -> String -> Mangle a
forall a b. (a -> b) -> a -> b
$ String
"mangleAlt: Could not find I.Var " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> MangledId -> String
forall a. Show a => a -> String
show MangledId
i
  lookupBinder Binder Type
b = Binder Type -> Mangle (Binder Type)
forall (m :: * -> *) a. Monad m => a -> m a
return Binder Type
b