Commit 3198956d authored by Arnaud Spiwack's avatar Arnaud Spiwack Committed by Ben Gamari

Factor mkCoreApp and mkCoreApps

`mkCoreApps` re-implemented `mkCoreApp` in a recursive function,
rather than using a simple `foldl'` in order to avoid repeatingly
computing the type of the function argument. I've factored the two
logic into a new (internal) function `mkCoreType` which assumes that
the type is known. `mkCoreApp` and `mkCoreApps` are thin wrappers
around it.

Differences
- The assertion failure message of `mkCoreApps` has more
  information in it.
- `mkCoreApps` now special-cases coercion argument like
  `mkCoreApp` (previously they were given to `mk_val_app` instead)

Reviewers: austin, bgamari

Reviewed By: bgamari

Subscribers: rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3971
parent bbb8cb92
......@@ -119,35 +119,44 @@ mkCoreLet bind body
mkCoreLets :: [CoreBind] -> CoreExpr -> CoreExpr
mkCoreLets binds body = foldr mkCoreLet body binds
-- | Construct an expression which represents the application of one expression
-- paired with its type to an argument. The result is paired with its type. This
-- function is not exported and used in the definition of 'mkCoreApp' and
-- 'mkCoreApps'.
-- Respects the let/app invariant by building a case expression where necessary
-- See CoreSyn Note [CoreSyn let/app invariant]
mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type)
mkCoreAppTyped _ (fun, fun_ty) (Type ty)
= (App fun (Type ty), piResultTy fun_ty ty)
mkCoreAppTyped _ (fun, fun_ty) (Coercion co)
= (App fun (Coercion co), res_ty)
where
(_, res_ty) = splitFunTy fun_ty
mkCoreAppTyped d (fun, fun_ty) arg
= ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg $$ d )
(mk_val_app fun arg arg_ty res_ty, res_ty)
where
(arg_ty, res_ty) = splitFunTy fun_ty
-- | Construct an expression which represents the application of one expression
-- to the other
mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
-- Respects the let/app invariant by building a case expression where necessary
-- See CoreSyn Note [CoreSyn let/app invariant]
mkCoreApp _ fun (Type ty) = App fun (Type ty)
mkCoreApp _ fun (Coercion co) = App fun (Coercion co)
mkCoreApp d fun arg = ASSERT2( isFunTy fun_ty, ppr fun $$ ppr arg $$ d )
mk_val_app fun arg arg_ty res_ty
where
fun_ty = exprType fun
(arg_ty, res_ty) = splitFunTy fun_ty
mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
mkCoreApp s fun arg
= fst $ mkCoreAppTyped s (fun, exprType fun) arg
-- | Construct an expression which represents the application of a number of
-- expressions to another. The leftmost expression in the list is applied first
-- Respects the let/app invariant by building a case expression where necessary
-- See CoreSyn Note [CoreSyn let/app invariant]
mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr
-- Slightly more efficient version of (foldl mkCoreApp)
mkCoreApps orig_fun orig_args
= go orig_fun (exprType orig_fun) orig_args
mkCoreApps fun args
= fst $
foldl' (mkCoreAppTyped doc_string) (fun, fun_ty) args
where
go fun _ [] = fun
go fun fun_ty (Type ty : args) = go (App fun (Type ty)) (piResultTy fun_ty ty) args
go fun fun_ty (arg : args) = ASSERT2( isFunTy fun_ty, ppr fun_ty $$ ppr orig_fun
$$ ppr orig_args )
go (mk_val_app fun arg arg_ty res_ty) res_ty args
where
(arg_ty, res_ty) = splitFunTy fun_ty
doc_string = ppr fun_ty $$ ppr fun $$ ppr args
fun_ty = exprType fun
-- | Construct an expression which represents the application of a number of
-- expressions to that of a data constructor expression. The leftmost expression
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment