[project @ 2003-11-06 17:09:50 by simonpj]

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

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 2865f94..f447d9d 100644 (file)
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -13,7 +13,6 @@ import Match          ( matchWrapper, matchSimply )
 import MatchLit                ( dsLit )
 import DsBinds         ( dsMonoBinds, AutoScc(..) )
 import DsGRHSs         ( dsGuarded )
-import DsCCall         ( dsCCall )
 import DsListComp      ( dsListComp, dsPArrComp )
 import DsUtils         ( mkErrorAppDs, mkStringLit, mkConsExpr, mkNilExpr,
                          mkCoreTupTy, selectMatchVar,
@@ -23,7 +22,7 @@ import DsMonad
 
 #ifdef GHCI
        -- Template Haskell stuff iff bootstrapped
-import DsMeta          ( dsBracket, dsReify )
+import DsMeta          ( dsBracket )
 #endif
 
 import HsSyn           ( HsExpr(..), Pat(..), ArithSeqInfo(..),
@@ -54,7 +53,7 @@ import DataCon                ( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArg
 import DataCon         ( isExistentialDataCon )
 import Name            ( Name )
 import TyCon           ( tyConDataCons )
-import TysWiredIn      ( tupleCon, mkTupleTy )
+import TysWiredIn      ( tupleCon )
 import BasicTypes      ( RecFlag(..), Boxity(..), ipNameName )
 import PrelNames       ( toPName,
                          returnMName, bindMName, thenMName, failMName,
@@ -93,7 +92,7 @@ dsLet (ThenBinds b1 b2) body
   = dsLet b2 body      `thenDs` \ body' ->
     dsLet b1 body'
   
-dsLet (IPBinds binds is_with) body
+dsLet (IPBinds binds) body
   = foldlDs dsIPBind body binds
   where
     dsIPBind body (n, e)
@@ -236,11 +235,6 @@ dsExpr (SectionR op expr)
     returnDs (bindNonRec y_id y_core $
              Lam x_id (mkApps core_op [Var x_id, Var y_id]))
 
-dsExpr (HsCCall lbl args may_gc is_asm result_ty)
-  = mapDs dsExpr args          `thenDs` \ core_args ->
-    dsCCall lbl core_args may_gc is_asm result_ty
-       -- dsCCall does all the unboxification, etc.
-
 dsExpr (HsSCC cc expr)
   = dsExpr expr                        `thenDs` \ core_expr ->
     getModuleDs                        `thenDs` \ mod_name ->
@@ -351,7 +345,7 @@ dsExpr (ExplicitPArr ty xs)
     returnDs (mkApps (Var toP) [Type ty, coreList])
 
 dsExpr (ExplicitTuple expr_list boxity)
-  = mapDs dsExpr expr_list       `thenDs` \ core_exprs  ->
+  = mappM dsExpr expr_list       `thenDs` \ core_exprs  ->
     returnDs (mkConApp (tupleCon boxity (length expr_list))
                       (map (Type .  exprType) core_exprs ++ core_exprs))
 
@@ -439,8 +433,8 @@ dsExpr (RecordConOut data_con con_expr rbinds)
     in
 
     (if null labels
-       then mapDs unlabelled_bottom arg_tys
-       else mapDs mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels))
+       then mappM unlabelled_bottom arg_tys
+       else mappM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels))
        `thenDs` \ con_args ->
 
     returnDs (mkApps con_expr' con_args)
@@ -511,7 +505,7 @@ dsExpr expr@(RecordUpdOut record_expr record_in_ty record_out_ty rbinds)
        -- and the right hand sides with applications of the wrapper Id
        -- so that everything works when we are doing fancy unboxing on the
        -- constructor aguments.
-    mapDs mk_alt cons_to_upd           `thenDs` \ alts ->
+    mappM mk_alt cons_to_upd           `thenDs` \ alts ->
     matchWrapper RecUpd alts           `thenDs` \ ([discrim_var], matching_code) ->
 
     returnDs (bindNonRec discrim_var record_expr' matching_code)
@@ -561,7 +555,6 @@ Here is where we desugar the Template Haskell brackets and escapes
 
 #ifdef GHCI    /* Only if bootstrapping */
 dsExpr (HsBracketOut x ps) = dsBracket x ps
-dsExpr (HsReify r)        = dsReify r
 dsExpr (HsSplice n e _)    = pprPanic "dsExpr:splice" (ppr e)
 #endif