Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c7a8941b04541789e60950bb126902effae0ccab >--------------------------------------------------------------- commit c7a8941b04541789e60950bb126902effae0ccab Author: Ian Lynagh <[email protected]> Date: Wed Jun 27 21:49:57 2012 +0100 Add some more Integer rules; fixes #6111 >--------------------------------------------------------------- compiler/basicTypes/Id.lhs | 2 +- compiler/basicTypes/IdInfo.lhs | 2 +- compiler/basicTypes/MkId.lhs-boot | 3 +++ compiler/prelude/PrelRules.lhs | 37 ++++++++++++++++++++++++++++++++++++- compiler/prelude/PrimOp.lhs-boot | 7 +++++++ 5 files changed, 48 insertions(+), 3 deletions(-) diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs index e6e221b..b3011aa 100644 --- a/compiler/basicTypes/Id.lhs +++ b/compiler/basicTypes/Id.lhs @@ -118,7 +118,7 @@ import Demand import Name import Module import Class -import PrimOp +import {-# SOURCE #-} PrimOp (PrimOp) import ForeignCall import Maybes import SrcLoc diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs index 3f5eaa4..8a52ce1 100644 --- a/compiler/basicTypes/IdInfo.lhs +++ b/compiler/basicTypes/IdInfo.lhs @@ -75,7 +75,7 @@ module IdInfo ( import CoreSyn import Class -import PrimOp +import {-# SOURCE #-} PrimOp (PrimOp) import Name import VarSet import BasicTypes diff --git a/compiler/basicTypes/MkId.lhs-boot b/compiler/basicTypes/MkId.lhs-boot index 4f9615a..7891e65 100644 --- a/compiler/basicTypes/MkId.lhs-boot +++ b/compiler/basicTypes/MkId.lhs-boot @@ -2,8 +2,11 @@ module MkId where import Name( Name ) import DataCon( DataCon, DataConIds ) +import {-# SOURCE #-} PrimOp( PrimOp ) +import Id( Id ) mkDataConIds :: Name -> Name -> DataCon -> DataConIds +mkPrimOpId :: PrimOp -> Id \end{code} diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index 8bc070f..dab34fc 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -18,6 +18,8 @@ module PrelRules ( primOpRules, builtinRules ) where #include "HsVersions.h" +import {-# SOURCE #-} MkId ( mkPrimOpId ) + import CoreSyn import MkCore import Id @@ -659,7 +661,15 @@ builtinIntegerRules = rule_binop "xorInteger" xorIntegerName xor, rule_unop "complementInteger" complementIntegerName complement, rule_Int_binop "shiftLInteger" shiftLIntegerName shiftL, - rule_Int_binop "shiftRInteger" shiftRIntegerName shiftR] + rule_Int_binop "shiftRInteger" shiftRIntegerName shiftR, + -- These rules below don't actually have to be built in, but if we + -- put them in the Haskell source then we'd have to duplicate them + -- between all Integer implementations + rule_smallIntegerToInt "smallIntegerToInt" integerToIntName, + rule_smallIntegerTo "smallIntegerToWord" integerToWordName Int2WordOp, + rule_smallIntegerTo "smallIntegerToFloat" floatFromIntegerName Int2FloatOp, + rule_smallIntegerTo "smallIntegerToDouble" doubleFromIntegerName Int2DoubleOp + ] where rule_convert str name convert = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, ru_try = match_Integer_convert convert } @@ -702,6 +712,12 @@ builtinIntegerRules = rule_decodeDouble str name = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, ru_try = match_decodeDouble } + rule_smallIntegerToInt str name + = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, + ru_try = match_smallIntegerToInt } + rule_smallIntegerTo str name primOp + = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1, + ru_try = match_smallIntegerTo primOp } --------------------------------------------------- -- The rule is this: @@ -946,4 +962,23 @@ match_decodeDouble fn id_unf [xl] _ -> panic "match_decodeDouble: Id has the wrong type" match_decodeDouble _ _ _ = Nothing + +match_smallIntegerToInt :: Id + -> IdUnfoldingFun + -> [Expr CoreBndr] + -> Maybe (Expr CoreBndr) +match_smallIntegerToInt _ _ [App (Var x) y] + | idName x == smallIntegerName + = Just y +match_smallIntegerToInt _ _ _ = Nothing + +match_smallIntegerTo :: PrimOp + -> Id + -> IdUnfoldingFun + -> [Expr CoreBndr] + -> Maybe (Expr CoreBndr) +match_smallIntegerTo primOp _ _ [App (Var x) y] + | idName x == smallIntegerName + = Just $ App (Var (mkPrimOpId primOp)) y +match_smallIntegerTo _ _ _ _ = Nothing \end{code} diff --git a/compiler/prelude/PrimOp.lhs-boot b/compiler/prelude/PrimOp.lhs-boot new file mode 100644 index 0000000..5d003f2 --- /dev/null +++ b/compiler/prelude/PrimOp.lhs-boot @@ -0,0 +1,7 @@ + +\begin{code} +module PrimOp where + +data PrimOp +\end{code} + _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
