X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;h=162e90fa01b1f2c4b1f9f66281a7910307c6cd66;hp=411da4074c79e0f552beeecddb6ddb3f1312e81d;hb=1e436f2bb208a6c990743afaf17b7c2a93c31742;hpb=c281c07544cc58afe68fdda96afe53ba46985732

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 411da40..162e90f 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -587,43 +587,44 @@ repTy (HsForAllTy _ tvs ctxt ty)  =
     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
 --
@@ -640,6 +641,21 @@ repKind ki
                                                         (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
 -----------------------------------------------------------------------------
 
@@ -742,14 +758,8 @@ repE (ArithSeq _ aseq) =
 			     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)