STG linter's type equality can loop

stgEqType will currently loop when given the following,

stgEqType (a -> IO ()) (a -> IO ())

The problem is that the (->) tycon now takes runtime rep arguments.

To see why, let's look at the (paraphrased) implementation,

stgEqType orig_ty1 orig_ty2
  = gos (typePrimRep orig_ty1) (typePrimRep orig_ty2)
  where
    gos :: [PrimRep] -> [PrimRep] -> Bool
    gos [_]   [_]   = go orig_ty1 orig_ty2
    gos reps1 reps2 = reps1 == reps2

    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)
                  else (isFamilyTyCon tc1 || isFamilyTyCon tc2)
      = res

      | otherwise = True  -- Conservatively say "fine".

Our example will begin by looking at the gos (typePrimRep orig_ty1) (typePrimRep orig_ty2) and, seeing that the orig_tys are unary, enter go. We will then split the applications such that,

tc1, tc2 = (->)
tc_args1, tc_args2 = ['LiftedPtrRep, 'LiftedPtrRep, a, IO ()]

Seeing that the tycons are equal, we will enter gos on each of the tc_args. Of course, one would think that typePrimRep 'LiftedPtrRep should throw an error, but because gos only forces the spine of the list, that error doesn't get thrown. Instead we incorrectly conclude that 'LiftedPtrRep is a unary type and recurse into go orig_ty1 orig_ty2, thus looping.

Trac metadata

Trac field	Value
Version	8.0.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture