module Language.HERMIT.Kure
(
module Language.KURE
, module Language.KURE.BiTranslate
, module Language.KURE.Lens
, TranslateH
, RewriteH
, BiRewriteH
, LensH
, modGutsT, modGutsR
, progNilT
, progConsT, progConsAllR, progConsAnyR, progConsOneR
, nonRecT, nonRecR
, recT, recAllR, recAnyR, recOneR
, defT, defR
, altT, altR
, varT
, litT
, appT, appAllR, appAnyR, appOneR
, lamT, lamR
, letT, letAllR, letAnyR, letOneR
, caseT, caseAllR, caseAnyR, caseOneR
, castT, castR
, tickT, tickR
, typeT
, coercionT
, recDefT, recDefAllR, recDefAnyR, recDefOneR
, letNonRecT, letNonRecAllR, letNonRecAnyR, letNonRecOneR
, letRecT, letRecAllR, letRecAnyR, letRecOneR
, letRecDefT, letRecDefAllR, letRecDefAnyR, letRecDefOneR
, consNonRecT, consNonRecAllR, consNonRecAnyR, consNonRecOneR
, consRecT, consRecAllR, consRecAnyR, consRecOneR
, consRecDefT, consRecDefAllR, consRecDefAnyR, consRecDefOneR
, caseAltT, caseAltAllR, caseAltAnyR, caseAltOneR
, promoteModGutsR
, promoteProgR
, promoteBindR
, promoteDefR
, promoteExprR
, promoteAltR
, promoteExprBiR
, promoteModGutsT
, promoteProgT
, promoteBindT
, promoteDefT
, promoteExprT
, promoteAltT
)
where
import GhcPlugins hiding (empty)
import Language.KURE
import Language.KURE.BiTranslate
import Language.KURE.Lens
import Language.HERMIT.Core
import Language.HERMIT.Context
import Language.HERMIT.Monad
import Control.Monad
type TranslateH a b = Translate HermitC HermitM a b
type RewriteH a = Rewrite HermitC HermitM a
type BiRewriteH a = BiRewrite HermitC HermitM a
type LensH a b = Lens HermitC HermitM a b
(<$>) :: Monad m => (a -> b) -> m a -> m b
(<$>) = liftM
(<*>) :: Monad m => m (a -> b) -> m a -> m b
(<*>) = ap
instance Injection ModGuts Core where
inject :: ModGuts -> Core
inject = GutsCore
project :: Core -> Maybe ModGuts
project (GutsCore guts) = Just guts
project _ = Nothing
instance Injection CoreProg Core where
inject :: CoreProg -> Core
inject = ProgCore
project :: Core -> Maybe CoreProg
project (ProgCore bds) = Just bds
project _ = Nothing
instance Injection CoreBind Core where
inject :: CoreBind -> Core
inject = BindCore
project :: Core -> Maybe CoreBind
project (BindCore bnd) = Just bnd
project _ = Nothing
instance Injection CoreDef Core where
inject :: CoreDef -> Core
inject = DefCore
project :: Core -> Maybe CoreDef
project (DefCore def) = Just def
project _ = Nothing
instance Injection CoreAlt Core where
inject :: CoreAlt -> Core
inject = AltCore
project :: Core -> Maybe CoreAlt
project (AltCore expr) = Just expr
project _ = Nothing
instance Injection CoreExpr Core where
inject :: CoreExpr -> Core
inject = ExprCore
project :: Core -> Maybe CoreExpr
project (ExprCore expr) = Just expr
project _ = Nothing
instance Walker HermitC Core where
allR :: forall m. MonadCatch m => Rewrite HermitC m Core -> Rewrite HermitC m Core
allR r = prefixFailMsg "allR failed: " $
rewrite $ \ c -> \case
GutsCore guts -> inject <$> apply allRmodguts c guts
ProgCore p -> inject <$> apply allRprog c p
BindCore bn -> inject <$> apply allRbind c bn
DefCore def -> inject <$> apply allRdef c def
AltCore alt -> inject <$> apply allRalt c alt
ExprCore e -> inject <$> apply allRexpr c e
where
allRmodguts :: MonadCatch m => Rewrite HermitC m ModGuts
allRmodguts = modGutsR (extractR r)
allRprog :: MonadCatch m => Rewrite HermitC m CoreProg
allRprog = readerT $ \case
ProgCons _ _ -> progConsAllR (extractR r) (extractR r)
_ -> idR
allRbind :: MonadCatch m => Rewrite HermitC m CoreBind
allRbind = readerT $ \case
NonRec _ _ -> nonRecR (extractR r)
Rec _ -> recAllR (const $ extractR r)
allRdef :: MonadCatch m => Rewrite HermitC m CoreDef
allRdef = defR (extractR r)
allRalt :: MonadCatch m => Rewrite HermitC m CoreAlt
allRalt = altR (extractR r)
allRexpr :: MonadCatch m => Rewrite HermitC m CoreExpr
allRexpr = readerT $ \case
App _ _ -> appAllR (extractR r) (extractR r)
Lam _ _ -> lamR (extractR r)
Let _ _ -> letAllR (extractR r) (extractR r)
Case _ _ _ _ -> caseAllR (extractR r) (const $ extractR r)
Cast _ _ -> castR (extractR r)
Tick _ _ -> tickR (extractR r)
_ -> idR
modGutsT :: Monad m => Translate HermitC m CoreProg a -> (ModGuts -> a -> b) -> Translate HermitC m ModGuts b
modGutsT t f = translate $ \ c guts -> f guts <$> apply t (c @@ 0) (bindsToProg $ mg_binds guts)
modGutsR :: Monad m => Rewrite HermitC m CoreProg -> Rewrite HermitC m ModGuts
modGutsR r = modGutsT r (\ guts p -> guts {mg_binds = progToBinds p})
progNilT :: Monad m => b -> Translate HermitC m CoreProg b
progNilT b = contextfreeT $ \case
ProgNil -> return b
ProgCons _ _ -> fail "not an empty program node."
progConsT :: Monad m => Translate HermitC m CoreBind a1 -> Translate HermitC m CoreProg a2 -> (a1 -> a2 -> b) -> Translate HermitC m CoreProg b
progConsT t1 t2 f = translate $ \ c -> \case
ProgCons bd p -> f <$> apply t1 (c @@ 0) bd <*> apply t2 (addBinding bd c @@ 1) p
_ -> fail "not a non-empty program node."
progConsAllR :: Monad m => Rewrite HermitC m CoreBind -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
progConsAllR r1 r2 = progConsT r1 r2 ProgCons
progConsAnyR :: MonadCatch m => Rewrite HermitC m CoreBind -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
progConsAnyR r1 r2 = unwrapAnyR $ progConsAllR (wrapAnyR r1) (wrapAnyR r2)
progConsOneR :: MonadCatch m => Rewrite HermitC m CoreBind -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
progConsOneR r1 r2 = unwrapOneR $ progConsAllR (wrapOneR r1) (wrapOneR r2)
nonRecT :: Monad m => Translate HermitC m CoreExpr a -> (Var -> a -> b) -> Translate HermitC m CoreBind b
nonRecT t f = translate $ \ c -> \case
NonRec v e -> f v <$> apply t (c @@ 0) e
_ -> fail "not a non-recursive binding-group node."
nonRecR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreBind
nonRecR r = nonRecT r NonRec
recT :: Monad m => (Int -> Translate HermitC m CoreDef a) -> ([a] -> b) -> Translate HermitC m CoreBind b
recT t f = translate $ \ c -> \case
Rec bds ->
let c' = addBinding (Rec bds) c
in f <$> sequence [ apply (t n) (c' @@ n) (Def v e)
| ((v,e),n) <- zip bds [0..]
]
_ -> fail "not a recursive binding-group node."
recAllR :: Monad m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreBind
recAllR rs = recT rs defsToRecBind
recAnyR :: MonadCatch m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreBind
recAnyR rs = unwrapAnyR $ recAllR (wrapAnyR . rs)
recOneR :: MonadCatch m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreBind
recOneR rs = unwrapOneR $ recAllR (wrapOneR . rs)
defT :: Monad m => Translate HermitC m CoreExpr a -> (Id -> a -> b) -> Translate HermitC m CoreDef b
defT t f = translate $ \ c (Def v e) -> f v <$> apply t (c @@ 0) e
defR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreDef
defR r = defT r Def
altT :: Monad m => Translate HermitC m CoreExpr a -> (AltCon -> [Var] -> a -> b) -> Translate HermitC m CoreAlt b
altT t f = translate $ \ c (con,vs,e) -> f con vs <$> apply t (addAltBindings vs c @@ 0) e
altR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreAlt
altR r = altT r (,,)
varT :: Monad m => (Id -> b) -> Translate HermitC m CoreExpr b
varT f = contextfreeT $ \case
Var v -> return (f v)
_ -> fail "not a variable node."
litT :: Monad m => (Literal -> b) -> Translate HermitC m CoreExpr b
litT f = contextfreeT $ \case
Lit x -> return (f x)
_ -> fail "not a literal node."
appT :: Monad m => Translate HermitC m CoreExpr a1 -> Translate HermitC m CoreExpr a2 -> (a1 -> a2 -> b) -> Translate HermitC m CoreExpr b
appT t1 t2 f = translate $ \ c -> \case
App e1 e2 -> f <$> apply t1 (c @@ 0) e1 <*> apply t2 (c @@ 1) e2
_ -> fail "not an application node."
appAllR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
appAllR r1 r2 = appT r1 r2 App
appAnyR :: MonadCatch m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
appAnyR r1 r2 = unwrapAnyR $ appAllR (wrapAnyR r1) (wrapAnyR r2)
appOneR :: MonadCatch m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
appOneR r1 r2 = unwrapOneR $ appAllR (wrapOneR r1) (wrapOneR r2)
lamT :: Monad m => Translate HermitC m CoreExpr a -> (Var -> a -> b) -> Translate HermitC m CoreExpr b
lamT t f = translate $ \ c -> \case
Lam v e -> f v <$> apply t (addLambdaBinding v c @@ 0) e
_ -> fail "not a lambda node."
lamR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
lamR r = lamT r Lam
letT :: Monad m => Translate HermitC m CoreBind a1 -> Translate HermitC m CoreExpr a2 -> (a1 -> a2 -> b) -> Translate HermitC m CoreExpr b
letT t1 t2 f = translate $ \ c -> \case
Let bds e ->
f <$> apply t1 (c @@ 0) bds <*> apply t2 (addBinding bds c @@ 1) e
_ -> fail "not a let node."
letAllR :: Monad m => Rewrite HermitC m CoreBind -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letAllR r1 r2 = letT r1 r2 Let
letAnyR :: MonadCatch m => Rewrite HermitC m CoreBind -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letAnyR r1 r2 = unwrapAnyR $ letAnyR (wrapAnyR r1) (wrapAnyR r2)
letOneR :: MonadCatch m => Rewrite HermitC m CoreBind -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letOneR r1 r2 = unwrapOneR $ letOneR (wrapOneR r1) (wrapOneR r2)
caseT :: Monad m => Translate HermitC m CoreExpr a1 -> (Int -> Translate HermitC m CoreAlt a2) -> (a1 -> Id -> Type -> [a2] -> b) -> Translate HermitC m CoreExpr b
caseT t ts f = translate $ \ c -> \case
Case e x ty alts -> f <$> apply t (c @@ 0) e
<*> return x
<*> return ty
<*> sequence [ apply (ts n) (addCaseBinding (x,e,alt) c @@ (n+1)) alt
| (alt,n) <- zip alts [0..]
]
_ -> fail "not a case node."
caseAllR :: Monad m => Rewrite HermitC m CoreExpr -> (Int -> Rewrite HermitC m CoreAlt) -> Rewrite HermitC m CoreExpr
caseAllR r rs = caseT r rs Case
caseAnyR :: MonadCatch m => Rewrite HermitC m CoreExpr -> (Int -> Rewrite HermitC m CoreAlt) -> Rewrite HermitC m CoreExpr
caseAnyR r rs = unwrapAnyR $ caseAllR (wrapAnyR r) (wrapAnyR . rs)
caseOneR :: MonadCatch m => Rewrite HermitC m CoreExpr -> (Int -> Rewrite HermitC m CoreAlt) -> Rewrite HermitC m CoreExpr
caseOneR r rs = unwrapOneR $ caseAllR (wrapOneR r) (wrapOneR . rs)
castT :: Monad m => Translate HermitC m CoreExpr a -> (a -> Coercion -> b) -> Translate HermitC m CoreExpr b
castT t f = translate $ \ c -> \case
Cast e cast -> f <$> apply t (c @@ 0) e <*> return cast
_ -> fail "not a cast node."
castR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
castR r = castT r Cast
tickT :: Monad m => Translate HermitC m CoreExpr a -> (CoreTickish -> a -> b) -> Translate HermitC m CoreExpr b
tickT t f = translate $ \ c -> \case
Tick tk e -> f tk <$> apply t (c @@ 0) e
_ -> fail "not a tick node."
tickR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
tickR r = tickT r Tick
typeT :: Monad m => (Type -> b) -> Translate HermitC m CoreExpr b
typeT f = contextfreeT $ \case
Type t -> return (f t)
_ -> fail "not a type node."
coercionT :: Monad m => (Coercion -> b) -> Translate HermitC m CoreExpr b
coercionT f = contextfreeT $ \case
Coercion co -> return (f co)
_ -> fail "not a coercion node."
recDefT :: Monad m => (Int -> Translate HermitC m CoreExpr a1) -> ([(Id,a1)] -> b) -> Translate HermitC m CoreBind b
recDefT ts = recT (\ n -> defT (ts n) (,))
recDefAllR :: Monad m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreBind
recDefAllR rs = recAllR (\ n -> defR (rs n))
recDefAnyR :: MonadCatch m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreBind
recDefAnyR rs = recAnyR (\ n -> defR (rs n))
recDefOneR :: MonadCatch m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreBind
recDefOneR rs = recOneR (\ n -> defR (rs n))
consNonRecT :: Monad m => Translate HermitC m CoreExpr a1 -> Translate HermitC m CoreProg a2 -> (Var -> a1 -> a2 -> b) -> Translate HermitC m CoreProg b
consNonRecT t1 t2 f = progConsT (nonRecT t1 (,)) t2 (uncurry f)
consNonRecAllR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consNonRecAllR r1 r2 = progConsAllR (nonRecR r1) r2
consNonRecAnyR :: MonadCatch m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consNonRecAnyR r1 r2 = progConsAnyR (nonRecR r1) r2
consNonRecOneR :: MonadCatch m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consNonRecOneR r1 r2 = progConsOneR (nonRecR r1) r2
consRecT :: Monad m => (Int -> Translate HermitC m CoreDef a1) -> Translate HermitC m CoreProg a2 -> ([a1] -> a2 -> b) -> Translate HermitC m CoreProg b
consRecT ts t = progConsT (recT ts id) t
consRecAllR :: Monad m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consRecAllR rs r = progConsAllR (recAllR rs) r
consRecAnyR :: MonadCatch m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consRecAnyR rs r = progConsAnyR (recAnyR rs) r
consRecOneR :: MonadCatch m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consRecOneR rs r = progConsOneR (recOneR rs) r
consRecDefT :: Monad m => (Int -> Translate HermitC m CoreExpr a1) -> Translate HermitC m CoreProg a2 -> ([(Id,a1)] -> a2 -> b) -> Translate HermitC m CoreProg b
consRecDefT ts t = consRecT (\ n -> defT (ts n) (,)) t
consRecDefAllR :: Monad m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consRecDefAllR rs r = consRecAllR (\ n -> defR (rs n)) r
consRecDefAnyR :: MonadCatch m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consRecDefAnyR rs r = consRecAnyR (\ n -> defR (rs n)) r
consRecDefOneR :: MonadCatch m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreProg -> Rewrite HermitC m CoreProg
consRecDefOneR rs r = consRecOneR (\ n -> defR (rs n)) r
letNonRecT :: Monad m => Translate HermitC m CoreExpr a1 -> Translate HermitC m CoreExpr a2 -> (Var -> a1 -> a2 -> b) -> Translate HermitC m CoreExpr b
letNonRecT t1 t2 f = letT (nonRecT t1 (,)) t2 (uncurry f)
letNonRecAllR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letNonRecAllR r1 r2 = letAllR (nonRecR r1) r2
letNonRecAnyR :: MonadCatch m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letNonRecAnyR r1 r2 = letAnyR (nonRecR r1) r2
letNonRecOneR :: MonadCatch m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letNonRecOneR r1 r2 = letOneR (nonRecR r1) r2
letRecT :: Monad m => (Int -> Translate HermitC m CoreDef a1) -> Translate HermitC m CoreExpr a2 -> ([a1] -> a2 -> b) -> Translate HermitC m CoreExpr b
letRecT ts t = letT (recT ts id) t
letRecAllR :: Monad m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letRecAllR rs r = letAllR (recAllR rs) r
letRecAnyR :: MonadCatch m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letRecAnyR rs r = letAnyR (recAnyR rs) r
letRecOneR :: MonadCatch m => (Int -> Rewrite HermitC m CoreDef) -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letRecOneR rs r = letOneR (recOneR rs) r
letRecDefT :: Monad m => (Int -> Translate HermitC m CoreExpr a1) -> Translate HermitC m CoreExpr a2 -> ([(Id,a1)] -> a2 -> b) -> Translate HermitC m CoreExpr b
letRecDefT ts t = letRecT (\ n -> defT (ts n) (,)) t
letRecDefAllR :: Monad m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letRecDefAllR rs r = letRecAllR (\ n -> defR (rs n)) r
letRecDefAnyR :: MonadCatch m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letRecDefAnyR rs r = letRecAnyR (\ n -> defR (rs n)) r
letRecDefOneR :: MonadCatch m => (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreExpr -> Rewrite HermitC m CoreExpr
letRecDefOneR rs r = letRecOneR (\ n -> defR (rs n)) r
caseAltT :: Monad m => Translate HermitC m CoreExpr a1 -> (Int -> Translate HermitC m CoreExpr a2) -> (a1 -> Id -> Type -> [(AltCon,[Var],a2)] -> b) -> Translate HermitC m CoreExpr b
caseAltT t ts = caseT t (\ n -> altT (ts n) (,,))
caseAltAllR :: Monad m => Rewrite HermitC m CoreExpr -> (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreExpr
caseAltAllR t ts = caseAllR t (\ n -> altR (ts n))
caseAltAnyR :: MonadCatch m => Rewrite HermitC m CoreExpr -> (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreExpr
caseAltAnyR t ts = caseAnyR t (\ n -> altR (ts n))
caseAltOneR :: MonadCatch m => Rewrite HermitC m CoreExpr -> (Int -> Rewrite HermitC m CoreExpr) -> Rewrite HermitC m CoreExpr
caseAltOneR t ts = caseOneR t (\ n -> altR (ts n))
promoteModGutsR :: Monad m => Rewrite HermitC m ModGuts -> Rewrite HermitC m Core
promoteModGutsR = promoteWithFailMsgR "This rewrite can only succeed at the module level."
promoteProgR :: Monad m => Rewrite HermitC m CoreProg -> Rewrite HermitC m Core
promoteProgR = promoteWithFailMsgR "This rewrite can only succeed at program nodes (the top-level)."
promoteBindR :: Monad m => Rewrite HermitC m CoreBind -> Rewrite HermitC m Core
promoteBindR = promoteWithFailMsgR "This rewrite can only succeed at binding group nodes."
promoteDefR :: Monad m => Rewrite HermitC m CoreDef -> Rewrite HermitC m Core
promoteDefR = promoteWithFailMsgR "This rewrite can only succeed at recursive definition nodes."
promoteAltR :: Monad m => Rewrite HermitC m CoreAlt -> Rewrite HermitC m Core
promoteAltR = promoteWithFailMsgR "This rewrite can only succeed at case alternative nodes."
promoteExprR :: Monad m => Rewrite HermitC m CoreExpr -> Rewrite HermitC m Core
promoteExprR = promoteWithFailMsgR "This rewrite can only succeed at expression nodes."
promoteExprBiR :: Monad m => BiRewrite HermitC m CoreExpr -> BiRewrite HermitC m Core
promoteExprBiR b = bidirectional (promoteExprR $ forewardT b) (promoteExprR $ backwardT b)
promoteModGutsT :: Monad m => Translate HermitC m ModGuts b -> Translate HermitC m Core b
promoteModGutsT = promoteWithFailMsgT "This translate can only succeed at the module level."
promoteProgT :: Monad m => Translate HermitC m CoreProg b -> Translate HermitC m Core b
promoteProgT = promoteWithFailMsgT "This translate can only succeed at program nodes (the top-level)."
promoteBindT :: Monad m => Translate HermitC m CoreBind b -> Translate HermitC m Core b
promoteBindT = promoteWithFailMsgT "This translate can only succeed at binding group nodes."
promoteDefT :: Monad m => Translate HermitC m CoreDef b -> Translate HermitC m Core b
promoteDefT = promoteWithFailMsgT "This translate can only succeed at recursive definition nodes."
promoteAltT :: Monad m => Translate HermitC m CoreAlt b -> Translate HermitC m Core b
promoteAltT = promoteWithFailMsgT "This translate can only succeed at case alternative nodes."
promoteExprT :: Monad m => Translate HermitC m CoreExpr b -> Translate HermitC m Core b
promoteExprT = promoteWithFailMsgT "This translate can only succeed at expression nodes."