diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2014-01-23 15:13:30 +0000 |
|---|---|---|
| committer | Joachim Breitner <mail@joachim-breitner.de> | 2014-01-23 18:16:45 +0000 |
| commit | 8d34ae393eb49121e51bf1f01d575928aece5cfe (patch) | |
| tree | 4e93a3570fa5e66c59d63105a6f2975222461381 /compiler/stranal | |
| parent | 26acb4981d02eb59c72d059cb196c04a7ac945af (diff) | |
| download | haskell-8d34ae393eb49121e51bf1f01d575928aece5cfe.tar.gz | |
Some polishing of the demand analyser.
I did some refactoring of the demand analyser, because I was smelling
some minor code smell. Most of my changes I had to undo, though,
adding notes and testcases on why the existing code was correct after
all.
Especially the semantics of the DmdResult is confusing, as it differs in
a DmdType and a StrictSig.
I got to imrpove the readability of the code for lubDmdType, though.
Also, dmdAnalRhs was a bit fishy in how it removed the demand on
further arguments of the body, but used the DmdResult. This would be
wrong if a body would return a demand type of "<L>m" (which currently
does not happen). This is now treated better in removeDmdTyArgs.
Diffstat (limited to 'compiler/stranal')
| -rw-r--r-- | compiler/stranal/DmdAnal.lhs | 15 |
1 files changed, 8 insertions, 7 deletions
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 9a7c985e46..e9a7ab488f 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -602,13 +602,14 @@ dmdAnalRhs top_lvl rec_flag env id rhs | otherwise = (sig_ty, lazy_fv, id', mkLams bndrs' body') where - (bndrs, body) = collectBinders rhs - env_body = foldl extendSigsWithLam env bndrs - (DmdType body_fv _ body_res, body') = dmdAnal env_body body_dmd body - (DmdType rhs_fv rhs_dmds rhs_res, bndrs') = annotateLamBndrs env (isDFunId id) - (DmdType body_fv [] body_res) bndrs - sig_ty = mkStrictSig (mkDmdType sig_fv rhs_dmds rhs_res') - id' = set_idStrictness env id sig_ty + (bndrs, body) = collectBinders rhs + env_body = foldl extendSigsWithLam env bndrs + (body_ty, body') = dmdAnal env_body body_dmd body + body_ty' = removeDmdTyArgs body_ty -- zap possible deep CPR info + (DmdType rhs_fv rhs_dmds rhs_res, bndrs') + = annotateLamBndrs env (isDFunId id) body_ty' bndrs + sig_ty = mkStrictSig (mkDmdType sig_fv rhs_dmds rhs_res') + id' = set_idStrictness env id sig_ty -- See Note [NOINLINE and strictness] -- See Note [Product demands for function body] |