Commit 98b6756b authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu

Fix #8807.

It turns out that the enhanced repPred function in DsMeta assumed
that the head of any constraint would be a tycon. This assumption
is false. Happily, the solution involved *deleting* code. I
just removed repPred in favor of repTy, and added the HsEqTy case
to repTy, where it should be anyway.
parent 018676c7
......@@ -754,41 +754,9 @@ repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
repLContext (L _ ctxt) = repContext ctxt
repContext :: HsContext Name -> DsM (Core TH.CxtQ)
repContext ctxt = do preds <- repList predQTyConName repLPred ctxt
repContext ctxt = do preds <- repList typeQTyConName repLTy ctxt
repCtxt preds
-- represent a type predicate
--
repLPred :: LHsType Name -> DsM (Core TH.PredQ)
repLPred (L _ p) = repPred p
repPred :: HsType Name -> DsM (Core TH.PredQ)
repPred (HsParTy ty)
= repLPred ty
repPred ty
| Just (cls, tys) <- splitHsClassTy_maybe ty
-- works even when cls is not a class (ConstraintKinds)
= do
cls1 <- lookupOcc cls
tyco <- repNamedTyCon cls1
tys' <- mapM repLTy tys
repTapps tyco tys'
repPred (HsEqTy tyleft tyright)
= do
tyleft1 <- repLTy tyleft
tyright1 <- repLTy tyright
eq <- repTequality
repTapps eq [tyleft1, tyright1]
repPred (HsTupleTy _ lps)
= do
tupTy <- repTupleTyCon size
tys' <- mapM repLTy lps
repTapps tupTy tys'
where
size = length lps
repPred ty
= notHandled "Exotic predicate type" (ppr ty)
-- yield the representation of a list of types
--
repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
......@@ -843,6 +811,11 @@ repTy (HsTupleTy _ tys) = do tys1 <- repLTys tys
repTy (HsOpTy ty1 (_, n) ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
`nlHsAppTy` ty2)
repTy (HsParTy t) = repLTy t
repTy (HsEqTy t1 t2) = do
t1' <- repLTy t1
t2' <- repLTy t2
eq <- repTequality
repTapps eq [t1', t2']
repTy (HsKindSig t k) = do
t1 <- repLTy t
k1 <- repLKind k
......@@ -858,6 +831,7 @@ repTy (HsExplicitTupleTy _ tys) = do
repTy (HsTyLit lit) = do
lit' <- repTyLit lit
repTLit lit'
repTy ty = notHandled "Exotic form of type" (ppr ty)
repTyLit :: HsTyLit -> DsM (Core TH.TyLitQ)
......
{-# LANGUAGE ConstraintKinds #-}
module T8807 where
import Data.Proxy
foo :: $( [t| a b => Proxy a -> b -> b |] )
foo = undefined
\ No newline at end of file
......@@ -320,4 +320,5 @@ test('T8625', normal, ghci_script, ['T8625.script'])
test('T8759', normal, compile_fail, ['-v0'])
test('T8759a', normal, compile_fail, ['-v0'])
test('T7021',
extra_clean(['T7021a.hi', 'T7021a.o']), multimod_compile, ['T7021','-v0'])
\ No newline at end of file
extra_clean(['T7021a.hi', 'T7021a.o']), multimod_compile, ['T7021','-v0'])
test('T8807', normal, compile, ['-v0'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment