Wibbles to lunaris's patch for promoted kinds
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 18 May 2012 09:10:28 +0000 (10:10 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Fri, 18 May 2012 09:10:28 +0000 (10:10 +0100)
compiler/deSugar/DsMeta.hs
compiler/hsSyn/Convert.lhs

index c9fa60d..6d1520b 100644 (file)
@@ -722,19 +722,15 @@ repTy (HsForAllTy _ tvs ctxt ty)  =
     repTForall bndrs ctxt1 ty1
 
 repTy (HsTyVar n)
-  | isTvOcc occ = do
-                               tv1 <- lookupOcc n
-                               repTvar tv1
-  | n == consDataConName = repPromotedConsTyCon
-  | isDataOcc occ = do
-                      tc1 <- lookupOcc n
-                      repPromotedTyCon tc1
-  | otherwise              = do
-                               tc1 <- lookupOcc n
-                               repNamedTyCon tc1
-
+  | isTvOcc occ   = do tv1 <- lookupOcc n
+                      repTvar tv1
+  | isDataOcc occ = do tc1 <- lookupOcc n
+                       repPromotedTyCon tc1
+  | otherwise    = do tc1 <- lookupOcc n
+                      repNamedTyCon tc1
   where
     occ = nameOccName n
+
 repTy (HsAppTy f a)         = do
                                f1 <- repLTy f
                                a1 <- repLTy a
index f4aae3f..ef17c60 100644 (file)
@@ -876,9 +876,12 @@ cvtTypeKind ty_str ty
            PromotedNilT
              -> returnL (HsExplicitListTy placeHolderKind [])
 
-           PromotedConsT
-             | [ty1, ty2] <- tys'
-             -> mk_apps (HsTyVar (getRdrName consDataCon)) [ty1, ty2]
+           PromotedConsT  -- See Note [Representing concrete syntax in types] 
+                          -- in Language.Haskell.TH.Syntax
+             | [ty1, L _ (HsExplicitListTy _ tys2)] <- tys'
+             -> returnL (HsExplicitListTy placeHolderKind (ty1:tys2))
+             | otherwise 
+             -> mk_apps (HsTyVar (getRdrName consDataCon)) tys'
 
            StarT
              -> returnL (HsTyVar (getRdrName liftedTypeKindTyCon))