-- a Royal Pain (triggers other recompilation).
-----------------------------------------------------------------------------
-{-# OPTIONS -fno-warn-unused-imports #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
--- The kludge is only needed in this module because of trac #2267.
-
module DsMeta( dsBracket,
templateHaskellNames, qTyConName, nameTyConName,
liftName, liftStringName, expQTyConName, patQTyConName, decQTyConName, typeQTyConName,
import {-# SOURCE #-} DsExpr ( dsExpr )
import MatchLit
-import DsUtils
import DsMonad
import qualified Language.Haskell.TH as TH
repTForall bndrs1 ctxt1 ty1
repTy (HsTyVar n)
- | isTvOcc (nameOccName n) = do
- tv1 <- lookupTvOcc n
- repTvar tv1
- | otherwise = do
- tc1 <- lookupOcc n
- repNamedTyCon tc1
-repTy (HsAppTy f a) = do
- f1 <- repLTy f
- a1 <- repLTy a
- repTapp f1 a1
-repTy (HsFunTy f a) = do
- f1 <- repLTy f
- a1 <- repLTy a
- tcon <- repArrowTyCon
- repTapps tcon [f1, a1]
-repTy (HsListTy t) = do
- t1 <- repLTy t
- tcon <- repListTyCon
- repTapp tcon t1
-repTy (HsPArrTy t) = do
- t1 <- repLTy t
- tcon <- repTy (HsTyVar (tyConName parrTyCon))
- repTapp tcon t1
-repTy (HsTupleTy _ tys) = do
- tys1 <- repLTys tys
- tcon <- repTupleTyCon (length tys)
- repTapps tcon tys1
-repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
- `nlHsAppTy` ty2)
-repTy (HsParTy t) = repLTy t
-repTy (HsPredTy pred) = repPredTy pred
-repTy (HsKindSig t k) = do
- t1 <- repLTy t
- k1 <- repKind k
- repTSig t1 k1
-repTy ty@(HsNumTy _) = notHandled "Number types (for generics)" (ppr ty)
-repTy ty = notHandled "Exotic form of type" (ppr ty)
+ | isTvOcc (nameOccName n) = do
+ tv1 <- lookupTvOcc n
+ repTvar tv1
+ | otherwise = do
+ tc1 <- lookupOcc n
+ repNamedTyCon tc1
+repTy (HsAppTy f a) = do
+ f1 <- repLTy f
+ a1 <- repLTy a
+ repTapp f1 a1
+repTy (HsFunTy f a) = do
+ f1 <- repLTy f
+ a1 <- repLTy a
+ tcon <- repArrowTyCon
+ repTapps tcon [f1, a1]
+repTy (HsListTy t) = do
+ t1 <- repLTy t
+ tcon <- repListTyCon
+ repTapp tcon t1
+repTy (HsPArrTy t) = do
+ t1 <- repLTy t
+ tcon <- repTy (HsTyVar (tyConName parrTyCon))
+ repTapp tcon t1
+repTy (HsTupleTy _ tys) = do
+ tys1 <- repLTys tys
+ tcon <- repTupleTyCon (length tys)
+ repTapps tcon tys1
+repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
+ `nlHsAppTy` ty2)
+repTy (HsParTy t) = repLTy t
+repTy (HsPredTy pred) = repPredTy pred
+repTy (HsKindSig t k) = do
+ t1 <- repLTy t
+ k1 <- repKind k
+ repTSig t1 k1
+repTy (HsSpliceTy splice) = repSplice splice
+repTy ty@(HsNumTy _) = notHandled "Number types (for generics)" (ppr ty)
+repTy ty = notHandled "Exotic form of type" (ppr ty)
-- represent a kind
--
(ppr k)
-----------------------------------------------------------------------------
+-- Splices
+-----------------------------------------------------------------------------
+
+repSplice :: HsSplice Name -> DsM (Core a)
+-- See Note [How brackets and nested splices are handled] in TcSplice
+-- We return a CoreExpr of any old type; the context should know
+repSplice (HsSplice n _)
+ = do { mb_val <- dsLookupMetaEnv n
+ ; case mb_val of
+ Just (Splice e) -> do { e' <- dsExpr e
+ ; return (MkC e') }
+ _ -> pprPanic "HsSplice" (ppr n) }
+ -- Should not happen; statically checked
+
+-----------------------------------------------------------------------------
-- Expressions
-----------------------------------------------------------------------------
repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
repE e@(ExplicitTuple es boxed)
- | isBoxed boxed = do { xs <- repLEs es; repTup xs }
- | otherwise = notHandled "Unboxed tuples" (ppr e)
+ | not (isBoxed boxed) = notHandled "Unboxed tuples" (ppr e)
+ | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
+ | otherwise = do { xs <- repLEs [e | Present e <- es]; repTup xs }
+
repE (RecordCon c _ flds)
= do { x <- lookupLOcc c;
fs <- repFields flds;
ds2 <- repLE e2
ds3 <- repLE e3
repFromThenTo ds1 ds2 ds3
-repE (HsSpliceE (HsSplice n _))
- = do { mb_val <- dsLookupMetaEnv n
- ; case mb_val of
- Just (Splice e) -> do { e' <- dsExpr e
- ; return (MkC e') }
- _ -> pprPanic "HsSplice" (ppr n) }
- -- Should not happen; statically checked
+repE (HsSpliceE splice) = repSplice splice
repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e)