*** compiler/typecheck/TcSplice.lhs	2010-11-08 17:39:14.000000000 -0500
--- compiler/typecheck/TcSplice.lhs	2010-11-05 16:03:14.625037000 -0400
***************
*** 286,294 ****
  %************************************************************************
  
  \begin{code}
! tcBracket     :: HsBracket Name -> BoxyRhoType -> TcM (LHsExpr TcId)
  tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
! tcSpliceExpr  :: HsSplice Name -> BoxyRhoType -> TcM (HsExpr TcId)
  kcSpliceType  :: HsSplice Name -> FreeVars -> TcM (HsType Name, TcKind)
  	-- None of these functions add constraints to the LIE
  
--- 286,294 ----
  %************************************************************************
  
  \begin{code}
! tcBracket     :: HsBracket Name -> TcRhoType -> TcM (LHsExpr TcId)
  tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
! tcSpliceExpr  :: HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
  kcSpliceType  :: HsSplice Name -> FreeVars -> TcM (HsType Name, TcKind)
  	-- None of these functions add constraints to the LIE
  
***************
*** 340,356 ****
  	-- but throw away the results.  We'll type check
  	-- it again when we actually use it.
         ; pending_splices <- newMutVar []
!        ; lie_var <- getLIEVar
         ; let brack_stage = Brack cur_stage pending_splices lie_var
  
         ; (meta_ty, lie) <- setStage brack_stage $
!                            getLIE $
                             tc_bracket cur_stage brack
  
!        ; tcSimplifyBracket lie
  
  	-- Make the expected type have the right shape
!        ; _ <- boxyUnify meta_ty res_ty
  
  	-- Return the original expression, not the type-decorated one
         ; pendings <- readMutVar pending_splices
--- 340,356 ----
  	-- but throw away the results.  We'll type check
  	-- it again when we actually use it.
         ; pending_splices <- newMutVar []
!        ; lie_var <- getConstraintVar
         ; let brack_stage = Brack cur_stage pending_splices lie_var
  
         ; (meta_ty, lie) <- setStage brack_stage $
!                            getConstraints $
                             tc_bracket cur_stage brack
  
!        ; simplifyBracket lie
  
  	-- Make the expected type have the right shape
!        ; _ <- unifyType meta_ty res_ty
  
  	-- Return the original expression, not the type-decorated one
         ; pendings <- readMutVar pending_splices
***************
*** 395,401 ****
  
  tc_bracket _ (PatBr pat)
    = do	{ any_ty <- newFlexiTyVarTy liftedTypeKind
! 	; _ <- tcPat ThPatQuote pat any_ty unitTy $ \_ ->
                 return ()
  	; tcMetaTy patQTyConName }
  	-- Result type is PatQ (= Q Pat)
--- 395,401 ----
  
  tc_bracket _ (PatBr pat)
    = do	{ any_ty <- newFlexiTyVarTy liftedTypeKind
! 	; _ <- tcPat ThPatQuote pat any_ty unitTy $ 
                 return ()
  	; tcMetaTy patQTyConName }
  	-- Result type is PatQ (= Q Pat)
***************
*** 433,442 ****
  	-- Here (h 4) :: Q Exp
  	-- but $(h 4) :: forall a.a 	i.e. anything!
  
!      { _ <- unBox res_ty
!      ; meta_exp_ty <- tcMetaTy expQTyConName
       ; expr' <- setStage pop_stage $
!                 setLIEVar lie_var    $
                  tcMonoExpr expr meta_exp_ty
  
  	-- Write the pending splice into the bucket
--- 433,441 ----
  	-- Here (h 4) :: Q Exp
  	-- but $(h 4) :: forall a.a 	i.e. anything!
  
!      { meta_exp_ty <- tcMetaTy expQTyConName
       ; expr' <- setStage pop_stage $
!                 setConstraintVar lie_var    $
                  tcMonoExpr expr meta_exp_ty
  
  	-- Write the pending splice into the bucket
***************
*** 446,452 ****
       ; return (panic "tcSpliceExpr")	-- The returned expression is ignored
       }}}
  
! tcTopSplice :: LHsExpr Name -> BoxyRhoType -> TcM (HsExpr Id)
  -- Note [How top-level splices are handled]
  tcTopSplice expr res_ty
    = do { meta_exp_ty <- tcMetaTy expQTyConName
--- 445,451 ----
       ; return (panic "tcSpliceExpr")	-- The returned expression is ignored
       }}}
  
