projects
/
matthijs
/
master-project
/
cλash.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add and use a mkFunction utility function.
[matthijs/master-project/cλash.git]
/
Normalize.hs
diff --git
a/Normalize.hs
b/Normalize.hs
index cbe2090e22def5d29d3b24bb878f37c68b81b3ea..93e89b615a0b493ef8a64ebdb99d9029f7ec5f15 100644
(file)
--- a/
Normalize.hs
+++ b/
Normalize.hs
@@
-62,7
+62,7
@@
beta (App (Let binds expr) arg) = change $ Let binds (App expr arg)
beta (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
where
alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
beta (App (Case scrut b ty alts) arg) = change $ Case scrut b ty' alts'
where
alts' = map (\(con, bndrs, expr) -> (con, bndrs, (App expr arg))) alts
- (_, ty') = Type.splitFunTy ty
+ ty' = CoreUtils.applyTypeToArg ty arg
-- Leave all other expressions unchanged
beta expr = return expr
-- Perform this transform everywhere
-- Leave all other expressions unchanged
beta expr = return expr
-- Perform this transform everywhere
@@
-302,14
+302,13
@@
typeprop, typeproptop :: Transform
-- arguments without any free tyvars, since tyvars those wouldn't be in scope
-- in the new function.
typeprop expr@(App (Var f) arg@(Type ty)) | not $ has_free_tyvars arg = do
-- arguments without any free tyvars, since tyvars those wouldn't be in scope
-- in the new function.
typeprop expr@(App (Var f) arg@(Type ty)) | not $ has_free_tyvars arg = do
- id <- cloneVar f
- let newty = Type.applyTy (Id.idType f) ty
- let newf = Var.setVarType id newty
body_maybe <- Trans.lift $ getGlobalBind f
case body_maybe of
Just body -> do
let newbody = App body (Type ty)
body_maybe <- Trans.lift $ getGlobalBind f
case body_maybe of
Just body -> do
let newbody = App body (Type ty)
- Trans.lift $ addGlobalBind newf newbody
+ -- Create a new function with the same name but a new body
+ newf <- mkFunction f newbody
+ -- Replace the application with this new function
change (Var newf)
-- If we don't have a body for the function called, leave it unchanged (it
-- should be a primitive function then).
change (Var newf)
-- If we don't have a body for the function called, leave it unchanged (it
-- should be a primitive function then).
@@
-346,11
+345,8
@@
funprop expr@(App _ _) | is_var fexpr && not (any has_free_tyvars args) = do
-- Create a new body that consists of a lambda for all new arguments and
-- the old body applied to some arguments.
let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
-- Create a new body that consists of a lambda for all new arguments and
-- the old body applied to some arguments.
let newbody = MkCore.mkCoreLams newparams (MkCore.mkCoreApps body oldargs)
- -- Create a new function name
- id <- cloneVar f
- let newf = Var.setVarType id (CoreUtils.exprType newbody)
- -- Add the new function
- Trans.lift $ addGlobalBind newf newbody
+ -- Create a new function with the same name but a new body
+ newf <- mkFunction f newbody
-- 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