{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts  #-}

-- | Unique names.

module Gibbon.Passes.Freshen (freshNames, freshNames1, freshExp, freshExp1, freshFun1) where

import           Control.Exception
import           Data.Foldable ( foldrM )
import           Prelude hiding (exp)
import qualified Data.List as L
import qualified Data.Map as M

import           Gibbon.Common
import           Gibbon.L0.Syntax
import qualified Gibbon.L1.Syntax as L1

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

type VarEnv     = M.Map Var Var
type TyVarEnv t = M.Map TyVar t

freshNames :: Prog0 -> PassM Prog0
freshNames :: Prog0 -> PassM Prog0
freshNames (Prog DDefs (TyOf Exp0)
defs FunDefs Exp0
funs Maybe (Exp0, TyOf Exp0)
main) =
    do Maybe (Exp0, Ty0)
main' <- case Maybe (Exp0, TyOf Exp0)
main of
                  Maybe (Exp0, TyOf Exp0)
Nothing -> Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0))
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Exp0, Ty0)
forall a. Maybe a
Nothing
                  Just (Exp0
m,TyOf Exp0
ty) -> do Exp0
m' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
forall k a. Map k a
M.empty TyVarEnv Ty0
forall k a. Map k a
M.empty Exp0
m
                                    Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0))
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0)))
-> Maybe (Exp0, Ty0) -> PassM (Maybe (Exp0, Ty0))
forall a b. (a -> b) -> a -> b
$ (Exp0, Ty0) -> Maybe (Exp0, Ty0)
forall a. a -> Maybe a
Just (Exp0
m',TyOf Exp0
Ty0
ty)
       Map Var (DDef Ty0)
defs' <- (DDef Ty0 -> PassM (DDef Ty0))
-> Map Var (DDef Ty0) -> PassM (Map Var (DDef Ty0))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Var a -> f (Map Var b)
traverse DDef Ty0 -> PassM (DDef Ty0)
freshDDef DDefs (TyOf Exp0)
Map Var (DDef Ty0)
defs
       FunDefs Exp0
funs' <- (Var -> Var) -> FunDefs Exp0 -> FunDefs Exp0
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys Var -> Var
cleanFunName (FunDefs Exp0 -> FunDefs Exp0)
-> PassM (FunDefs Exp0) -> PassM (FunDefs Exp0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FunDef Exp0 -> PassM (FunDef Exp0))
-> FunDefs Exp0 -> PassM (FunDefs Exp0)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Var a -> f (Map Var b)
traverse FunDef Exp0 -> PassM (FunDef Exp0)
freshFun FunDefs Exp0
funs
       Prog0 -> PassM Prog0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prog0 -> PassM Prog0) -> Prog0 -> PassM Prog0
forall a b. (a -> b) -> a -> b
$ DDefs (TyOf Exp0)
-> FunDefs Exp0 -> Maybe (Exp0, TyOf Exp0) -> Prog0
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
Prog DDefs (TyOf Exp0)
Map Var (DDef Ty0)
defs' FunDefs Exp0
funs' Maybe (Exp0, TyOf Exp0)
Maybe (Exp0, Ty0)
main'

freshDDef :: DDef Ty0 -> PassM (DDef Ty0)
freshDDef :: DDef Ty0 -> PassM (DDef Ty0)
freshDDef DDef{Var
tyName :: Var
tyName :: forall a. DDef a -> Var
tyName,[TyVar]
tyArgs :: [TyVar]
tyArgs :: forall a. DDef a -> [TyVar]
tyArgs,[(DataCon, [(IsBoxed, Ty0)])]
dataCons :: [(DataCon, [(IsBoxed, Ty0)])]
dataCons :: forall a. DDef a -> [(DataCon, [(IsBoxed, a)])]
dataCons} = do
  [TyVar]
rigid_tyvars <- (TyVar -> PassM TyVar) -> [TyVar] -> PassM [TyVar]
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 (\(UserTv Var
v) -> Var -> TyVar
BoundTv (Var -> TyVar) -> PassM Var -> PassM TyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
v) [TyVar]
tyArgs
  let env :: TyVarEnv Ty0
      env :: TyVarEnv Ty0