! tcTopSplice :: LHsExpr Name -> TcRhoType -> TcM (HsExpr Id)
  -- Note [How top-level splices are handled]
  tcTopSplice expr res_ty
    = do { meta_exp_ty <- tcMetaTy expQTyConName
***************
*** 488,500 ****
                     -- if the type checker fails!
      setStage Splice $ 
      do {    -- Typecheck the expression
!          (expr', lie) <- getLIE tc_action
          
  	-- Solve the constraints
! 	; const_binds <- tcSimplifyTop lie
  	
            -- Zonk it and tie the knot of dictionary bindings
!        ; zonkTopLExpr (mkHsDictLet const_binds expr') }
  \end{code}
  
  
--- 487,499 ----
                     -- if the type checker fails!
      setStage Splice $ 
      do {    -- Typecheck the expression
!          (expr', lie) <- getConstraints tc_action
          
  	-- Solve the constraints
! 	; const_binds <- simplifyTop lie
  	
            -- Zonk it and tie the knot of dictionary bindings
!        ; zonkTopLExpr (mkHsDictLet (EvBinds const_binds) expr') }
  \end{code}
  
  
***************
*** 519,525 ****
  	   -- A splice inside brackets
      { meta_ty <- tcMetaTy typeQTyConName
      ; expr' <- setStage pop_level $
!     	       setLIEVar lie_var $
      	       tcMonoExpr hs_expr meta_ty
  
      	-- Write the pending splice into the bucket
--- 518,524 ----
  	   -- A splice inside brackets
      { meta_ty <- tcMetaTy typeQTyConName
      ; expr' <- setStage pop_level $
!     	       setConstraintVar lie_var $
      	       tcMonoExpr hs_expr meta_ty
  
      	-- Write the pending splice into the bucket
***************
*** 1049,1057 ****
                                (reifyName (dataConOrigTyCon dc)) fix) 
          }
  
! reifyThing (ATcId {tct_id = id, tct_type = ty}) 
!   = do	{ ty1 <- zonkTcType ty	-- Make use of all the info we have, even
! 				-- though it may be incomplete
  	; ty2 <- reifyType ty1
  	; fix <- reifyFixity (idName id)
  	; return (TH.VarI (reifyName id) ty2 Nothing fix) }
--- 1048,1056 ----
                                (reifyName (dataConOrigTyCon dc)) fix) 
          }
  
! reifyThing (ATcId {tct_id = id}) 
!   = do	{ ty1 <- zonkTcType (idType id)	-- Make use of all the info we have, even
!     					-- though it may be incomplete
  	; ty2 <- reifyType ty1
  	; fix <- reifyFixity (idName id)
  	; return (TH.VarI (reifyName id) ty2 Nothing fix) }
***************
*** 1070,1076 ****
    = return (TH.PrimTyConI (reifyName tc) 2 		  False)
    | isPrimTyCon tc 
    = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
!   | isOpenTyCon tc
    = let flavour = reifyFamFlavour tc
          tvs     = tyConTyVars tc
          kind    = tyConKind tc
--- 1069,1075 ----
    = return (TH.PrimTyConI (reifyName tc) 2 		  False)
    | isPrimTyCon tc 
    = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
!   | isFamilyTyCon tc
    = let flavour = reifyFamFlavour tc
          tvs     = tyConTyVars tc
          kind    = tyConKind tc
***************
*** 1199,1206 ****
  reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)
  
  reifyFamFlavour :: TyCon -> TH.FamFlavour
! reifyFamFlavour tc | isOpenSynTyCon tc = TH.TypeFam
!                    | isOpenTyCon    tc = TH.DataFam
                     | otherwise         
                     = panic "TcSplice.reifyFamFlavour: not a type family"
  
--- 1198,1205 ----
  reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)
  
  reifyFamFlavour :: TyCon -> TH.FamFlavour
! reifyFamFlavour tc | isSynFamilyTyCon tc = TH.TypeFam
!                    | isFamilyTyCon    tc = TH.DataFam
                     | otherwise         
                     = panic "TcSplice.reifyFamFlavour: not a type family"