[GHC] #13035: GHC enters a loop when partial type signatures and advanced type level code mix

[GHC]

#13035: GHC enters a loop when partial type signatures and advanced type level code
mix
-------------------------------------+-------------------------------------
           Reporter:  xcmw           |             Owner:
               Type:  bug            |            Status:  new
           Priority:  normal         |         Milestone:
          Component:  Compiler       |           Version:  8.0.1
           Keywords:                 |  Operating System:  Unknown/Multiple
       Architecture:                 |   Type of failure:  None/Unknown
  Unknown/Multiple                   |
          Test Case:                 |        Blocked By:
           Blocking:                 |   Related Tickets:
Differential Rev(s):                 |         Wiki Page:
-------------------------------------+-------------------------------------
 GHC loops when compiling this code. Replacing the _ with the actual type
 fixes the error.

 {{{#!hs
 {-# LANGUAGE PolyKinds, DataKinds, TypeOperators, TypeFamilies,
 TemplateHaskell, GADTs, PartialTypeSignatures #-}
 import Data.Vinyl
 import Data.Singletons.TH

 newtype MyAttr a b = MyAttr { _unMyAttr :: MyFun (a b) }
 type MyRec a b = Rec (MyAttr a) b

 type family MyFun (a :: k1) :: k2

 data GY (a :: k1) (b :: k2) (c :: k1 -> k3) (d :: k1)
 data GNone (a :: k1)

 type family GYTF a where
     GYTF (GY a b _ a) = b
     GYTF (GY _ _ c d) = MyFun (c d)

 type instance MyFun (GY a b c d) = GYTF (GY a b c d)

 type family GNoneTF (a :: k1) :: k2 where

 type instance MyFun (GNone a) = GNoneTF a

 type (a :: k1) =: (b :: k2) = a `GY` b
 type (a :: j1 -> j2) $ (b :: j1) = a b

 infixr 0 $
 infixr 9 =:

 data FConst (a :: *) (b :: Fields)
 data FApply (a :: * -> * -> *) b c (d :: Fields)
 data FMap (a :: * -> *) b (d :: Fields)

 type instance MyFun (FConst a b) = a
 type instance MyFun (FApply b c d a) = b (MyFun (c a)) (MyFun (d a))
 type instance MyFun (FMap b c a) = b (MyFun (c a))

 data Fields = Name | Author | Image | Description | Ingredients |
 Instructions | CookTime | PrepTime | TotalTime | Yield | Nutrition | Tags
 | Url
             | Section | Items | Subsections
             | Calories | Carbohydrates | Cholesterol | Fat | Fiber |
 Protien | SaturatedFat | Sodium | Sugar | TransFat | UnsaturatedFat |
 ServingSize

 genSingletons [ ''Fields ]

 (=::) :: sing f -> MyFun (a f) -> MyAttr a f
 _ =:: x = MyAttr x

 type NutritionT
     = Calories       =: Maybe Int
     $ Carbohydrates  =: Maybe Int
     $ Cholesterol    =: Maybe Int
     $ Fat            =: Maybe Int
     $ Fiber          =: Maybe Int
     $ Protien        =: Maybe Int
     $ SaturatedFat   =: Maybe Int
     $ Sodium         =: Maybe Int
     $ Sugar          =: Maybe Int
     $ TransFat       =: Maybe Int
     $ UnsaturatedFat =: Maybe Int
     $ ServingSize    =: String
     $ GNone

 type NutritionRec = MyRec NutritionT ['Calories, 'Carbohydrates,
 'Cholesterol, 'Fat, 'Fiber, 'Protien, 'SaturatedFat, 'Sodium, 'Sugar,
 'TransFat, 'UnsaturatedFat, 'ServingSize]

 type RecipeT
     = Name         =: String
     $ Author       =: String
     $ Image        =: String
     $ Description  =: String
     $ CookTime     =: Maybe Int
     $ PrepTime     =: Maybe Int
     $ TotalTime    =: Maybe Int
     $ Yield        =: String
     $ Nutrition    =: NutritionRec
     $ Tags         =: [String]
     $ Url          =: String
     $ GNone

 type RecipeFormatter = FApply (->) (FConst [String]) (FMap IO RecipeT)

 g :: MyRec RecipeFormatter _ --'[ 'Author ] Uncomment to prevent loop
 g
      = SAuthor =:: (\a -> return "Hi")
     :& RNil

 main = putStrLn "Hi"
 }}}

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/13035>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler