module Tip.Pass.Uncurry(uncurryTheory) where
import Tip.Core
import Tip.Fresh
import Tip.WorkerWrapper
uncurryTheory :: Name a => Theory a -> Fresh (Theory a)
uncurryTheory thy =
workerWrapperFunctions outerUncurryWW thy >>=
workerWrapperFunctions innerUncurryWW
outerUncurryWW :: Name a => Function a -> Maybe (Fresh (WorkerWrapper a))
outerUncurryWW func@Function{func_res = args :=>: res, ..} = Just $ do
lcls <- mapM freshLocal args
return WorkerWrapper {
ww_func = func,
ww_args = func_args ++ lcls,
ww_res = res,
ww_def = \e -> apply e (map Lcl lcls),
ww_use =
\hd@(Gbl Global{..}) orig_args -> do
new_args <- mapM (freshLocal . applyType func_tvs gbl_args) args
return (Lam new_args (hd :@: (orig_args ++ map Lcl new_args)))
}
outerUncurryWW _ = Nothing
innerUncurryWW :: Name a => Function a -> Maybe (Fresh (WorkerWrapper a))
innerUncurryWW _func = Nothing