[project @ 2002-02-06 20:52:51 by sof]

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

diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index 44ba746..162ae24 100644 (file)
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -47,7 +47,7 @@ import DataCon                ( isExistentialDataCon )
 import Literal         ( Literal(..) )
 import TyCon           ( tyConDataCons )
 import TysWiredIn      ( tupleCon, listTyCon, charDataCon, intDataCon )
-import BasicTypes      ( RecFlag(..), Boxity(..) )
+import BasicTypes      ( RecFlag(..), Boxity(..), ipNameName )
 import Maybes          ( maybeToBool )
 import PrelNames       ( hasKey, ratioTyConKey )
 import Util            ( zipEqual, zipWithEqual )
@@ -88,7 +88,7 @@ dsLet (ThenBinds b1 b2) body
 -- We need to do a case right away, rather than building
 -- a tuple and doing selections.
 -- Silently ignore INLINE pragmas...
-dsLet (MonoBind (AbsBinds [] [] exports inlines binds) sigs is_rec) body
+dsLet bind@(MonoBind (AbsBinds [] [] exports inlines binds) sigs is_rec) body
   | or [isUnLiftedType (idType g) | (_, g, l) <- exports]
   = ASSERT (case is_rec of {NonRecursive -> True; other -> False})
        -- Unlifted bindings are always non-recursive
@@ -109,6 +109,8 @@ dsLet (MonoBind (AbsBinds [] [] exports inlines binds) sigs is_rec) body
           dsGuarded grhss                      `thenDs` \ rhs ->
           mk_error_app pat                     `thenDs` \ error_expr ->
           matchSimply rhs PatBindRhs pat body_w_exports error_expr
+
+      other -> pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
   where
     body_w_exports              = foldr bind_export body exports
     bind_export (tvs, g, l) body = ASSERT( null tvs )
@@ -143,9 +145,9 @@ dsLet (MonoBind binds sigs is_rec) body
 \begin{code}
 dsExpr :: TypecheckedHsExpr -> DsM CoreExpr
 
-dsExpr (HsVar var)      = returnDs (Var var)
-dsExpr (HsIPVar var)     = returnDs (Var var)
-dsExpr (HsLit lit)       = dsLit lit
+dsExpr (HsVar var)  = returnDs (Var var)
+dsExpr (HsIPVar ip) = returnDs (Var (ipNameName ip))
+dsExpr (HsLit lit)  = dsLit lit
 -- HsOverLit has been gotten rid of by the type checker
 
 dsExpr expr@(HsLam a_Match)
@@ -239,7 +241,7 @@ dsExpr (HsCase discrim matches src_loc)
                returnDs (Case core_discrim bndr alts)
        _ -> panic ("dsExpr: tuple pattern:\n" ++ showSDoc (ppr matching_code))
   where
-    ubx_tuple_match (Match _ [TuplePat ps Unboxed] _ _) = True
+    ubx_tuple_match (Match [TuplePat ps Unboxed] _ _) = True
     ubx_tuple_match _ = False
 
 dsExpr (HsCase discrim matches src_loc)
@@ -258,7 +260,7 @@ dsExpr (HsWith expr binds)
     where
       dsIPBind body (n, e)
         = dsExpr e     `thenDs` \ e' ->
-         returnDs (Let (NonRec n e') body)
+         returnDs (Let (NonRec (ipNameName n) e') body)
 
 dsExpr (HsDoOut do_or_lc stmts return_id then_id fail_id result_ty src_loc)
   | maybeToBool maybe_list_comp