X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FMatchLit.lhs;h=d3f04f46af5f72d9cc7ae88a334cda9657b6cbf5;hb=fc63e16fda616d34ffc93a19d1f47271d416e65a;hp=287d730f7d5283178f1e50f850600aa87f3a6d38;hpb=9af77fa423926fbda946b31e174173d0ec5ebac8;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs
index 287d730..d3f04f4 100644
--- a/ghc/compiler/deSugar/MatchLit.lhs
+++ b/ghc/compiler/deSugar/MatchLit.lhs
@@ -12,24 +12,21 @@ import {-# SOURCE #-} Match  ( match )
 import {-# SOURCE #-} DsExpr ( dsExpr )
 
 import DsMonad
-import DsCCall		( resultWrapper )
 import DsUtils
 
-import HsSyn		( HsLit(..), Pat(..), HsExpr(..) )
-import TcHsSyn		( TypecheckedPat )
+import HsSyn
 import Id		( Id )
 import CoreSyn
 import TyCon		( tyConDataCons )
-import TcType		( tcSplitTyConApp, isIntegerTy  )
-
+import TcType		( tcSplitTyConApp, isIntegerTy )
 import PrelNames	( ratioTyConKey )
 import Unique		( hasKey )
 import Literal		( mkMachInt, Literal(..) )
 import Maybes		( catMaybes )
-import Type		( isUnLiftedType )
+import SrcLoc		( noLoc, Located(..), unLoc )
 import Panic		( panic, assertPanic )
-import Maybe		( isJust )
 import Ratio 		( numerator, denominator )
+import Outputable
 \end{code}
 
 %************************************************************************
@@ -59,17 +56,11 @@ dsLit (HsChar c)       = returnDs (mkCharExpr c)
 dsLit (HsCharPrim c)   = returnDs (mkLit (MachChar c))
 dsLit (HsString str)   = mkStringLitFS str
 dsLit (HsStringPrim s) = returnDs (mkLit (MachStr s))
-dsLit (HsInteger i)    = mkIntegerExpr i
+dsLit (HsInteger i _)  = mkIntegerExpr i
 dsLit (HsInt i)	       = returnDs (mkIntExpr i)
 dsLit (HsIntPrim i)    = returnDs (mkIntLit i)
 dsLit (HsFloatPrim f)  = returnDs (mkLit (MachFloat f))
 dsLit (HsDoublePrim d) = returnDs (mkLit (MachDouble d))
-dsLit (HsLitLit str ty)
-  = ASSERT( isJust maybe_ty )
-    returnDs (wrap_fn (mkLit (MachLitLit str rep_ty)))
-  where
-    (maybe_ty, wrap_fn) = resultWrapper ty
-    Just rep_ty 	= maybe_ty
 
 dsLit (HsRat r ty)
   = mkIntegerExpr (numerator r)		`thenDs` \ num ->
@@ -134,8 +125,6 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (LitPat literal : ps1
 	mk_core_lit (HsStringPrim  s) 	 = MachStr    s
 	mk_core_lit (HsFloatPrim   f) 	 = MachFloat  f
 	mk_core_lit (HsDoublePrim  d)    = MachDouble d
-	mk_core_lit (HsLitLit      s ty) = ASSERT(isUnLiftedType ty)
-		    		           MachLitLit s ty
     	mk_core_lit other	         = panic "matchLiterals:mk_core_lit:unhandled"
 \end{code}
 
@@ -146,7 +135,7 @@ matchLiterals all_vars@(var:vars)
 	(shifted_eqns_for_this_lit, eqns_not_for_this_lit)
 	  = partitionEqnsByLit pat eqns_info
     in
-    dsExpr (HsApp eq_chk (HsVar var))		`thenDs` \ pred_expr ->
+    dsExpr (HsApp (noLoc eq_chk) (nlHsVar var))	`thenDs` \ pred_expr ->
     match vars shifted_eqns_for_this_lit        `thenDs` \ inner_match_result ->
     let
 	match_result1 = mkGuardedMatchResult pred_expr inner_match_result
@@ -178,12 +167,12 @@ matchLiterals all_vars@(var:vars) eqns_info@(EqnInfo n ctx (pat@(NPlusKPatOut ma
     in
     match vars shifted_eqns_for_this_lit	`thenDs` \ inner_match_result ->
 
-    dsExpr (HsApp ge (HsVar var))		`thenDs` \ ge_expr ->
-    dsExpr (HsApp sub (HsVar var))		`thenDs` \ nminusk_expr ->
+    dsExpr (HsApp (noLoc ge) (nlHsVar var))	`thenDs` \ ge_expr ->
+    dsExpr (HsApp (noLoc sub) (nlHsVar var))	`thenDs` \ nminusk_expr ->
 
     let
 	match_result1 = mkGuardedMatchResult ge_expr $
-			mkCoLetsMatchResult [NonRec master_n nminusk_expr] $
+			mkCoLetsMatchResult [NonRec (unLoc master_n) nminusk_expr] $
 			inner_match_result
     in
     if (null eqns_not_for_this_lit)
@@ -199,7 +188,7 @@ that are ``same''/different as one we are looking at.  We need to know
 whether we're looking at a @LitPat@/@NPat@, and what literal we're after.
 
 \begin{code}
-partitionEqnsByLit :: TypecheckedPat
+partitionEqnsByLit :: Pat Id
 		   -> [EquationInfo]
 		   -> ([EquationInfo], 	-- These ones are for this lit, AND
 					-- they've been "shifted" by stripping
@@ -212,7 +201,7 @@ partitionEqnsByLit master_pat eqns
   = ( \ (xs,ys) -> (catMaybes xs, catMaybes ys))
 	(unzip (map (partition_eqn master_pat) eqns))
   where
-    partition_eqn :: TypecheckedPat -> EquationInfo -> (Maybe EquationInfo, Maybe EquationInfo)
+    partition_eqn :: Pat Id -> EquationInfo -> (Maybe EquationInfo, Maybe EquationInfo)
 
     partition_eqn (LitPat k1) (EqnInfo n ctx (LitPat k2 : remaining_pats) match_result)
       | k1 == k2 = (Just (EqnInfo n ctx remaining_pats match_result), Nothing)
@@ -222,8 +211,8 @@ partitionEqnsByLit master_pat eqns
       | k1 == k2 = (Just (EqnInfo n ctx remaining_pats match_result), Nothing)
 			  -- NB the pattern is stripped off the EquationInfo
 
-    partition_eqn (NPlusKPatOut master_n k1 _ _)
- 	          (EqnInfo n ctx (NPlusKPatOut n' k2 _ _ : remaining_pats) match_result)
+    partition_eqn (NPlusKPatOut (L _ master_n) k1 _ _)
+ 	          (EqnInfo n ctx (NPlusKPatOut (L _ n') k2 _ _ : remaining_pats) match_result)
       | k1 == k2 = (Just (EqnInfo n ctx remaining_pats new_match_result), Nothing)
 			  -- NB the pattern is stripped off the EquationInfo
       where