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

1 files changed, 19 insertions, 6 deletions

diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs
index 7a1ed4df92..cbfd11b8d9 100644
--- a/compiler/stgSyn/StgLint.hs
+++ b/compiler/stgSyn/StgLint.hs
@@ -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