projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
[project @ 1999-04-09 01:55:15 by kglynn]
[ghc-hetmet.git]
/
ghc
/
compiler
/
simplCore
/
SimplCore.lhs
diff --git
a/ghc/compiler/simplCore/SimplCore.lhs
b/ghc/compiler/simplCore/SimplCore.lhs
index
97e38a3
..
dfd9ac5
100644
(file)
--- a/
ghc/compiler/simplCore/SimplCore.lhs
+++ b/
ghc/compiler/simplCore/SimplCore.lhs
@@
-39,23
+39,20
@@
import IdInfo ( InlinePragInfo(..), specInfo, setSpecInfo,
)
import VarEnv
import VarSet
)
import VarEnv
import VarSet
+import Module ( Module )
import Name ( mkLocalName, tidyOccName, tidyTopName, initTidyOccEnv, isExported,
import Name ( mkLocalName, tidyOccName, tidyTopName, initTidyOccEnv, isExported,
- Module, NamedThing(..), OccName
+ NamedThing(..), OccName
)
import TyCon ( TyCon, isDataTyCon )
import PrimOp ( PrimOp(..) )
)
import TyCon ( TyCon, isDataTyCon )
import PrimOp ( PrimOp(..) )
-import PrelInfo ( unpackCStringId, unpackCString2Id,
- integerZeroId, integerPlusOneId,
- integerPlusTwoId, integerMinusOneId,
- int2IntegerId, addr2IntegerId
- )
+import PrelInfo ( unpackCStringId, unpackCString2Id, addr2IntegerId )
import Type ( Type, splitAlgTyConApp_maybe,
isUnLiftedType,
tidyType, tidyTypes, tidyTopType, tidyTyVar, tidyTyVars,
Type
)
import Class ( Class, classSelIds )
import Type ( Type, splitAlgTyConApp_maybe,
isUnLiftedType,
tidyType, tidyTypes, tidyTopType, tidyTyVar, tidyTyVars,
Type
)
import Class ( Class, classSelIds )
-import TysWiredIn ( isIntegerTy )
+import TysWiredIn ( smallIntegerDataCon, isIntegerTy )
import LiberateCase ( liberateCase )
import SAT ( doStaticArgs )
import Specialise ( specProgram)
import LiberateCase ( liberateCase )
import SAT ( doStaticArgs )
import Specialise ( specProgram)
@@
-117,6
+114,9
@@
doCorePass us binds CoreDoFullLaziness = _scc_ "CoreFloating" floatOutwa
doCorePass us binds CoreDoStaticArgs = _scc_ "CoreStaticArgs" doStaticArgs us binds
doCorePass us binds CoreDoStrictness = _scc_ "CoreStranal" saWwTopBinds us binds
doCorePass us binds CoreDoSpecialising = _scc_ "Specialise" specProgram us binds
doCorePass us binds CoreDoStaticArgs = _scc_ "CoreStaticArgs" doStaticArgs us binds
doCorePass us binds CoreDoStrictness = _scc_ "CoreStranal" saWwTopBinds us binds
doCorePass us binds CoreDoSpecialising = _scc_ "Specialise" specProgram us binds
+doCorePass us binds CoreDoPrintCore = _scc_ "PrintCore" do
+ putStr (showSDoc $ pprCoreBindings binds)
+ return binds
\end{code}
\end{code}
@@
-634,20
+634,15
@@
litToRep (NoRepStr s ty)
If an Integer is small enough (Haskell implementations must support
Ints in the range $[-2^29+1, 2^29-1]$), wrap it up in @int2Integer@;
If an Integer is small enough (Haskell implementations must support
Ints in the range $[-2^29+1, 2^29-1]$), wrap it up in @int2Integer@;
-otherwise, wrap with @litString2Integer@.
+otherwise, wrap with @addr2Integer@.
\begin{code}
litToRep (NoRepInteger i integer_ty)
= returnPM (integer_ty, rhs)
where
\begin{code}
litToRep (NoRepInteger i integer_ty)
= returnPM (integer_ty, rhs)
where
- rhs | i == 0 = Var integerZeroId -- Extremely convenient to look out for
- | i == 1 = Var integerPlusOneId -- a few very common Integer literals!
- | i == 2 = Var integerPlusTwoId
- | i == (-1) = Var integerMinusOneId
-
- | i > tARGET_MIN_INT && -- Small enough, so start from an Int
+ rhs | i > tARGET_MIN_INT && -- Small enough, so start from an Int
i < tARGET_MAX_INT
i < tARGET_MAX_INT
- = App (Var int2IntegerId) (Con (Literal (mkMachInt i)) [])
+ = Con (DataCon smallIntegerDataCon) [Con (Literal (mkMachInt i)) []]
| otherwise -- Big, so start from a string
= App (Var addr2IntegerId) (Con (Literal (MachStr (_PK_ (show i)))) [])
| otherwise -- Big, so start from a string
= App (Var addr2IntegerId) (Con (Literal (MachStr (_PK_ (show i)))) [])