env = [(TyVar, Ty0)] -> TyVarEnv Ty0
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(TyVar, Ty0)] -> TyVarEnv Ty0) -> [(TyVar, Ty0)] -> TyVarEnv Ty0
forall a b. (a -> b) -> a -> b
$ [TyVar] -> [Ty0] -> [(TyVar, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TyVar]
tyArgs ((TyVar -> Ty0) -> [TyVar] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> Ty0
TyVar [TyVar]
rigid_tyvars)
  [(DataCon, [(IsBoxed, Ty0)])]
dataCons' <- ((DataCon, [(IsBoxed, Ty0)]) -> PassM (DataCon, [(IsBoxed, Ty0)]))
-> [(DataCon, [(IsBoxed, Ty0)])]
-> PassM [(DataCon, [(IsBoxed, Ty0)])]
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 (\(DataCon
dcon,[(IsBoxed, Ty0)]
vs) -> (DataCon
dcon,) ([(IsBoxed, Ty0)] -> (DataCon, [(IsBoxed, Ty0)]))
-> PassM [(IsBoxed, Ty0)] -> PassM (DataCon, [(IsBoxed, Ty0)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((IsBoxed, Ty0) -> PassM (IsBoxed, Ty0))
-> [(IsBoxed, Ty0)] -> PassM [(IsBoxed, Ty0)]
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 (DataCon
-> [TyVar]
-> TyVarEnv Ty0
-> (IsBoxed, Ty0)
-> PassM (IsBoxed, Ty0)
forall t.
DataCon -> [TyVar] -> TyVarEnv Ty0 -> (t, Ty0) -> PassM (t, Ty0)
go ((DataCon, [(IsBoxed, Ty0)]) -> DataCon
forall a. Out a => a -> DataCon
sdoc (DataCon
dcon,[(IsBoxed, Ty0)]
vs)) [TyVar]
rigid_tyvars TyVarEnv Ty0
env) [(IsBoxed, Ty0)]
vs) [(DataCon, [(IsBoxed, Ty0)])]
dataCons
  DDef Ty0 -> PassM (DDef Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Var -> [TyVar] -> [(DataCon, [(IsBoxed, Ty0)])] -> DDef Ty0
forall a. Var -> [TyVar] -> [(DataCon, [(IsBoxed, a)])] -> DDef a
DDef Var
tyName [TyVar]
rigid_tyvars [(DataCon, [(IsBoxed, Ty0)])]
dataCons')
  where
    go :: String -> [TyVar] -> TyVarEnv Ty0 -> (t, Ty0) -> PassM (t, Ty0)
    go :: forall t.
DataCon -> [TyVar] -> TyVarEnv Ty0 -> (t, Ty0) -> PassM (t, Ty0)
go DataCon
msg [TyVar]
bound TyVarEnv Ty0
env (t
b, Ty0
ty) = do
      (TyVarEnv Ty0
_, Ty0
ty') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env Ty0
ty
      let free_tvs :: [TyVar]
free_tvs = Ty0 -> [TyVar]
tyVarsInTy Ty0
ty' [TyVar] -> [TyVar] -> [TyVar]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [TyVar]
bound
      if [TyVar]
free_tvs [TyVar] -> [TyVar] -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
== []
      then (t, Ty0) -> PassM (t, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
b, Ty0
ty')
      else DataCon -> PassM (t, Ty0)
forall a. HasCallStack => DataCon -> a
error (DataCon -> PassM (t, Ty0)) -> DataCon -> PassM (t, Ty0)
forall a b. (a -> b) -> a -> b
$ DataCon
"freshDDef: Unbound type variables " DataCon -> DataCon -> DataCon
forall a. [a] -> [a] -> [a]
++ [TyVar] -> DataCon
forall a. Out a => a -> DataCon
sdoc [TyVar]
free_tvs
                   DataCon -> DataCon -> DataCon
forall a. [a] -> [a] -> [a]
++ DataCon
" in the constructor:\n" DataCon -> DataCon -> DataCon
forall a. [a] -> [a] -> [a]
++ DataCon
msg

freshFun :: FunDef Exp0 -> PassM (FunDef Exp0)
freshFun :: FunDef Exp0 -> PassM (FunDef Exp0)
freshFun (FunDef Var
nam [Var]
nargs ArrowTy (TyOf Exp0)
funty Exp0
bod FunMeta
meta) =
    do [Var]
nargs' <- (Var -> PassM Var) -> [Var] -> PassM [Var]
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 Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym [Var]
nargs
       let msubst :: VarEnv
msubst = ([(Var, Var)] -> VarEnv
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, Var)] -> VarEnv) -> [(Var, Var)] -> VarEnv
forall a b. (a -> b) -> a -> b
$ [Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
nargs [Var]
nargs')
       (TyVarEnv Ty0
tvenv, TyScheme
funty') <- TyScheme -> PassM (TyVarEnv Ty0, TyScheme)
freshTyScheme ArrowTy (TyOf Exp0)
TyScheme
funty
       TyScheme
funty'' <- VarEnv -> TyScheme -> PassM TyScheme
forall (m :: * -> *). Monad m => VarEnv -> TyScheme -> m TyScheme
freshDictTyScheme VarEnv
msubst TyScheme
funty'
       Exp0
bod' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
msubst TyVarEnv Ty0
tvenv Exp0
bod
       let nam' :: Var
nam' = Var -> Var
cleanFunName Var
nam
       FunDef Exp0 -> PassM (FunDef Exp0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FunDef Exp0 -> PassM (FunDef Exp0))
-> FunDef Exp0 -> PassM (FunDef Exp0)
forall a b. (a -> b) -> a -> b
$ Var
-> [Var] -> ArrowTy (TyOf Exp0) -> Exp0 -> FunMeta -> FunDef Exp0
forall ex.
Var -> [Var] -> ArrowTy (TyOf ex) -> ex -> FunMeta -> FunDef ex
FunDef Var
nam' [Var]
nargs' ArrowTy (TyOf Exp0)
TyScheme
funty'' Exp0
bod' FunMeta
meta

--
freshTyScheme :: TyScheme -> PassM (TyVarEnv Ty0, TyScheme)
freshTyScheme :: TyScheme -> PassM (TyVarEnv Ty0, TyScheme)
freshTyScheme (ForAll [TyVar]
tvs Ty0
ty) = do
  [TyVar]
rigid_tyvars <- (TyVar -> PassM TyVar) -> [TyVar] -> PassM [TyVar]
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 (\(UserTv Var
v) -> Var -> TyVar
BoundTv (Var -> TyVar) -> PassM Var -> PassM TyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
v) [TyVar]
tvs
  let env :: TyVarEnv Ty0
env = [(TyVar, Ty0)] -> TyVarEnv Ty0
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(TyVar, Ty0)] -> TyVarEnv Ty0) -> [(TyVar, Ty0)] -> TyVarEnv Ty0
forall a b. (a -> b) -> a -> b
$ [TyVar] -> [Ty0] -> [(TyVar, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TyVar]
tvs ((TyVar -> Ty0) -> [TyVar] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> Ty0
TyVar [TyVar]
rigid_tyvars)
  (TyVarEnv Ty0
env', Ty0
ty') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env Ty0
ty
  (TyVarEnv Ty0, TyScheme) -> PassM (TyVarEnv Ty0, TyScheme)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env', [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
rigid_tyvars Ty0
ty')

freshTy :: TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy :: TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env Ty0
ty =
  case Ty0
ty of
     Ty0
IntTy    -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     Ty0
CharTy   -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     Ty0
FloatTy  -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     Ty0
SymTy0   -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     Ty0
BoolTy   -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     Ty0
ArenaTy  -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     Ty0
SymSetTy -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     Ty0
SymHashTy -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     TyVar TyVar
tv -> case TyVar -> TyVarEnv Ty0 -> Maybe Ty0
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TyVar
tv TyVarEnv Ty0
env of
                   Maybe Ty0
Nothing  -> do TyVar
tv' <- PassM TyVar
forall (m :: * -> *). MonadState Int m => m TyVar
newTyVar
                                  (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, TyVar -> Ty0
TyVar TyVar
tv')
                   Just Ty0
tv' -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
tv')
     MetaTv{} -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)
     ProdTy [Ty0]
tys    -> do (TyVarEnv Ty0
env', [Ty0]
tys') <- TyVarEnv (TyOf Exp0)
-> [Ty0] -> PassM (TyVarEnv (TyOf Exp0), [Ty0])
freshTys TyVarEnv (TyOf Exp0)
TyVarEnv Ty0
env [Ty0]
tys
                         (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env', [Ty0] -> Ty0
ProdTy [Ty0]
tys')
     SymDictTy Maybe Var
v Ty0
t   -> do (TyVarEnv Ty0
env', Ty0
t') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env Ty0
t
                           (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env', Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
v Ty0
t')
     PDictTy Ty0
k Ty0
v -> do (TyVarEnv Ty0
env', Ty0
k') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env Ty0
k
                       (TyVarEnv Ty0
env'', Ty0
v') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env' Ty0
v
                       (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env'', Ty0 -> Ty0 -> Ty0
PDictTy Ty0
k' Ty0
v')
     ArrowTy [Ty0]
tys Ty0
t -> do (TyVarEnv Ty0
env', [Ty0]
tys') <- TyVarEnv (TyOf Exp0)
-> [Ty0] -> PassM (TyVarEnv (TyOf Exp0), [Ty0])
freshTys TyVarEnv (TyOf Exp0)
TyVarEnv Ty0
env [Ty0]
tys
                         (TyVarEnv Ty0
env'', [Ty0
t'])  <- TyVarEnv (TyOf Exp0)
-> [Ty0] -> PassM (TyVarEnv (TyOf Exp0), [Ty0])
freshTys TyVarEnv (TyOf Exp0)
TyVarEnv Ty0
env' [Ty0
t]
                         (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env'', [Ty0] -> Ty0 -> Ty0
ArrowTy [Ty0]
tys' Ty0
t')
     PackedTy DataCon
tycon [Ty0]
tys -> do (TyVarEnv Ty0
env', [Ty0]
tys') <- TyVarEnv (TyOf Exp0)
-> [Ty0] -> PassM (TyVarEnv (TyOf Exp0), [Ty0])
freshTys TyVarEnv (TyOf Exp0)
TyVarEnv Ty0
env [Ty0]
tys
                              (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env', DataCon -> [Ty0] -> Ty0
PackedTy DataCon
tycon [Ty0]
tys')
     VectorTy Ty0
el_t -> do (TyVarEnv Ty0
env', Ty0
el_t') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env Ty0
el_t
                         (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env', Ty0 -> Ty0
VectorTy Ty0
el_t')
     ListTy Ty0
el_t -> do (TyVarEnv Ty0
env', Ty0
el_t') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env Ty0
el_t
                       (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env', Ty0 -> Ty0
ListTy Ty0
el_t')
     Ty0
IntHashTy -> (TyVarEnv Ty0, Ty0) -> PassM (TyVarEnv Ty0, Ty0)
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env, Ty0
ty)

freshTys :: TyVarEnv (TyOf Exp0) -> [Ty0] -> PassM (TyVarEnv (TyOf Exp0), [Ty0])
freshTys :: TyVarEnv (TyOf Exp0)
-> [Ty0] -> PassM (TyVarEnv (TyOf Exp0), [Ty0])
freshTys TyVarEnv (TyOf Exp0)
env [Ty0]
tys =
  (Ty0 -> (TyVarEnv Ty0, [Ty0]) -> PassM (TyVarEnv Ty0, [Ty0]))
-> (TyVarEnv Ty0, [Ty0]) -> [Ty0] -> PassM (TyVarEnv Ty0, [Ty0])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM
    (\Ty0
t (TyVarEnv Ty0
env', [Ty0]
acc) -> do
          (TyVarEnv Ty0
env'', Ty0
t') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
env' Ty0
t
          (TyVarEnv Ty0, [Ty0]) -> PassM (TyVarEnv Ty0, [Ty0])
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVarEnv Ty0
env' TyVarEnv Ty0 -> TyVarEnv Ty0 -> TyVarEnv Ty0
forall a. Semigroup a => a -> a -> a
<> TyVarEnv Ty0
env'', Ty0
t' Ty0 -> [Ty0] -> [Ty0]
forall a. a -> [a] -> [a]
: [Ty0]
acc))
    (TyVarEnv (TyOf Exp0)
TyVarEnv Ty0
env, [])
    [Ty0]
tys

freshDictTy :: Monad m => M.Map Var Var -> Ty0 -> m Ty0
freshDictTy :: forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
ty =
    case Ty0
ty of
     Ty0
IntTy    -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     Ty0
CharTy   -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     Ty0
FloatTy  -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     Ty0
SymTy0   -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     Ty0
BoolTy   -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     Ty0
ArenaTy  -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     TyVar TyVar
_tv -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     MetaTv{}  -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     ProdTy [Ty0]
tys ->
         do [Ty0]
tys' <- (Ty0 -> m Ty0) -> [Ty0] -> m [Ty0]
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 (VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m) [Ty0]
tys
            Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Ty0] -> Ty0
ProdTy [Ty0]
tys')
     SymDictTy (Just Var
v) Ty0
t   ->
         do Ty0
t' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
t
            case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
m of
              Just Var
v' -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> m Ty0) -> Ty0 -> m Ty0
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Ty0 -> Ty0
SymDictTy (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
v') Ty0
t'
              Maybe Var
Nothing -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     SymDictTy Maybe Var
Nothing Ty0
t ->
         do Ty0
t' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
t
            Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> m Ty0) -> Ty0 -> m Ty0
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Ty0 -> Ty0
SymDictTy Maybe Var
forall a. Maybe a
Nothing Ty0
t'
     PDictTy Ty0
k Ty0
v ->
         do Ty0
k' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
k
            Ty0
v' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
v
            Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> m Ty0) -> Ty0 -> m Ty0
forall a b. (a -> b) -> a -> b
$ Ty0 -> Ty0 -> Ty0
PDictTy Ty0
k' Ty0
v'
     ArrowTy [Ty0]
tys Ty0
t ->
         do [Ty0]
tys' <- (Ty0 -> m Ty0) -> [Ty0] -> m [Ty0]
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 (VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m) [Ty0]
tys
            Ty0
t' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
t
            Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> m Ty0) -> Ty0 -> m Ty0
forall a b. (a -> b) -> a -> b
$ [Ty0] -> Ty0 -> Ty0
ArrowTy [Ty0]
tys' Ty0
t'
     PackedTy DataCon
tycon [Ty0]
tys ->
         do [Ty0]
tys' <- (Ty0 -> m Ty0) -> [Ty0] -> m [Ty0]
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 (VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m) [Ty0]
tys
            Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> m Ty0) -> Ty0 -> m Ty0
forall a b. (a -> b) -> a -> b
$ DataCon -> [Ty0] -> Ty0
PackedTy DataCon
tycon [Ty0]
tys'
     VectorTy Ty0
el_t ->
         do Ty0
el_t' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
el_t
            Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> m Ty0) -> Ty0 -> m Ty0
forall a b. (a -> b) -> a -> b
$ Ty0 -> Ty0
VectorTy Ty0
el_t'
     ListTy Ty0
el_t ->
         do Ty0
el_t' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
el_t
            Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ty0 -> m Ty0) -> Ty0 -> m Ty0
forall a b. (a -> b) -> a -> b
$ Ty0 -> Ty0
ListTy Ty0
el_t'
     Ty0
SymSetTy  -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     Ty0
SymHashTy -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty
     Ty0
IntHashTy -> Ty0 -> m Ty0
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ty0
ty

freshDictTyScheme :: Monad m =>
                     M.Map Var Var -> TyScheme -> m TyScheme
freshDictTyScheme :: forall (m :: * -> *). Monad m => VarEnv -> TyScheme -> m TyScheme
freshDictTyScheme VarEnv
m (ForAll [TyVar]
tvs Ty0
ty) =
    do Ty0
ty' <- VarEnv -> Ty0 -> m Ty0
forall (m :: * -> *). Monad m => VarEnv -> Ty0 -> m Ty0
freshDictTy VarEnv
m Ty0
ty
       TyScheme -> m TyScheme
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyScheme -> m TyScheme) -> TyScheme -> m TyScheme
forall a b. (a -> b) -> a -> b
$ [TyVar] -> Ty0 -> TyScheme
ForAll [TyVar]
tvs Ty0
ty'

freshExp :: VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp :: VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv TyVarEnv Ty0
tvenv Exp0
exp =
  case Exp0
exp of
    LitE Int
i    -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Int -> Exp0
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
i
    CharE Char
c   -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Char -> Exp0
forall (ext :: * -> * -> *) loc dec. Char -> PreExp ext loc dec
CharE Char
c
    FloatE Double
i  -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Double -> Exp0
forall (ext :: * -> * -> *) loc dec. Double -> PreExp ext loc dec
FloatE Double
i
    LitSymE Var
v -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
LitSymE Var
v

    VarE Var
v ->
      case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
venv of
        Maybe Var
Nothing -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Var
cleanFunName Var
v)
        Just Var
v' -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> Exp0
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE (Var -> Var
cleanFunName Var
v')

    AppE Var
v [Ty0]
locs [Exp0]
ls -> IsBoxed -> PassM Exp0 -> PassM Exp0
forall a. HasCallStack => IsBoxed -> a -> a
assert ([] [Ty0] -> [Ty0] -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
== [Ty0]
locs) (PassM Exp0 -> PassM Exp0) -> PassM Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ do
      [Exp0]
ls' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
ls
      case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
venv of
        Maybe Var
Nothing -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE (Var -> Var
cleanFunName Var
v) [] [Exp0]
ls'
        Just Var
v' -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE (Var -> Var
cleanFunName Var
v') [] [Exp0]
ls'

    PrimAppE Prim Ty0
p [Exp0]
es -> do
      [Exp0]
es' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
es
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Prim Ty0 -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim Ty0
p [Exp0]
es'

    LetE (Var
v,[Ty0]
_locs,Ty0
ty, Exp0
e1) Exp0
e2 -> do
      let user_tvs :: [TyVar]
user_tvs  = (TyVar -> IsBoxed) -> [TyVar] -> [TyVar]
forall a. (a -> IsBoxed) -> [a] -> [a]
filter TyVar -> IsBoxed
isUserTv ([TyVar] -> [TyVar]) -> [TyVar] -> [TyVar]
forall a b. (a -> b) -> a -> b
$ Ty0 -> [TyVar]
tyVarsInTy Ty0
ty
      [TyVar]
rigid_tyvars <- (TyVar -> PassM TyVar) -> [TyVar] -> PassM [TyVar]
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 (\(UserTv Var
w) ->
                                case TyVar -> TyVarEnv Ty0 -> Maybe Ty0
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Var -> TyVar
UserTv Var
w) TyVarEnv Ty0
tvenv of
                                  Just (TyVar TyVar
tv) -> TyVar -> PassM TyVar
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TyVar
tv
                                  Just Ty0
oth -> DataCon -> PassM TyVar
forall a. HasCallStack => DataCon -> a
error (DataCon -> PassM TyVar) -> DataCon -> PassM TyVar
forall a b. (a -> b) -> a -> b
$ DataCon
"freshExp: UserTv bound to: " DataCon -> DataCon -> DataCon
forall a. [a] -> [a] -> [a]
++ Ty0 -> DataCon
forall a. Out a => a -> DataCon
sdoc Ty0
oth
                                  Maybe Ty0
Nothing -> Var -> TyVar
BoundTv (Var -> TyVar) -> PassM Var -> PassM TyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
w)
                           [TyVar]
user_tvs
      let env :: TyVarEnv Ty0
env = [(TyVar, Ty0)] -> TyVarEnv Ty0
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(TyVar, Ty0)] -> TyVarEnv Ty0) -> [(TyVar, Ty0)] -> TyVarEnv Ty0
forall a b. (a -> b) -> a -> b
$ [TyVar] -> [Ty0] -> [(TyVar, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TyVar]
user_tvs ((TyVar -> Ty0) -> [TyVar] -> [Ty0]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> Ty0
TyVar [TyVar]
rigid_tyvars)
          tvenv' :: TyVarEnv Ty0
tvenv' = TyVarEnv Ty0
env TyVarEnv Ty0 -> TyVarEnv Ty0 -> TyVarEnv Ty0
forall a. Semigroup a => a -> a -> a
<> TyVarEnv Ty0
tvenv

      (TyVarEnv Ty0
_tvenv'', Ty0
ty') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
tvenv' Ty0
ty
      Exp0
e1' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv TyVarEnv Ty0
tvenv' Exp0
e1
      Var
v'  <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym (Var -> Var
cleanFunName Var
v)
      Exp0
e2' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp (Var -> Var -> VarEnv -> VarEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Var
v' VarEnv
venv) TyVarEnv Ty0
tvenv Exp0
e2
      Ty0
ty'' <- case Ty0
ty' of
                SymDictTy (Just Var
w) Ty0
ty2 -> case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
w VarEnv
venv of
                                            Maybe Var
Nothing -> Ty0 -> PassM Ty0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty0
ty'
                                            Just Var
w' -> Ty0 -> PassM Ty0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ty0 -> PassM Ty0) -> Ty0 -> PassM Ty0
forall a b. (a -> b) -> a -> b
$ Maybe Var -> Ty0 -> Ty0
SymDictTy (Var -> Maybe Var
forall a. a -> Maybe a
Just Var
w') Ty0
ty2
                Ty0
_ -> Ty0 -> PassM Ty0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return Ty0
ty'
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ (Var, [Ty0], Ty0, Exp0) -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v',[],Ty0
ty'',Exp0
e1') Exp0
e2'

    IfE Exp0
e1 Exp0
e2 Exp0
e3 -> do
      Exp0
e1' <- Exp0 -> PassM Exp0
go Exp0
e1
      Exp0
e2' <- Exp0 -> PassM Exp0
go Exp0
e2
      Exp0
e3' <- Exp0 -> PassM Exp0
go Exp0
e3
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Exp0 -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE Exp0
e1' Exp0
e2' Exp0
e3'

    ProjE Int
i Exp0
e -> do
      Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Int -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i Exp0
e'

    MkProdE [Exp0]
es -> do
      [Exp0]
es' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
es
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp0]
es'

    CaseE Exp0
e [(DataCon, [(Var, Ty0)], Exp0)]
mp -> do
      Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
      [(DataCon, [(Var, Ty0)], Exp0)]
mp' <- ((DataCon, [(Var, Ty0)], Exp0)
 -> PassM (DataCon, [(Var, Ty0)], Exp0))
-> [(DataCon, [(Var, Ty0)], Exp0)]
-> PassM [(DataCon, [(Var, Ty0)], Exp0)]
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 (\(DataCon
c,[(Var, Ty0)]
prs,Exp0
ae) -> do
                     let ([Var]
args,[Ty0]
locs) = [(Var, Ty0)] -> ([Var], [Ty0])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, Ty0)]
prs
                     [Var]
args' <- (Var -> PassM Var) -> [Var] -> PassM [Var]
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 Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym [Var]
args
                     let venv' :: VarEnv
venv' = [(Var, Var)] -> VarEnv
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
args [Var]
args') VarEnv -> VarEnv -> VarEnv
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` VarEnv
venv
                     Exp0
ae' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv' TyVarEnv Ty0
tvenv Exp0
ae
                     (DataCon, [(Var, Ty0)], Exp0)
-> PassM (DataCon, [(Var, Ty0)], Exp0)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DataCon
c, [Var] -> [Ty0] -> [(Var, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
args' [Ty0]
locs, Exp0
ae')) [(DataCon, [(Var, Ty0)], Exp0)]
mp
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> [(DataCon, [(Var, Ty0)], Exp0)] -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(DataCon, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE Exp0
e' [(DataCon, [(Var, Ty0)], Exp0)]
mp'

    DataConE Ty0
loc DataCon
c [Exp0]
es -> do
      [Exp0]
es' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
es
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Ty0 -> DataCon -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
loc -> DataCon -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE Ty0
loc DataCon
c [Exp0]
es'

    TimeIt Exp0
e Ty0
t IsBoxed
b -> do
      Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Exp0 -> Ty0 -> IsBoxed -> Exp0
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> IsBoxed -> PreExp ext loc dec
TimeIt Exp0
e' Ty0
t IsBoxed
b

    WithArenaE Var
v Exp0
e -> do
      Var
v' <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
v
      Exp0
e' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp (Var -> Var -> VarEnv -> VarEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Var
v' VarEnv
venv) TyVarEnv Ty0
tvenv Exp0
e
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> PreExp ext loc dec -> PreExp ext loc dec
WithArenaE Var
v' Exp0
e'

    SpawnE Var
v [Ty0]
locs [Exp0]
ls -> IsBoxed -> PassM Exp0 -> PassM Exp0
forall a. HasCallStack => IsBoxed -> a -> a
assert ([] [Ty0] -> [Ty0] -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
== [Ty0]
locs) (PassM Exp0 -> PassM Exp0) -> PassM Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ do
      [Exp0]
ls' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
ls
      case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
venv of
        Maybe Var
Nothing -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE (Var -> Var
cleanFunName Var
v) [] [Exp0]
ls'
        Just Var
v' -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ Var -> [Ty0] -> [Exp0] -> Exp0
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE (Var -> Var
cleanFunName Var
v') [] [Exp0]
ls'

    Exp0
SyncE -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp0
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE

    MapE (Var
v,Ty0
t,Exp0
b) Exp0
e -> do
      Exp0
b' <- Exp0 -> PassM Exp0
go Exp0
b
      Exp0
e' <- Exp0 -> PassM Exp0
go Exp0
e
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ (Var, Ty0, Exp0) -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
(Var, dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
MapE (Var
v,Ty0
t,Exp0
b') Exp0
e'

    FoldE (Var
v1,Ty0
t1,Exp0
e1) (Var
v2,Ty0
t2,Exp0
e2) Exp0
e3 -> do
      Exp0
e1' <- Exp0 -> PassM Exp0
go Exp0
e1
      Exp0
e2' <- Exp0 -> PassM Exp0
go Exp0
e2
      Exp0
e3' <- Exp0 -> PassM Exp0
go Exp0
e3
      Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ (Var, Ty0, Exp0) -> (Var, Ty0, Exp0) -> Exp0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
(Var, dec, PreExp ext loc dec)
-> (Var, dec, PreExp ext loc dec)
-> PreExp ext loc dec
-> PreExp ext loc dec
FoldE (Var
v1,Ty0
t1,Exp0
e1') (Var
v2,Ty0
t2,Exp0
e2') Exp0
e3'

    -- Ext ext -> Ext <$> gFreshenExp venv tvenv ext

    Ext E0Ext Ty0 Ty0
ext ->
      case E0Ext Ty0 Ty0
ext of
        LambdaE [(Var, Ty0)]
args Exp0
bod -> do
          (VarEnv
venv', [Var]
vs, [Ty0]
ts) <- ((Var, Ty0)
 -> (VarEnv, [Var], [Ty0]) -> PassM (VarEnv, [Var], [Ty0]))
-> (VarEnv, [Var], [Ty0])
-> [(Var, Ty0)]
-> PassM (VarEnv, [Var], [Ty0])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM
                               (\(Var
v,Ty0
t) (VarEnv
acc1, [Var]
acc2, [Ty0]
acc3) -> do
                                     Var
v' <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
v
                                     let acc1' :: VarEnv
acc1' = Var -> Var -> VarEnv -> VarEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Var
v' VarEnv
acc1
                                     (TyVarEnv Ty0
_tvenv', Ty0
t') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
tvenv Ty0
t
                                     (VarEnv, [Var], [Ty0]) -> PassM (VarEnv, [Var], [Ty0])
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarEnv
acc1', Var
v'Var -> [Var] -> [Var]
forall a. a -> [a] -> [a]
:[Var]
acc2, Ty0
t'Ty0 -> [Ty0] -> [Ty0]
forall a. a -> [a] -> [a]
: [Ty0]
acc3))
                               (VarEnv
venv,[],[]) [(Var, Ty0)]
args
          E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> PassM (E0Ext Ty0 Ty0) -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Var, Ty0)] -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec.
[(Var, dec)] -> PreExp E0Ext loc dec -> E0Ext loc dec
LambdaE ([Var] -> [Ty0] -> [(Var, Ty0)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vs [Ty0]
ts) (Exp0 -> E0Ext Ty0 Ty0) -> PassM Exp0 -> PassM (E0Ext Ty0 Ty0)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv' TyVarEnv Ty0
tvenv Exp0
bod))
        FunRefE [Ty0]
tyapps Var
f ->
          case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
f VarEnv
venv of
            Maybe Var
Nothing -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ [Ty0] -> Var -> E0Ext Ty0 Ty0
forall loc dec. [loc] -> Var -> E0Ext loc dec
FunRefE [Ty0]
tyapps (Var -> Var
cleanFunName Var
f)
            Just Var
f' -> Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ [Ty0] -> Var -> E0Ext Ty0 Ty0
forall loc dec. [loc] -> Var -> E0Ext loc dec
FunRefE [Ty0]
tyapps (Var -> Var
cleanFunName Var
f')
        PolyAppE{} -> DataCon -> PassM Exp0
forall a. HasCallStack => DataCon -> a
error DataCon
"freshExp: TODO, PolyAppE."

        BenchE Var
fn [Ty0]
tyapps [Exp0]
args IsBoxed
b -> do
          [Exp0]
args' <- (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
args
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> [Ty0] -> [Exp0] -> IsBoxed -> E0Ext Ty0 Ty0
forall loc dec.
Var -> [loc] -> [PreExp E0Ext loc dec] -> IsBoxed -> E0Ext loc dec
BenchE (Var -> Var
cleanFunName Var
fn) [Ty0]
tyapps [Exp0]
args' IsBoxed
b)

        ParE0 [Exp0]
ls -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0)
-> ([Exp0] -> E0Ext Ty0 Ty0) -> [Exp0] -> Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp0] -> E0Ext Ty0 Ty0
forall loc dec. [PreExp E0Ext loc dec] -> E0Ext loc dec
ParE0 ([Exp0] -> Exp0) -> PassM [Exp0] -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp0 -> PassM Exp0) -> [Exp0] -> PassM [Exp0]
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 Exp0 -> PassM Exp0
go [Exp0]
ls
        L Loc
p Exp0
e    -> E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> (Exp0 -> E0Ext Ty0 Ty0) -> Exp0 -> Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Loc -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. Loc -> PreExp E0Ext loc dec -> E0Ext loc dec
L Loc
p) (Exp0 -> Exp0) -> PassM Exp0 -> PassM Exp0
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp0 -> PassM Exp0
go Exp0
e
        PrintPacked Ty0
ty Exp0
arg -> do
          (TyVarEnv Ty0
tvenv', Ty0
ty') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
tvenv Ty0
ty
          Exp0
arg' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv TyVarEnv Ty0
tvenv' Exp0
arg
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
PrintPacked Ty0
ty' Exp0
arg'
        CopyPacked Ty0
ty Exp0
arg -> do
          (TyVarEnv Ty0
tvenv', Ty0
ty') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
tvenv Ty0
ty
          Exp0
arg' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv TyVarEnv Ty0
tvenv' Exp0
arg
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
CopyPacked Ty0
ty' Exp0
arg'
        TravPacked Ty0
ty Exp0
arg -> do
          (TyVarEnv Ty0
tvenv', Ty0
ty') <- TyVarEnv Ty0 -> Ty0 -> PassM (TyVarEnv Ty0, Ty0)
freshTy TyVarEnv Ty0
tvenv Ty0
ty
          Exp0
arg' <- VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv TyVarEnv Ty0
tvenv' Exp0
arg
          Exp0 -> PassM Exp0
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp0 -> PassM Exp0) -> Exp0 -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ E0Ext Ty0 Ty0 -> Exp0
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E0Ext Ty0 Ty0 -> Exp0) -> E0Ext Ty0 Ty0 -> Exp0
forall a b. (a -> b) -> a -> b
$ Ty0 -> Exp0 -> E0Ext Ty0 Ty0
forall loc dec. dec -> PreExp E0Ext loc dec -> E0Ext loc dec
TravPacked Ty0
ty' Exp0
arg'
        LinearExt{} -> DataCon -> PassM Exp0
forall a. HasCallStack => DataCon -> a
error (DataCon -> PassM Exp0) -> DataCon -> PassM Exp0
forall a b. (a -> b) -> a -> b
$ DataCon
"freshenExp: a linear types extension wasn't desugared: " DataCon -> DataCon -> DataCon
forall a. [a] -> [a] -> [a]
++ Exp0 -> DataCon
forall a. Out a => a -> DataCon
sdoc Exp0
exp

  where go :: Exp0 -> PassM Exp0
go = VarEnv -> TyVarEnv Ty0 -> Exp0 -> PassM Exp0
freshExp VarEnv
venv TyVarEnv Ty0
tvenv


-- copy-paste.

freshNames1 :: L1.Prog1 -> PassM L1.Prog1
freshNames1 :: Prog1 -> PassM Prog1
freshNames1 (L1.Prog DDefs (TyOf Exp1)
defs FunDefs Exp1
funs Maybe (Exp1, TyOf Exp1)
main) =
    do Maybe (Exp1, UrTy ())
main' <- case Maybe (Exp1, TyOf Exp1)
main of
                  Maybe (Exp1, TyOf Exp1)
Nothing -> Maybe (Exp1, UrTy ()) -> PassM (Maybe (Exp1, UrTy ()))
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Exp1, UrTy ())
forall a. Maybe a
Nothing
                  Just (Exp1
m,TyOf Exp1
ty) -> do Exp1
m' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
forall k a. Map k a
M.empty Exp1
m
                                    Maybe (Exp1, UrTy ()) -> PassM (Maybe (Exp1, UrTy ()))
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Exp1, UrTy ()) -> PassM (Maybe (Exp1, UrTy ())))
-> Maybe (Exp1, UrTy ()) -> PassM (Maybe (Exp1, UrTy ()))
forall a b. (a -> b) -> a -> b
$ (Exp1, UrTy ()) -> Maybe (Exp1, UrTy ())
forall a. a -> Maybe a
Just (Exp1
m',TyOf Exp1
UrTy ()
ty)
       FunDefs Exp1
funs' <- (FunDef1 -> PassM FunDef1) -> FunDefs Exp1 -> PassM (FunDefs Exp1)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Var a -> f (Map Var b)
traverse FunDef1 -> PassM FunDef1
freshFun1 FunDefs Exp1
funs
       Prog1 -> PassM Prog1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prog1 -> PassM Prog1) -> Prog1 -> PassM Prog1
forall a b. (a -> b) -> a -> b
$ DDefs (TyOf Exp1)
-> FunDefs Exp1 -> Maybe (Exp1, TyOf Exp1) -> Prog1
forall ex.
DDefs (TyOf ex) -> FunDefs ex -> Maybe (ex, TyOf ex) -> Prog ex
L1.Prog DDefs (TyOf Exp1)
defs FunDefs Exp1
funs' Maybe (Exp1, TyOf Exp1)
Maybe (Exp1, UrTy ())
main'

freshFun1 :: L1.FunDef1 -> PassM L1.FunDef1
freshFun1 :: FunDef1 -> PassM FunDef1
freshFun1 (FunDef Var
nam [Var]
nargs ([UrTy ()]
targ,UrTy ()
ty) Exp1
bod FunMeta
meta) = do
    [Var]
nargs' <- (Var -> PassM Var) -> [Var] -> PassM [Var]
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 Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym [Var]
nargs
    let msubst :: VarEnv
msubst = ([(Var, Var)] -> VarEnv
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, Var)] -> VarEnv) -> [(Var, Var)] -> VarEnv
forall a b. (a -> b) -> a -> b
$ [Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
nargs [Var]
nargs')
    Exp1
bod' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
msubst Exp1
bod
    -- let nam' = cleanFunName nam
    FunDef1 -> PassM FunDef1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (FunDef1 -> PassM FunDef1) -> FunDef1 -> PassM FunDef1
forall a b. (a -> b) -> a -> b
$ Var -> [Var] -> ArrowTy (TyOf Exp1) -> Exp1 -> FunMeta -> FunDef1
forall ex.
Var -> [Var] -> ArrowTy (TyOf ex) -> ex -> FunMeta -> FunDef ex
FunDef Var
nam [Var]
nargs' ([UrTy ()]
targ,UrTy ()
ty) Exp1
bod' FunMeta
meta


freshExp1 :: VarEnv -> L1.Exp1 -> PassM L1.Exp1
freshExp1 :: VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
exp =
  case Exp1
exp of
    LitE Int
i    -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Int -> Exp1
forall (ext :: * -> * -> *) loc dec. Int -> PreExp ext loc dec
LitE Int
i
    CharE Char
c   -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Char -> Exp1
forall (ext :: * -> * -> *) loc dec. Char -> PreExp ext loc dec
CharE Char
c
    FloatE Double
i  -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Double -> Exp1
forall (ext :: * -> * -> *) loc dec. Double -> PreExp ext loc dec
FloatE Double
i
    LitSymE Var
v -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Var -> Exp1
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
LitSymE Var
v

    VarE Var
v ->
      case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
vs of
        Maybe Var
Nothing -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Var -> Exp1
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v
        Just Var
v' -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Var -> Exp1
forall (ext :: * -> * -> *) loc dec. Var -> PreExp ext loc dec
VarE Var
v'

    AppE Var
v [()]
locs [Exp1]
ls -> IsBoxed -> PassM Exp1 -> PassM Exp1
forall a. HasCallStack => IsBoxed -> a -> a
assert ([] [()] -> [()] -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
== [()]
locs) (PassM Exp1 -> PassM Exp1) -> PassM Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ do
      [Exp1]
ls' <- (Exp1 -> PassM Exp1) -> [Exp1] -> PassM [Exp1]
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 (VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs) [Exp1]
ls
      case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
vs of
        Maybe Var
Nothing -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE (Var -> Var
cleanFunName Var
v) [] [Exp1]
ls'
        Just Var
v' -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
AppE (Var -> Var
cleanFunName Var
v') [] [Exp1]
ls'

    PrimAppE Prim (UrTy ())
p [Exp1]
es -> do
      [Exp1]
es' <- (Exp1 -> PassM Exp1) -> [Exp1] -> PassM [Exp1]
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 (VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs) [Exp1]
es
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Prim (UrTy ()) -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Prim dec -> [PreExp ext loc dec] -> PreExp ext loc dec
PrimAppE Prim (UrTy ())
p [Exp1]
es'

    LetE (Var
v,[()]
locs,UrTy ()
t, Exp1
e1) Exp1
e2 -> IsBoxed -> PassM Exp1 -> PassM Exp1
forall a. HasCallStack => IsBoxed -> a -> a
assert ([][()] -> [()] -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
==[()]
locs) (PassM Exp1 -> PassM Exp1) -> PassM Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ do
     Exp1
e1' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e1
     Var
v'  <- Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym Var
v
     Exp1
e2' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 (Var -> Var -> VarEnv -> VarEnv
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Var
v Var
v' VarEnv
vs) Exp1
e2
     Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ (Var, [()], UrTy (), Exp1) -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
(Var, [loc], dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
LetE (Var
v',[],UrTy ()
t,Exp1
e1') Exp1
e2'

    IfE Exp1
e1 Exp1
e2 Exp1
e3 -> do
      Exp1
e1' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e1
      Exp1
e2' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e2
      Exp1
e3' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e3
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Exp1 -> Exp1 -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> PreExp ext loc dec -> PreExp ext loc dec -> PreExp ext loc dec
IfE Exp1
e1' Exp1
e2' Exp1
e3'

    ProjE Int
i Exp1
e -> do
      Exp1
e' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Int -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
Int -> PreExp ext loc dec -> PreExp ext loc dec
ProjE Int
i Exp1
e'

    MkProdE [Exp1]
es -> do
      [Exp1]
es' <- (Exp1 -> PassM Exp1) -> [Exp1] -> PassM [Exp1]
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 (VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs) [Exp1]
es
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
[PreExp ext loc dec] -> PreExp ext loc dec
MkProdE [Exp1]
es'

    CaseE Exp1
e [(DataCon, [(Var, ())], Exp1)]
mp -> do
      Exp1
e' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e
      -- Here we freshen locations:
      [(DataCon, [(Var, ())], Exp1)]
mp' <- ((DataCon, [(Var, ())], Exp1)
 -> PassM (DataCon, [(Var, ())], Exp1))
-> [(DataCon, [(Var, ())], Exp1)]
-> PassM [(DataCon, [(Var, ())], Exp1)]
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 (\(DataCon
c,[(Var, ())]
prs,Exp1
ae) ->
                   let ([Var]
args,[()]
_) = [(Var, ())] -> ([Var], [()])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Var, ())]
prs in
                   do
                     [Var]
args' <- (Var -> PassM Var) -> [Var] -> PassM [Var]
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 Var -> PassM Var
forall (m :: * -> *). MonadState Int m => Var -> m Var
gensym [Var]
args
                     let vs' :: VarEnv
vs' = ([(Var, Var)] -> VarEnv
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Var, Var)] -> VarEnv) -> [(Var, Var)] -> VarEnv
forall a b. (a -> b) -> a -> b
$ [Var] -> [Var] -> [(Var, Var)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
args [Var]
args') VarEnv -> VarEnv -> VarEnv
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` VarEnv
vs
                     Exp1
ae' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs' Exp1
ae
                     (DataCon, [(Var, ())], Exp1) -> PassM (DataCon, [(Var, ())], Exp1)
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (DataCon
c, (Var -> (Var, ())) -> [Var] -> [(Var, ())]
forall a b. (a -> b) -> [a] -> [b]
map (,()) [Var]
args', Exp1
ae')) [(DataCon, [(Var, ())], Exp1)]
mp
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Exp1 -> [(DataCon, [(Var, ())], Exp1)] -> Exp1
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec
-> [(DataCon, [(Var, loc)], PreExp ext loc dec)]
-> PreExp ext loc dec
CaseE Exp1
e' [(DataCon, [(Var, ())], Exp1)]
mp'

    DataConE () DataCon
c [Exp1]
es -> do
      [Exp1]
es' <- (Exp1 -> PassM Exp1) -> [Exp1] -> PassM [Exp1]
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 (VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs) [Exp1]
es
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ () -> DataCon -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
loc -> DataCon -> [PreExp ext loc dec] -> PreExp ext loc dec
DataConE () DataCon
c [Exp1]
es'

    TimeIt Exp1
e UrTy ()
t IsBoxed
b -> do
      Exp1
e' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Exp1 -> UrTy () -> IsBoxed -> Exp1
forall (ext :: * -> * -> *) loc dec.
PreExp ext loc dec -> dec -> IsBoxed -> PreExp ext loc dec
TimeIt Exp1
e' UrTy ()
t IsBoxed
b

    SpawnE Var
v [()]
locs [Exp1]
ls -> IsBoxed -> PassM Exp1 -> PassM Exp1
forall a. HasCallStack => IsBoxed -> a -> a
assert ([] [()] -> [()] -> IsBoxed
forall a. Eq a => a -> a -> IsBoxed
== [()]
locs) (PassM Exp1 -> PassM Exp1) -> PassM Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ do
      [Exp1]
ls' <- (Exp1 -> PassM Exp1) -> [Exp1] -> PassM [Exp1]
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 (VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs) [Exp1]
ls
      case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
vs of
        Maybe Var
Nothing -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE (Var -> Var
cleanFunName Var
v) [] [Exp1]
ls'
        Just Var
v' -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ Var -> [()] -> [Exp1] -> Exp1
forall (ext :: * -> * -> *) loc dec.
Var -> [loc] -> [PreExp ext loc dec] -> PreExp ext loc dec
SpawnE (Var -> Var
cleanFunName Var
v') [] [Exp1]
ls'

    Exp1
SyncE -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Exp1
forall (ext :: * -> * -> *) loc dec. PreExp ext loc dec
SyncE

    MapE (Var
v,UrTy ()
t,Exp1
b) Exp1
e -> do
      Exp1
b' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
b
      Exp1
e' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ (Var, UrTy (), Exp1) -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
(Var, dec, PreExp ext loc dec)
-> PreExp ext loc dec -> PreExp ext loc dec
MapE (Var
v,UrTy ()
t,Exp1
b') Exp1
e'

    FoldE (Var
v1,UrTy ()
t1,Exp1
e1) (Var
v2,UrTy ()
t2,Exp1
e2) Exp1
e3 -> do
      Exp1
e1' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e1
      Exp1
e2' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e2
      Exp1
e3' <- VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs Exp1
e3
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ (Var, UrTy (), Exp1) -> (Var, UrTy (), Exp1) -> Exp1 -> Exp1
forall (ext :: * -> * -> *) loc dec.
(Var, dec, PreExp ext loc dec)
-> (Var, dec, PreExp ext loc dec)
-> PreExp ext loc dec
-> PreExp ext loc dec
FoldE (Var
v1,UrTy ()
t1,Exp1
e1') (Var
v2,UrTy ()
t2,Exp1
e2') Exp1
e3'

    WithArenaE{} -> DataCon -> PassM Exp1
forall a. HasCallStack => DataCon -> a
error DataCon
"freshExp1: WithArenaE not handled."

    Ext (L1.BenchE Var
fn [()]
tyapps [Exp1]
args IsBoxed
b) -> do
      [Exp1]
args' <- (Exp1 -> PassM Exp1) -> [Exp1] -> PassM [Exp1]
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 (VarEnv -> Exp1 -> PassM Exp1
freshExp1 VarEnv
vs) [Exp1]
args
      Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ E1Ext () (UrTy ()) -> Exp1
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (Var -> [()] -> [Exp1] -> IsBoxed -> E1Ext () (UrTy ())
forall loc dec.
Var -> [loc] -> [PreExp E1Ext loc dec] -> IsBoxed -> E1Ext loc dec
L1.BenchE (Var -> Var
cleanFunName Var
fn) [()]
tyapps [Exp1]
args' IsBoxed
b)

    Ext (L1.StartOfPkdCursor Var
cur) -> do
      case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
cur VarEnv
vs of
        Maybe Var
Nothing -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ E1Ext () (UrTy ()) -> Exp1
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E1Ext () (UrTy ()) -> Exp1) -> E1Ext () (UrTy ()) -> Exp1
forall a b. (a -> b) -> a -> b
$ Var -> E1Ext () (UrTy ())
forall loc dec. Var -> E1Ext loc dec
L1.StartOfPkdCursor Var
cur
        Just Var
v' -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ E1Ext () (UrTy ()) -> Exp1
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E1Ext () (UrTy ()) -> Exp1) -> E1Ext () (UrTy ()) -> Exp1
forall a b. (a -> b) -> a -> b
$ Var -> E1Ext () (UrTy ())
forall loc dec. Var -> E1Ext loc dec
L1.StartOfPkdCursor Var
v'

    Ext (L1.AddFixed Var
v Int
i) -> do
     case Var -> VarEnv -> Maybe Var
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Var
v VarEnv
vs of
        Maybe Var
Nothing -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ E1Ext () (UrTy ()) -> Exp1
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E1Ext () (UrTy ()) -> Exp1) -> E1Ext () (UrTy ()) -> Exp1
forall a b. (a -> b) -> a -> b
$ Var -> Int -> E1Ext () (UrTy ())
forall loc dec. Var -> Int -> E1Ext loc dec
L1.AddFixed Var
v Int
i
        Just Var
v' -> Exp1 -> PassM Exp1
forall a. a -> PassM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp1 -> PassM Exp1) -> Exp1 -> PassM Exp1
forall a b. (a -> b) -> a -> b
$ E1Ext () (UrTy ()) -> Exp1
forall (ext :: * -> * -> *) loc dec.
ext loc dec -> PreExp ext loc dec
Ext (E1Ext () (UrTy ()) -> Exp1) -> E1Ext () (UrTy ()) -> Exp1
forall a b. (a -> b) -> a -> b
$ Var -> Int -> E1Ext () (UrTy ())
forall loc dec. Var -> Int -> E1Ext loc dec
L1.AddFixed Var
v' Int
i