[project @ 1997-03-14 07:52:06 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsUtils.lhs

diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
index 66472b7..3fdc1d3 100644 (file)
--- 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