projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 2003-12-10 14:15:16 by simonmar]
[ghc-hetmet.git]
/
ghc
/
compiler
/
deSugar
/
MatchLit.lhs
diff --git
a/ghc/compiler/deSugar/MatchLit.lhs
b/ghc/compiler/deSugar/MatchLit.lhs
index
01d1ed8
..
d3f04f4
100644
(file)
--- 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 {-# SOURCE #-} DsExpr ( dsExpr )
import DsMonad
-import DsCCall ( resultWrapper )
import DsUtils
import DsUtils
-import HsSyn ( HsLit(..), Pat(..), HsExpr(..) )
-import TcHsSyn ( TypecheckedPat )
+import HsSyn
import Id ( Id )
import CoreSyn
import TyCon ( tyConDataCons )
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 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 Panic ( panic, assertPanic )
-import Maybe ( isJust )
import Ratio ( numerator, denominator )
import Ratio ( numerator, denominator )
+import Outputable
\end{code}
%************************************************************************
\end{code}
%************************************************************************
@@
-59,16
+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 (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 (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)
- = resultWrapper ty `thenDs` \ (maybe_ty, wrap_fn) ->
- ASSERT( isJust maybe_ty )
- let (Just rep_ty) = maybe_ty in
- returnDs (wrap_fn (mkLit (MachLitLit str rep_ty)))
dsLit (HsRat r ty)
= mkIntegerExpr (numerator r) `thenDs` \ num ->
dsLit (HsRat r ty)
= mkIntegerExpr (numerator r) `thenDs` \ num ->
@@
-133,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 (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}
mk_core_lit other = panic "matchLiterals:mk_core_lit:unhandled"
\end{code}
@@
-145,7
+135,7
@@
matchLiterals all_vars@(var:vars)
(shifted_eqns_for_this_lit, eqns_not_for_this_lit)
= partitionEqnsByLit pat eqns_info
in
(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
match vars shifted_eqns_for_this_lit `thenDs` \ inner_match_result ->
let
match_result1 = mkGuardedMatchResult pred_expr inner_match_result
@@
-177,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 ->
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 $
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)
inner_match_result
in
if (null eqns_not_for_this_lit)
@@
-198,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}
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
-> [EquationInfo]
-> ([EquationInfo], -- These ones are for this lit, AND
-- they've been "shifted" by stripping
@@
-211,7
+201,7
@@
partitionEqnsByLit master_pat eqns
= ( \ (xs,ys) -> (catMaybes xs, catMaybes ys))
(unzip (map (partition_eqn master_pat) eqns))
where
= ( \ (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)
partition_eqn (LitPat k1) (EqnInfo n ctx (LitPat k2 : remaining_pats) match_result)
| k1 == k2 = (Just (EqnInfo n ctx remaining_pats match_result), Nothing)
@@
-221,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
| 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
| k1 == k2 = (Just (EqnInfo n ctx remaining_pats new_match_result), Nothing)
-- NB the pattern is stripped off the EquationInfo
where