Commit be04c16b authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari
Browse files

StgLint: Don't loop on tycons with runtime rep arguments

Test Plan: Validate

Reviewers: austin

Subscribers: rwbarton, thomie

GHC Trac Issues: #13941

Differential Revision: https://phabricator.haskell.org/D3714
parent fcd2db14
......@@ -27,7 +27,6 @@ import Util
import SrcLoc
import Outputable
import Control.Monad
import Data.Function
#include "HsVersions.h"
......@@ -419,18 +418,32 @@ stgEqType :: Type -> Type -> Bool
-- Fundamentally this is a losing battle because of unsafeCoerce
stgEqType orig_ty1 orig_ty2
= gos (typePrimRep orig_ty1) (typePrimRep orig_ty2)
= gos orig_ty1 orig_ty2
where
gos :: [PrimRep] -> [PrimRep] -> Bool
gos [_] [_] = go orig_ty1 orig_ty2
gos reps1 reps2 = reps1 == reps2
gos :: Type -> Type -> Bool
gos ty1 ty2
-- These have no prim rep
| isRuntimeRepKindedTy ty1 && isRuntimeRepKindedTy ty2
= True
-- We have a unary type
| [_] <- reps1, [_] <- reps2
= go ty1 ty2
-- In the case of a tuple just compare prim reps
| otherwise
= reps1 == reps2
where
reps1 = typePrimRep ty1
reps2 = typePrimRep ty2
go :: UnaryType -> UnaryType -> Bool
go ty1 ty2
| Just (tc1, tc_args1) <- splitTyConApp_maybe ty1
, Just (tc2, tc_args2) <- splitTyConApp_maybe ty2
, let res = if tc1 == tc2
then equalLength tc_args1 tc_args2 && and (zipWith (gos `on` typePrimRep) tc_args1 tc_args2)
then equalLength tc_args1 tc_args2
&& and (zipWith gos tc_args1 tc_args2)
else -- TyCons don't match; but don't bleat if either is a
-- family TyCon because a coercion might have made it
-- equal to something else
......
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