[commit: ghc] master: StgLint: Give up on trying to compare types (f17f106)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/f17f1063a29452843195c59e6cca2191b9d46c7f/ghc

>---------------------------------------------------------------

commit f17f1063a29452843195c59e6cca2191b9d46c7f
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue Aug 29 14:53:35 2017 -0400

    StgLint: Give up on trying to compare types
    
    We used to try a crude comparison of the type themselves, but this is
    essentially impossible in STG as we have discarded. both casts and type
    applications, so types might look different but be the same.  Now we
    simply compare their runtime representations.
    
    See #14120.
    
    Reviewers: austin
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #14120
    
    Differential Revision: https://phabricator.haskell.org/D3879


>---------------------------------------------------------------

f17f1063a29452843195c59e6cca2191b9d46c7f
 compiler/stgSyn/StgLint.hs | 52 +++++++---------------------------------------
 1 file changed, 8 insertions(+), 44 deletions(-)

diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs
index ac25ab5..5140a47 100644
--- a/compiler/stgSyn/StgLint.hs
+++ b/compiler/stgSyn/StgLint.hs
@@ -425,52 +425,16 @@ checkFunApp fun_ty arg_tys msg
       | otherwise
       = (Nothing, Nothing)
 
+-- | "Compare" types. We used to try a crude comparison of the type themselves,
+-- but this is essentially impossible in STG as we have discarded. both casts
+-- and type applications, so types might look different but be the same. Now we
+-- simply compare their runtime representations. See #14120.
 stgEqType :: Type -> Type -> Bool
--- Compare types, but crudely because we have discarded
--- both casts and type applications, so types might look
--- different but be the same.  So reply "True" if in doubt.
--- "False" means that the types are definitely different.
---
--- Fundamentally this is a losing battle because of unsafeCoerce
-
-stgEqType orig_ty1 orig_ty2
-  = gos orig_ty1 orig_ty2
+stgEqType ty1 ty2
+  = reps1 == reps2
   where
-    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 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
-                    (isFamilyTyCon tc1 || isFamilyTyCon tc2)
-      = if res then True
-        else
-        pprTrace "stgEqType: unequal" (vcat [ppr ty1, ppr ty2])
-        False
-
-      | otherwise = True  -- Conservatively say "fine".
-                          -- Type variables in particular
+    reps1 = typePrimRep ty1
+    reps2 = typePrimRep ty2
 
 checkInScope :: Id -> LintM ()
 checkInScope id = LintM $ \_lf loc scope errs