X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FMatchLit.lhs;fp=ghc%2Fcompiler%2FdeSugar%2FMatchLit.lhs;h=65b1eea4bca9d23bbc9680cf52d02ef315a7d040;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=f9e39bb27f2dd0e26dbbf3f61f250fc121f4108f;hpb=967cc47f37cb93a5e2b6df7822c9a646f0428247;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs
index f9e39bb..65b1eea 100644
--- a/ghc/compiler/deSugar/MatchLit.lhs
+++ b/ghc/compiler/deSugar/MatchLit.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[MatchLit]{Pattern-matching literal patterns}
 
@@ -11,19 +11,18 @@ module MatchLit ( matchLiterals ) where
 import {-# SOURCE #-} Match  ( match )
 import {-# SOURCE #-} DsExpr ( dsExpr )
 
-import HsSyn		( HsLit(..), OutPat(..), HsExpr(..), Fixity,
-			  Match, HsBinds, DoOrListComp, HsType, ArithSeqInfo )
+import HsSyn		( HsLit(..), OutPat(..), HsExpr(..) )
 import TcHsSyn		( TypecheckedHsExpr, TypecheckedPat )
-import CoreSyn		( CoreExpr, CoreBinding, GenCoreExpr(..), GenCoreBinding(..) )
+import CoreSyn		( Expr(..), Bind(..) )
 import Id		( Id )
 
 import DsMonad
 import DsUtils
 
-import Literal		( mkMachInt_safe, Literal(..) )
+import Const		( mkMachInt, Literal(..) )
 import PrimRep          ( PrimRep(IntRep) )
 import Maybes		( catMaybes )
-import Type		( Type, isUnpointedType )
+import Type		( Type, isUnLiftedType )
 import Util		( panic, assertPanic )
 \end{code}
 
@@ -46,7 +45,7 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (LitPat literal lit_t
     match_prims_used vars eqns_info `thenDs` \ prim_alts ->
 
     -- MAKE THE PRIMITIVE CASE
-    mkCoPrimCaseMatchResult var prim_alts
+    returnDs (mkCoPrimCaseMatchResult var prim_alts)
   where
     match_prims_used _ [{-no more eqns-}] = returnDs []
 
@@ -68,12 +67,12 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (LitPat literal lit_t
       where
 	mk_core_lit :: Type -> HsLit -> Literal
 
-	mk_core_lit ty (HsIntPrim     i) = mkMachInt_safe i
+	mk_core_lit ty (HsIntPrim     i) = mkMachInt  i
 	mk_core_lit ty (HsCharPrim    c) = MachChar   c
 	mk_core_lit ty (HsStringPrim  s) = MachStr    s
 	mk_core_lit ty (HsFloatPrim   f) = MachFloat  f
 	mk_core_lit ty (HsDoublePrim  d) = MachDouble d
-	mk_core_lit ty (HsLitLit      s) = ASSERT(isUnpointedType ty)
+	mk_core_lit ty (HsLitLit      s) = ASSERT(isUnLiftedType ty)
 					   MachLitLit s (panic "MatchLit.matchLiterals:mk_core_lit:HsLitLit; typePrimRep???")
     	mk_core_lit ty other	         = panic "matchLiterals:mk_core_lit:unhandled"
 \end{code}
@@ -86,14 +85,15 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx ((NPat literal lit_ty
     in
     dsExpr (HsApp eq_chk (HsVar var))			  `thenDs` \ pred_expr ->
     match vars shifted_eqns_for_this_lit                  `thenDs` \ inner_match_result ->
-    mkGuardedMatchResult pred_expr inner_match_result	  `thenDs` \ match_result1 ->
-
+    let
+	match_result1 = mkGuardedMatchResult pred_expr inner_match_result
+    in
     if (null eqns_not_for_this_lit)
     then
 	returnDs match_result1
     else
         matchLiterals all_vars eqns_not_for_this_lit  	  `thenDs` \ match_result2 ->
-	combineMatchResults match_result1 match_result2
+	returnDs (combineMatchResults match_result1 match_result2)
 \end{code}
 
 For an n+k pattern, we use the various magic expressions we've been given.
@@ -118,17 +118,17 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx ((NPlusKPat master_n
     dsExpr (HsApp ge (HsVar var))		`thenDs` \ ge_expr ->
     dsExpr (HsApp sub (HsVar var))		`thenDs` \ nminusk_expr ->
 
-    mkGuardedMatchResult
-	ge_expr
-	(mkCoLetsMatchResult [NonRec master_n nminusk_expr] inner_match_result)
-					`thenDs` \ match_result1 ->
-
+    let
+	match_result1 = mkGuardedMatchResult ge_expr $
+			mkCoLetsMatchResult [NonRec master_n nminusk_expr] $
+			inner_match_result
+    in
     if (null eqns_not_for_this_lit)
     then 
 	returnDs match_result1
     else 
 	matchLiterals all_vars eqns_not_for_this_lit 	`thenDs` \ match_result2 ->
-	combineMatchResults match_result1 match_result2
+	returnDs (combineMatchResults match_result1 match_result2)
 \end{code}
 
 Given a blob of LitPats/NPats, we want to split them into those