import CLasH.VHDL.VHDLTypes
import qualified CLasH.Utils as Utils
import CLasH.Utils.Core.CoreTools
import CLasH.VHDL.VHDLTypes
import qualified CLasH.Utils as Utils
import CLasH.Utils.Core.CoreTools
eta, etatop :: Transform
eta expr | is_fun expr && not (is_lam expr) = do
let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
eta, etatop :: Transform
eta expr | is_fun expr && not (is_lam expr) = do
let arg_ty = (fst . Type.splitFunTy . CoreUtils.exprType) expr
then do
-- If the result is not a local var already (to prevent loops with
-- ourselves), extract it.
then do
-- If the result is not a local var already (to prevent loops with
-- ourselves), extract it.
-- Create on new binder that will actually capture a value in this
-- case statement, and return it.
let bty = (Id.idType b)
-- Create on new binder that will actually capture a value in this
-- case statement, and return it.
let bty = (Id.idType b)
let binders = take i wildbndrs ++ [id] ++ drop (i+1) wildbndrs
let caseexpr = Case scrut b bty [(con, binders, Var id)]
return (wildbndrs!!i, Just (b, caseexpr))
let binders = take i wildbndrs ++ [id] ++ drop (i+1) wildbndrs
let caseexpr = Case scrut b bty [(con, binders, Var id)]
return (wildbndrs!!i, Just (b, caseexpr))
-- We don't flag a change here, since casevalsimpl will do that above
-- based on Just we return here.
return $ (Just (id, expr), Var id)
-- We don't flag a change here, since casevalsimpl will do that above
-- based on Just we return here.
return $ (Just (id, expr), Var id)
change $ Let (Rec [(id, arg)]) (App f (Var id))
else -- Leave non-representable arguments unchanged
return expr
change $ Let (Rec [(id, arg)]) (App f (Var id))
else -- Leave non-representable arguments unchanged
return expr
-- the old body applied to some arguments.
let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
-- Create a new function with the same name but a new body
-- the old body applied to some arguments.
let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
-- Create a new function with the same name but a new body
-- Replace the original application with one of the new function to the
-- new arguments.
change $ MkCore.mkCoreApps (Var newf) newargs
-- Replace the original application with one of the new function to the
-- new arguments.
change $ MkCore.mkCoreApps (Var newf) newargs
-- Representable types will not be propagated, and arguments with free
-- type variables will be propagated later.
-- TODO: preserve original naming?
-- Representable types will not be propagated, and arguments with free
-- type variables will be propagated later.
-- TODO: preserve original naming?
-- Just pass the original argument to the new function, which binds it
-- to a new id and just pass that new id to the old function body.
return ([arg], [id], mkReferenceTo id)
-- Just pass the original argument to the new function, which binds it
-- to a new id and just pass that new id to the old function body.
return ([arg], [id], mkReferenceTo id)
-- by the argument expression.
let free_vars = VarSet.varSetElems $ CoreFVs.exprFreeVars arg
let body = MkCore.mkCoreLams free_vars arg
-- by the argument expression.
let free_vars = VarSet.varSetElems $ CoreFVs.exprFreeVars arg
let body = MkCore.mkCoreLams free_vars arg
Trans.lift $ addGlobalBind id body
-- Replace the argument with a reference to the new function, applied to
-- all vars it uses.
Trans.lift $ addGlobalBind id body
-- Replace the argument with a reference to the new function, applied to
-- all vars it uses.