projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1998-12-02 13:17:09 by simonm]
[ghc-hetmet.git]
/
ghc
/
compiler
/
deSugar
/
MatchLit.lhs
diff --git
a/ghc/compiler/deSugar/MatchLit.lhs
b/ghc/compiler/deSugar/MatchLit.lhs
index
f9e39bb
..
65b1eea
100644
(file)
--- 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}
%
\section[MatchLit]{Pattern-matching literal patterns}
@@
-11,19
+11,18
@@
module MatchLit ( matchLiterals ) where
import {-# SOURCE #-} Match ( match )
import {-# SOURCE #-} DsExpr ( dsExpr )
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 TcHsSyn ( TypecheckedHsExpr, TypecheckedPat )
-import CoreSyn ( CoreExpr, CoreBinding, GenCoreExpr(..), GenCoreBinding(..) )
+import CoreSyn ( Expr(..), Bind(..) )
import Id ( Id )
import DsMonad
import DsUtils
import Id ( Id )
import DsMonad
import DsUtils
-import Literal ( mkMachInt_safe, Literal(..) )
+import Const ( mkMachInt, Literal(..) )
import PrimRep ( PrimRep(IntRep) )
import Maybes ( catMaybes )
import PrimRep ( PrimRep(IntRep) )
import Maybes ( catMaybes )
-import Type ( Type, isUnpointedType )
+import Type ( Type, isUnLiftedType )
import Util ( panic, assertPanic )
\end{code}
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
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 []
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
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 (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}
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 ->
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 ->
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.
\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 ->
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 ->
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
\end{code}
Given a blob of LitPats/NPats, we want to split them into those