Commit 4ff3da9a authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

FIX: mkWWcpr takes open alg types into account

- This fixed the failures of GMapAssoc and GMapTop for optmising ways

MERGE TO STABLE
parent 4f56b407
......@@ -27,9 +27,7 @@ import NewDemand ( Demand(..), DmdResult(..), Demands(..) )
import MkId ( realWorldPrimId, voidArgId, mkRuntimeErrorApp, rUNTIME_ERROR_ID,
mkUnpackCase, mkProductBox )
import TysWiredIn ( tupleCon )
import Type ( Type, isUnLiftedType, mkFunTys,
splitForAllTys, splitFunTys, isAlgType
)
import Type
import Coercion ( mkSymCoercion, splitNewTypeRepCo_maybe )
import BasicTypes ( Boxity(..) )
import Var ( Var, isId )
......@@ -422,8 +420,9 @@ mkWWcpr :: Type -- function body type
Type) -- Type of worker's body
mkWWcpr body_ty RetCPR
| not (isAlgType body_ty)
= WARN( True, text "mkWWcpr: non-algebraic body type" <+> ppr body_ty )
| not (isClosedAlgType body_ty)
= WARN( True,
text "mkWWcpr: non-algebraic or open body type" <+> ppr body_ty )
returnUs (id, id, body_ty)
| n_con_args == 1 && isUnLiftedType con_arg_ty1
......
......@@ -67,8 +67,8 @@ module Type (
newTyConInstRhs,
-- Lifting and boxity
isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
isStrictType, isStrictPred,
isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType,
isPrimitiveType, isStrictType, isStrictPred,
-- Free variables
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
......@@ -861,10 +861,19 @@ isUnboxedTupleType ty = case splitTyConApp_maybe ty of
-- Should only be applied to *types*; hence the assert
isAlgType :: Type -> Bool
isAlgType ty = case splitTyConApp_maybe ty of
Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
isAlgTyCon tc
other -> False
isAlgType ty
= case splitTyConApp_maybe ty of
Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
isAlgTyCon tc
_other -> False
-- Should only be applied to *types*; hence the assert
isClosedAlgType :: Type -> Bool
isClosedAlgType ty
= case splitTyConApp_maybe ty of
Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
isAlgTyCon tc && not (isOpenTyCon tc)
_other -> False
\end{code}
@isStrictType@ computes whether an argument (or let RHS) should
......
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