From: igloo <unknown>
Date: Sun, 6 Apr 2003 22:08:49 +0000 (+0000)
Subject: [project @ 2003-04-06 22:08:49 by igloo]
X-Git-Tag: Approx_11550_changesets_converted~992
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=8b2b2f7b8fc00e5b776b5766b72ef00fd65496db;p=ghc-hetmet.git

[project @ 2003-04-06 22:08:49 by igloo]
Typecheck type reification brackets [t| ... |]
---

diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs
index 3278fd9..5f05962 100644
--- a/ghc/compiler/typecheck/TcSplice.lhs
+++ b/ghc/compiler/typecheck/TcSplice.lhs
@@ -28,12 +28,13 @@ import TcUnify		( unifyTauTy )
 import TcType		( TcType, openTypeKind, mkAppTy )
 import TcEnv		( spliceOK, tcMetaTy, tcWithTempInstEnv, bracketOK )
 import TcRnTypes	( TopEnv(..) )
-import TcMType		( newTyVarTy, zapToType )
+import TcMType		( newTyVarTy, zapToType, UserTypeCtxt(ExprSigCtxt) )
+import TcMonoType	( tcHsSigType )
 import Name		( Name )
 import TcRnMonad
 
 import TysWiredIn	( mkListTy )
-import DsMeta		( exprTyConName, declTyConName, decTyConName, qTyConName )
+import DsMeta		( exprTyConName, declTyConName, typeTyConName, decTyConName, qTyConName )
 import ErrUtils (Message)
 import Outputable
 import Panic		( showException )
@@ -94,12 +95,18 @@ tcBracket brack res_ty
     returnM (HsBracketOut brack pendings)
     }
 
+tc_bracket :: HsBracket Name -> TcM TcType
 tc_bracket (ExpBr expr) 
   = newTyVarTy openTypeKind		`thenM` \ any_ty ->
     tcMonoExpr expr any_ty		`thenM_`
     tcMetaTy exprTyConName
 	-- Result type is Expr (= Q Exp)
 
+tc_bracket (TypBr typ) 
+  = tcHsSigType ExprSigCtxt typ		`thenM_`
+    tcMetaTy typeTyConName
+	-- Result type is Type (= Q Typ)
+
 tc_bracket (DecBr decls)
   = tcWithTempInstEnv (tcTopSrcDecls decls)	`thenM_`
 	-- Typecheck the declarations, dicarding any side effects