Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : cardinality
http://hackage.haskell.org/trac/ghc/changeset/88d6a4a5149e311a52604c6a67a9ff3b539b094d >--------------------------------------------------------------- commit 88d6a4a5149e311a52604c6a67a9ff3b539b094d Author: Ilya Sergey <[email protected]> Date: Tue Sep 4 01:56:46 2012 +0100 rollback >--------------------------------------------------------------- compiler/basicTypes/Demand.lhs | 13 ++++++------- 1 files changed, 6 insertions(+), 7 deletions(-) diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs index 5a90f49..e512ef5 100644 --- a/compiler/basicTypes/Demand.lhs +++ b/compiler/basicTypes/Demand.lhs @@ -307,8 +307,9 @@ instance LatticeLike AbsDmd where both (UProd _ ux1) (UProd _ ux2) | length ux1 == length ux2 = absProd Many $ zipWith both ux1 ux2 -- is it correct? -- explain! - both (UCall _ u1) (UCall _ u2) = absCall Many (u1 `lub` u2) - --both (UCall _ u1) (UCall _ u2) = absCall Many (u1 `both` u2) + -- possibly, wrong... + --both (UCall _ u1) (UCall _ u2) = absCall Many (u1 `lub` u2) + both (UCall _ u1) (UCall _ u2) = absCall Many (u1 `both` u2) both _ _ = top -- utility functions @@ -532,7 +533,7 @@ should be: <L,C(U(AU))>m mkCallDmd :: JointDmd -> JointDmd mkCallDmd (JD {strd = d, absd = a}) - = mkJointDmd (strCall d) (absCall One a) + = mkJointDmd (strCall d) (absCall Many a) -- TODO: think how to peel peelCallDmd :: JointDmd -> Maybe JointDmd @@ -556,13 +557,11 @@ isSingleShot :: JointDmd -> Bool isSingleShot (JD {absd=a}) = isUsedOnce a vanillaCall :: Arity -> Demand -vanillaCall 0 = - -- we have no ide how many times the result is going to be used - evalDmd +vanillaCall 0 = onceEvalDmd vanillaCall n = -- generate C^n (S) let strComp = (iterate strCall strStr) !! n - absComp = (iterate (absCall One) usedOnce) !! n + absComp = (iterate (absCall Many) usedOnce) !! n in mkJointDmd strComp absComp \end{code} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
