X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsUtils.lhs;h=3fdc1d3c9a7d307fd07529738dc21fdac990c0db;hb=1fb1ab5d53a09607e7f6d2450806760688396387;hp=66472b77a14c1e873a01dd7d4bd07090ea4ee35a;hpb=f7ecf7234c224489be8a5e63fced903b655d92ee;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index 66472b7..3fdc1d3 100644
--- a/ghc/compiler/deSugar/DsUtils.lhs
+++ b/ghc/compiler/deSugar/DsUtils.lhs
@@ -30,8 +30,8 @@ module DsUtils (
 IMP_Ubiq()
 IMPORT_DELOOPER(DsLoop)		( match, matchSimply )
 
-import HsSyn		( HsExpr(..), OutPat(..), HsLit(..),
-			  Match, HsBinds, Stmt, Qualifier, PolyType, ArithSeqInfo )
+import HsSyn		( HsExpr(..), OutPat(..), HsLit(..), Fixity,
+			  Match, HsBinds, Stmt, DoOrListComp, HsType, ArithSeqInfo )
 import TcHsSyn		( SYN_IE(TypecheckedPat) )
 import DsHsSyn		( outPatType )
 import CoreSyn
@@ -41,24 +41,25 @@ import DsMonad
 import CoreUtils	( coreExprType, mkCoreIfThenElse )
 import PprStyle		( PprStyle(..) )
 import PrelVals		( iRREFUT_PAT_ERROR_ID, voidId )
-import Pretty		( ppShow )
-import Id		( idType, dataConArgTys, mkTupleCon,
+import Pretty		( ppShow, ppBesides, ppStr )
+import Id		( idType, dataConArgTys, 
 --			  pprId{-ToDo:rm-},
 			  SYN_IE(DataCon), SYN_IE(DictVar), SYN_IE(Id), GenId )
 import Literal		( Literal(..) )
-import TyCon		( mkTupleTyCon, isNewTyCon, tyConDataCons )
+import PprType		( GenType, GenTyVar )
+import TyCon		( isNewTyCon, tyConDataCons )
 import Type		( mkTyVarTys, mkRhoTy, mkForAllTys, mkFunTy,
-			  mkTheta, isUnboxedType, applyTyCon, getAppTyCon
+			  mkTheta, isUnboxedType, applyTyCon, getAppTyCon,
+			  GenType {- instances -}
 			)
+import TyVar		( GenTyVar {- instances -} )
 import TysPrim		( voidTy )
+import TysWiredIn	( tupleTyCon, unitDataCon, tupleCon )
 import UniqSet		( mkUniqSet, minusUniqSet, uniqSetToList, SYN_IE(UniqSet) )
 import Util		( panic, assertPanic{-, pprTrace ToDo:rm-} )
+import Unique		( Unique )
 import Usage		( SYN_IE(UVar) )
---import PprCore{-ToDo:rm-}
---import PprType--ToDo:rm
---import Pretty--ToDo:rm
---import TyVar--ToDo:rm
---import Unique--ToDo:rm
+import SrcLoc		( SrcLoc {- instance Outputable -} )
 \end{code}
 
 %************************************************************************
@@ -312,9 +313,9 @@ mkErrorAppDs :: Id 		-- The error function
 	     -> DsM CoreExpr
 
 mkErrorAppDs err_id ty msg
-  = getSrcLocDs			`thenDs` \ (file, line) ->
+  = getSrcLocDs			`thenDs` \ src_loc ->
     let
-	full_msg = file ++ "|" ++ line ++ "|" ++msg
+	full_msg = ppShow 80 (ppBesides [ppr PprForUser src_loc, ppStr "|", ppStr msg])
 	msg_lit  = NoRepStr (_PK_ full_msg)
     in
     returnDs (mkApp (Var err_id) [] [ty] [LitArg msg_lit])
@@ -354,7 +355,7 @@ mkSelectorBinds tyvars pat locals_and_globals val_expr
   = if is_simple_tuple_pat pat then
 	mkTupleBind tyvars [] locals_and_globals val_expr
     else
-	mkErrorAppDs iRREFUT_PAT_ERROR_ID res_ty ""	`thenDs` \ error_msg ->
+	mkErrorAppDs iRREFUT_PAT_ERROR_ID res_ty pat_string	`thenDs` \ error_msg ->
 	matchSimply val_expr pat res_ty local_tuple error_msg `thenDs` \ tuple_expr ->
 	mkTupleBind tyvars [] locals_and_globals tuple_expr
   where
@@ -367,6 +368,8 @@ mkSelectorBinds tyvars pat locals_and_globals val_expr
 
     is_var_pat (VarPat v) = True
     is_var_pat other      = False -- Even wild-card patterns aren't acceptable
+
+    pat_string = ppShow 80 (ppr PprForUser pat)
 \end{code}
 
 We're about to match against some patterns.  We want to make some
@@ -449,7 +452,7 @@ mkTupleBind tyvars dicts local_global_prs tuple_expr
     tuple_var_ty
       = mkForAllTys tyvars $
 	mkRhoTy theta	   $
-	applyTyCon (mkTupleTyCon no_of_binders)
+	applyTyCon (tupleTyCon no_of_binders)
 		   (map idType locals)
       where
 	theta = mkTheta (map idType dicts)
@@ -477,9 +480,9 @@ has only one element, it is the identity function.
 \begin{code}
 mkTupleExpr :: [Id] -> CoreExpr
 
-mkTupleExpr []	 = Con (mkTupleCon 0) []
+mkTupleExpr []	 = Con unitDataCon []
 mkTupleExpr [id] = Var id
-mkTupleExpr ids	 = mkCon (mkTupleCon (length ids))
+mkTupleExpr ids	 = mkCon (tupleCon (length ids))
 			 [{-usages-}]
 			 (map idType ids)
 			 [ VarArg i | i <- ids ]
@@ -508,7 +511,7 @@ mkTupleSelector expr [var] should_be_the_same_var
     expr
 
 mkTupleSelector expr vars the_var
- = Case expr (AlgAlts [(mkTupleCon arity, vars, Var the_var)]
+ = Case expr (AlgAlts [(tupleCon arity, vars, Var the_var)]
 			  NoDefault)
  where
    arity = length vars