X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Fprelude%2FPrimOp.lhs;h=41793af100e76d83fa05be285579341da7a7be8a;hb=cfcebde74cf826af12143a92bcffa8c995eee135;hp=1e073e44d1bc235fa0f058535614cc7c0b3293fc;hpb=46de0542b6c4344ed71296db09066e0504dd00d9;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs index 1e073e4..41793af 100644 --- a/ghc/compiler/prelude/PrimOp.lhs +++ b/ghc/compiler/prelude/PrimOp.lhs @@ -6,14 +6,13 @@ \begin{code} module PrimOp ( PrimOp(..), allThePrimOps, - tagOf_PrimOp, -- ToDo: rm - primOpType, - primOpUniq, primOpOcc, + primOpType, primOpSig, primOpUsg, + mkPrimOpIdName, primOpRdrName, commutableOp, primOpOutOfLine, primOpNeedsWrapper, primOpStrictness, - primOpOkForSpeculation, primOpIsCheap, + primOpOkForSpeculation, primOpIsCheap, primOpIsDupable, primOpHasSideEffects, getPrimOpResultInfo, PrimOpResultInfo(..), @@ -28,19 +27,22 @@ import TysPrim import TysWiredIn import Demand ( Demand, wwLazy, wwPrim, wwStrict ) -import Var ( TyVar ) +import Var ( TyVar, Id ) import CallConv ( CallConv, pprCallConv ) import PprType ( pprParendType ) +import Name ( Name, mkWiredInIdName ) +import RdrName ( RdrName, mkRdrQual ) import OccName ( OccName, pprOccName, mkSrcVarOcc ) import TyCon ( TyCon, tyConArity ) -import Type ( mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys, +import Type ( Type, mkForAllTys, mkForAllTy, mkFunTy, mkFunTys, mkTyVarTys, mkTyConTy, mkTyConApp, typePrimRep, - splitAlgTyConApp, Type, isUnboxedTupleType, - splitAlgTyConApp_maybe + splitFunTy_maybe, splitAlgTyConApp_maybe, splitTyConApp_maybe, + UsageAnn(..), mkUsgTy ) import Unique ( Unique, mkPrimOpIdUnique ) +import PrelMods ( pREL_GHC, pREL_GHC_Name ) import Outputable -import Util ( assoc ) +import Util ( assoc, zipWithEqual ) import GlaExts ( Int(..), Int#, (==#) ) \end{code} @@ -73,6 +75,9 @@ data PrimOp | IntAddOp | IntSubOp | IntMulOp | IntQuotOp | IntRemOp | IntNegOp | IntAbsOp | ISllOp | ISraOp | ISrlOp -- shift {left,right} {arithmetic,logical} + | IntAddCOp + | IntSubCOp + | IntMulCOp -- Word#-related ops: | WordQuotOp | WordRemOp @@ -114,6 +119,7 @@ data PrimOp | IntegerQuotRemOp | IntegerDivModOp | IntegerNegOp | IntegerCmpOp + | IntegerCmpIntOp | Integer2IntOp | Integer2WordOp | Int2IntegerOp | Word2IntegerOp @@ -123,8 +129,8 @@ data PrimOp | IntegerToWord64Op | Word64ToIntegerOp -- ?? gcd, etc? - | FloatEncodeOp | FloatDecodeOp - | DoubleEncodeOp | DoubleDecodeOp + | FloatDecodeOp + | DoubleDecodeOp -- primitive ops for primitive arrays @@ -148,6 +154,7 @@ data PrimOp | IndexOffForeignObjOp PrimRep | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp + | UnsafeThawArrayOp | UnsafeThawByteArrayOp | SizeofByteArrayOp | SizeofMutableByteArrayOp -- Mutable variables @@ -167,17 +174,21 @@ data PrimOp | CatchOp | RaiseOp + -- foreign objects | MakeForeignObjOp | WriteForeignObjOp + -- weak pointers | MkWeakOp | DeRefWeakOp - | FinaliseWeakOp + | FinalizeWeakOp + -- stable names | MakeStableNameOp | EqStableNameOp | StableNameToIntOp + -- stable pointers | MakeStablePtrOp | DeRefStablePtrOp | EqStablePtrOp @@ -269,10 +280,13 @@ about using it this way?? ADR) -- concurrency | ForkOp | KillThreadOp + | YieldOp + | MyThreadIdOp | DelayOp | WaitReadOp | WaitWriteOp + -- more parallel stuff | ParGlobalOp -- named global par | ParLocalOp -- named local par | ParAtOp -- specifies destination of local par @@ -281,6 +295,10 @@ about using it this way?? ADR) | ParAtForNowOp -- specifies initial destination of global par | CopyableOp -- marks copyable code | NoFollowOp -- marks non-followup expression + + -- tag-related + | DataToTagOp + | TagToEnumOp \end{code} Used for the Ord instance @@ -342,195 +360,205 @@ tagOf_PrimOp SrlOp = ILIT( 53) tagOf_PrimOp ISllOp = ILIT( 54) tagOf_PrimOp ISraOp = ILIT( 55) tagOf_PrimOp ISrlOp = ILIT( 56) -tagOf_PrimOp Int2WordOp = ILIT( 57) -tagOf_PrimOp Word2IntOp = ILIT( 58) -tagOf_PrimOp Int2AddrOp = ILIT( 59) -tagOf_PrimOp Addr2IntOp = ILIT( 60) - -tagOf_PrimOp FloatAddOp = ILIT( 61) -tagOf_PrimOp FloatSubOp = ILIT( 62) -tagOf_PrimOp FloatMulOp = ILIT( 63) -tagOf_PrimOp FloatDivOp = ILIT( 64) -tagOf_PrimOp FloatNegOp = ILIT( 65) -tagOf_PrimOp Float2IntOp = ILIT( 66) -tagOf_PrimOp Int2FloatOp = ILIT( 67) -tagOf_PrimOp FloatExpOp = ILIT( 68) -tagOf_PrimOp FloatLogOp = ILIT( 69) -tagOf_PrimOp FloatSqrtOp = ILIT( 70) -tagOf_PrimOp FloatSinOp = ILIT( 71) -tagOf_PrimOp FloatCosOp = ILIT( 72) -tagOf_PrimOp FloatTanOp = ILIT( 73) -tagOf_PrimOp FloatAsinOp = ILIT( 74) -tagOf_PrimOp FloatAcosOp = ILIT( 75) -tagOf_PrimOp FloatAtanOp = ILIT( 76) -tagOf_PrimOp FloatSinhOp = ILIT( 77) -tagOf_PrimOp FloatCoshOp = ILIT( 78) -tagOf_PrimOp FloatTanhOp = ILIT( 79) -tagOf_PrimOp FloatPowerOp = ILIT( 80) - -tagOf_PrimOp DoubleAddOp = ILIT( 81) -tagOf_PrimOp DoubleSubOp = ILIT( 82) -tagOf_PrimOp DoubleMulOp = ILIT( 83) -tagOf_PrimOp DoubleDivOp = ILIT( 84) -tagOf_PrimOp DoubleNegOp = ILIT( 85) -tagOf_PrimOp Double2IntOp = ILIT( 86) -tagOf_PrimOp Int2DoubleOp = ILIT( 87) -tagOf_PrimOp Double2FloatOp = ILIT( 88) -tagOf_PrimOp Float2DoubleOp = ILIT( 89) -tagOf_PrimOp DoubleExpOp = ILIT( 90) -tagOf_PrimOp DoubleLogOp = ILIT( 91) -tagOf_PrimOp DoubleSqrtOp = ILIT( 92) -tagOf_PrimOp DoubleSinOp = ILIT( 93) -tagOf_PrimOp DoubleCosOp = ILIT( 94) -tagOf_PrimOp DoubleTanOp = ILIT( 95) -tagOf_PrimOp DoubleAsinOp = ILIT( 96) -tagOf_PrimOp DoubleAcosOp = ILIT( 97) -tagOf_PrimOp DoubleAtanOp = ILIT( 98) -tagOf_PrimOp DoubleSinhOp = ILIT( 99) -tagOf_PrimOp DoubleCoshOp = ILIT(100) -tagOf_PrimOp DoubleTanhOp = ILIT(101) -tagOf_PrimOp DoublePowerOp = ILIT(102) - -tagOf_PrimOp IntegerAddOp = ILIT(103) -tagOf_PrimOp IntegerSubOp = ILIT(104) -tagOf_PrimOp IntegerMulOp = ILIT(105) -tagOf_PrimOp IntegerGcdOp = ILIT(106) -tagOf_PrimOp IntegerQuotRemOp = ILIT(107) -tagOf_PrimOp IntegerDivModOp = ILIT(108) -tagOf_PrimOp IntegerNegOp = ILIT(109) -tagOf_PrimOp IntegerCmpOp = ILIT(110) -tagOf_PrimOp Integer2IntOp = ILIT(111) -tagOf_PrimOp Integer2WordOp = ILIT(112) -tagOf_PrimOp Int2IntegerOp = ILIT(113) -tagOf_PrimOp Word2IntegerOp = ILIT(114) -tagOf_PrimOp Addr2IntegerOp = ILIT(115) -tagOf_PrimOp IntegerToInt64Op = ILIT(116) -tagOf_PrimOp Int64ToIntegerOp = ILIT(117) -tagOf_PrimOp IntegerToWord64Op = ILIT(118) -tagOf_PrimOp Word64ToIntegerOp = ILIT(119) - -tagOf_PrimOp FloatEncodeOp = ILIT(120) -tagOf_PrimOp FloatDecodeOp = ILIT(121) -tagOf_PrimOp DoubleEncodeOp = ILIT(122) -tagOf_PrimOp DoubleDecodeOp = ILIT(123) - -tagOf_PrimOp NewArrayOp = ILIT(124) -tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(125) -tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(126) -tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(127) -tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(128) -tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(129) -tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(130) -tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(131) -tagOf_PrimOp SameMutableArrayOp = ILIT(132) -tagOf_PrimOp SameMutableByteArrayOp = ILIT(133) -tagOf_PrimOp ReadArrayOp = ILIT(134) -tagOf_PrimOp WriteArrayOp = ILIT(135) -tagOf_PrimOp IndexArrayOp = ILIT(136) - -tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(137) -tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(138) -tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(139) -tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(140) -tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(141) -tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(142) -tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(143) -tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(144) -tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(145) - -tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(146) -tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(147) -tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(148) -tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(149) -tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(150) -tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(151) -tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(152) -tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(153) -tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(154) - -tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(155) -tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(156) -tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(157) -tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(158) -tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(159) -tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(160) -tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(161) -tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(162) -tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(163) - -tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(164) -tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(165) -tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(166) -tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(167) -tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(168) -tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(169) -tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(170) -tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(171) -tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(172) -tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(173) -tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(174) -tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(175) -tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(176) -tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(177) -tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(178) -tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(179) -tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(180) -tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(181) - -tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(182) -tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(183) -tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(184) -tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(185) -tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(186) -tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(187) -tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(188) -tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(189) -tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(190) -tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(191) - -tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(192) -tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(193) -tagOf_PrimOp SizeofByteArrayOp = ILIT(194) -tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(195) -tagOf_PrimOp NewMVarOp = ILIT(196) -tagOf_PrimOp TakeMVarOp = ILIT(197) -tagOf_PrimOp PutMVarOp = ILIT(198) -tagOf_PrimOp SameMVarOp = ILIT(199) -tagOf_PrimOp IsEmptyMVarOp = ILIT(200) -tagOf_PrimOp MakeForeignObjOp = ILIT(201) -tagOf_PrimOp WriteForeignObjOp = ILIT(202) -tagOf_PrimOp MkWeakOp = ILIT(203) -tagOf_PrimOp DeRefWeakOp = ILIT(204) -tagOf_PrimOp FinaliseWeakOp = ILIT(205) -tagOf_PrimOp MakeStableNameOp = ILIT(206) -tagOf_PrimOp EqStableNameOp = ILIT(207) -tagOf_PrimOp StableNameToIntOp = ILIT(208) -tagOf_PrimOp MakeStablePtrOp = ILIT(209) -tagOf_PrimOp DeRefStablePtrOp = ILIT(210) -tagOf_PrimOp EqStablePtrOp = ILIT(211) -tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(212) -tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(213) -tagOf_PrimOp SeqOp = ILIT(214) -tagOf_PrimOp ParOp = ILIT(215) -tagOf_PrimOp ForkOp = ILIT(216) -tagOf_PrimOp KillThreadOp = ILIT(217) -tagOf_PrimOp DelayOp = ILIT(218) -tagOf_PrimOp WaitReadOp = ILIT(219) -tagOf_PrimOp WaitWriteOp = ILIT(220) -tagOf_PrimOp ParGlobalOp = ILIT(221) -tagOf_PrimOp ParLocalOp = ILIT(222) -tagOf_PrimOp ParAtOp = ILIT(223) -tagOf_PrimOp ParAtAbsOp = ILIT(224) -tagOf_PrimOp ParAtRelOp = ILIT(225) -tagOf_PrimOp ParAtForNowOp = ILIT(226) -tagOf_PrimOp CopyableOp = ILIT(227) -tagOf_PrimOp NoFollowOp = ILIT(228) -tagOf_PrimOp NewMutVarOp = ILIT(229) -tagOf_PrimOp ReadMutVarOp = ILIT(230) -tagOf_PrimOp WriteMutVarOp = ILIT(231) -tagOf_PrimOp SameMutVarOp = ILIT(232) -tagOf_PrimOp CatchOp = ILIT(233) -tagOf_PrimOp RaiseOp = ILIT(234) +tagOf_PrimOp IntAddCOp = ILIT( 57) +tagOf_PrimOp IntSubCOp = ILIT( 58) +tagOf_PrimOp IntMulCOp = ILIT( 59) +tagOf_PrimOp Int2WordOp = ILIT( 60) +tagOf_PrimOp Word2IntOp = ILIT( 61) +tagOf_PrimOp Int2AddrOp = ILIT( 62) +tagOf_PrimOp Addr2IntOp = ILIT( 63) + +tagOf_PrimOp FloatAddOp = ILIT( 64) +tagOf_PrimOp FloatSubOp = ILIT( 65) +tagOf_PrimOp FloatMulOp = ILIT( 66) +tagOf_PrimOp FloatDivOp = ILIT( 67) +tagOf_PrimOp FloatNegOp = ILIT( 68) +tagOf_PrimOp Float2IntOp = ILIT( 69) +tagOf_PrimOp Int2FloatOp = ILIT( 70) +tagOf_PrimOp FloatExpOp = ILIT( 71) +tagOf_PrimOp FloatLogOp = ILIT( 72) +tagOf_PrimOp FloatSqrtOp = ILIT( 73) +tagOf_PrimOp FloatSinOp = ILIT( 74) +tagOf_PrimOp FloatCosOp = ILIT( 75) +tagOf_PrimOp FloatTanOp = ILIT( 76) +tagOf_PrimOp FloatAsinOp = ILIT( 77) +tagOf_PrimOp FloatAcosOp = ILIT( 78) +tagOf_PrimOp FloatAtanOp = ILIT( 79) +tagOf_PrimOp FloatSinhOp = ILIT( 80) +tagOf_PrimOp FloatCoshOp = ILIT( 81) +tagOf_PrimOp FloatTanhOp = ILIT( 82) +tagOf_PrimOp FloatPowerOp = ILIT( 83) + +tagOf_PrimOp DoubleAddOp = ILIT( 84) +tagOf_PrimOp DoubleSubOp = ILIT( 85) +tagOf_PrimOp DoubleMulOp = ILIT( 86) +tagOf_PrimOp DoubleDivOp = ILIT( 87) +tagOf_PrimOp DoubleNegOp = ILIT( 88) +tagOf_PrimOp Double2IntOp = ILIT( 89) +tagOf_PrimOp Int2DoubleOp = ILIT( 90) +tagOf_PrimOp Double2FloatOp = ILIT( 91) +tagOf_PrimOp Float2DoubleOp = ILIT( 92) +tagOf_PrimOp DoubleExpOp = ILIT( 93) +tagOf_PrimOp DoubleLogOp = ILIT( 94) +tagOf_PrimOp DoubleSqrtOp = ILIT( 95) +tagOf_PrimOp DoubleSinOp = ILIT( 96) +tagOf_PrimOp DoubleCosOp = ILIT( 97) +tagOf_PrimOp DoubleTanOp = ILIT( 98) +tagOf_PrimOp DoubleAsinOp = ILIT( 99) +tagOf_PrimOp DoubleAcosOp = ILIT(100) +tagOf_PrimOp DoubleAtanOp = ILIT(101) +tagOf_PrimOp DoubleSinhOp = ILIT(102) +tagOf_PrimOp DoubleCoshOp = ILIT(103) +tagOf_PrimOp DoubleTanhOp = ILIT(104) +tagOf_PrimOp DoublePowerOp = ILIT(105) + +tagOf_PrimOp IntegerAddOp = ILIT(106) +tagOf_PrimOp IntegerSubOp = ILIT(107) +tagOf_PrimOp IntegerMulOp = ILIT(108) +tagOf_PrimOp IntegerGcdOp = ILIT(109) +tagOf_PrimOp IntegerQuotRemOp = ILIT(110) +tagOf_PrimOp IntegerDivModOp = ILIT(111) +tagOf_PrimOp IntegerNegOp = ILIT(112) +tagOf_PrimOp IntegerCmpOp = ILIT(113) +tagOf_PrimOp IntegerCmpIntOp = ILIT(114) +tagOf_PrimOp Integer2IntOp = ILIT(115) +tagOf_PrimOp Integer2WordOp = ILIT(116) +tagOf_PrimOp Int2IntegerOp = ILIT(117) +tagOf_PrimOp Word2IntegerOp = ILIT(118) +tagOf_PrimOp Addr2IntegerOp = ILIT(119) +tagOf_PrimOp IntegerToInt64Op = ILIT(120) +tagOf_PrimOp Int64ToIntegerOp = ILIT(121) +tagOf_PrimOp IntegerToWord64Op = ILIT(122) +tagOf_PrimOp Word64ToIntegerOp = ILIT(123) +tagOf_PrimOp FloatDecodeOp = ILIT(125) +tagOf_PrimOp DoubleDecodeOp = ILIT(127) + +tagOf_PrimOp NewArrayOp = ILIT(128) +tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(129) +tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(130) +tagOf_PrimOp (NewByteArrayOp WordRep) = ILIT(131) +tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(132) +tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(133) +tagOf_PrimOp (NewByteArrayOp DoubleRep) = ILIT(134) +tagOf_PrimOp (NewByteArrayOp StablePtrRep) = ILIT(135) + +tagOf_PrimOp SameMutableArrayOp = ILIT(136) +tagOf_PrimOp SameMutableByteArrayOp = ILIT(137) +tagOf_PrimOp ReadArrayOp = ILIT(138) +tagOf_PrimOp WriteArrayOp = ILIT(139) +tagOf_PrimOp IndexArrayOp = ILIT(140) + +tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(141) +tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(142) +tagOf_PrimOp (ReadByteArrayOp WordRep) = ILIT(143) +tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(144) +tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(145) +tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(146) +tagOf_PrimOp (ReadByteArrayOp StablePtrRep) = ILIT(147) +tagOf_PrimOp (ReadByteArrayOp Int64Rep) = ILIT(148) +tagOf_PrimOp (ReadByteArrayOp Word64Rep) = ILIT(149) + +tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(150) +tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(151) +tagOf_PrimOp (WriteByteArrayOp WordRep) = ILIT(152) +tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(153) +tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(154) +tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(155) +tagOf_PrimOp (WriteByteArrayOp StablePtrRep) = ILIT(156) +tagOf_PrimOp (WriteByteArrayOp Int64Rep) = ILIT(157) +tagOf_PrimOp (WriteByteArrayOp Word64Rep) = ILIT(158) + +tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(159) +tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(160) +tagOf_PrimOp (IndexByteArrayOp WordRep) = ILIT(161) +tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(162) +tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(163) +tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(164) +tagOf_PrimOp (IndexByteArrayOp StablePtrRep) = ILIT(165) +tagOf_PrimOp (IndexByteArrayOp Int64Rep) = ILIT(166) +tagOf_PrimOp (IndexByteArrayOp Word64Rep) = ILIT(167) + +tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(168) +tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(169) +tagOf_PrimOp (IndexOffAddrOp WordRep) = ILIT(170) +tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(171) +tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(172) +tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(173) +tagOf_PrimOp (IndexOffAddrOp StablePtrRep) = ILIT(174) +tagOf_PrimOp (IndexOffAddrOp Int64Rep) = ILIT(175) +tagOf_PrimOp (IndexOffAddrOp Word64Rep) = ILIT(176) + +tagOf_PrimOp (IndexOffForeignObjOp CharRep) = ILIT(177) +tagOf_PrimOp (IndexOffForeignObjOp IntRep) = ILIT(178) +tagOf_PrimOp (IndexOffForeignObjOp WordRep) = ILIT(179) +tagOf_PrimOp (IndexOffForeignObjOp AddrRep) = ILIT(180) +tagOf_PrimOp (IndexOffForeignObjOp FloatRep) = ILIT(181) +tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(182) +tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(183) +tagOf_PrimOp (IndexOffForeignObjOp Int64Rep) = ILIT(184) +tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(185) + +tagOf_PrimOp (WriteOffAddrOp CharRep) = ILIT(186) +tagOf_PrimOp (WriteOffAddrOp IntRep) = ILIT(187) +tagOf_PrimOp (WriteOffAddrOp WordRep) = ILIT(188) +tagOf_PrimOp (WriteOffAddrOp AddrRep) = ILIT(189) +tagOf_PrimOp (WriteOffAddrOp FloatRep) = ILIT(190) +tagOf_PrimOp (WriteOffAddrOp DoubleRep) = ILIT(191) +tagOf_PrimOp (WriteOffAddrOp StablePtrRep) = ILIT(192) +tagOf_PrimOp (WriteOffAddrOp ForeignObjRep) = ILIT(193) +tagOf_PrimOp (WriteOffAddrOp Int64Rep) = ILIT(194) +tagOf_PrimOp (WriteOffAddrOp Word64Rep) = ILIT(195) + +tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(196) +tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(197) +tagOf_PrimOp UnsafeThawArrayOp = ILIT(198) +tagOf_PrimOp UnsafeThawByteArrayOp = ILIT(199) +tagOf_PrimOp SizeofByteArrayOp = ILIT(200) +tagOf_PrimOp SizeofMutableByteArrayOp = ILIT(201) + +tagOf_PrimOp NewMVarOp = ILIT(202) +tagOf_PrimOp TakeMVarOp = ILIT(203) +tagOf_PrimOp PutMVarOp = ILIT(204) +tagOf_PrimOp SameMVarOp = ILIT(205) +tagOf_PrimOp IsEmptyMVarOp = ILIT(206) +tagOf_PrimOp MakeForeignObjOp = ILIT(207) +tagOf_PrimOp WriteForeignObjOp = ILIT(208) +tagOf_PrimOp MkWeakOp = ILIT(209) +tagOf_PrimOp DeRefWeakOp = ILIT(210) +tagOf_PrimOp FinalizeWeakOp = ILIT(211) +tagOf_PrimOp MakeStableNameOp = ILIT(212) +tagOf_PrimOp EqStableNameOp = ILIT(213) +tagOf_PrimOp StableNameToIntOp = ILIT(214) +tagOf_PrimOp MakeStablePtrOp = ILIT(215) +tagOf_PrimOp DeRefStablePtrOp = ILIT(216) +tagOf_PrimOp EqStablePtrOp = ILIT(217) +tagOf_PrimOp (CCallOp _ _ _ _) = ILIT(218) +tagOf_PrimOp ReallyUnsafePtrEqualityOp = ILIT(219) +tagOf_PrimOp SeqOp = ILIT(220) +tagOf_PrimOp ParOp = ILIT(221) +tagOf_PrimOp ForkOp = ILIT(222) +tagOf_PrimOp KillThreadOp = ILIT(223) +tagOf_PrimOp YieldOp = ILIT(224) +tagOf_PrimOp MyThreadIdOp = ILIT(225) +tagOf_PrimOp DelayOp = ILIT(226) +tagOf_PrimOp WaitReadOp = ILIT(227) +tagOf_PrimOp WaitWriteOp = ILIT(228) +tagOf_PrimOp ParGlobalOp = ILIT(229) +tagOf_PrimOp ParLocalOp = ILIT(230) +tagOf_PrimOp ParAtOp = ILIT(231) +tagOf_PrimOp ParAtAbsOp = ILIT(232) +tagOf_PrimOp ParAtRelOp = ILIT(233) +tagOf_PrimOp ParAtForNowOp = ILIT(234) +tagOf_PrimOp CopyableOp = ILIT(235) +tagOf_PrimOp NoFollowOp = ILIT(236) +tagOf_PrimOp NewMutVarOp = ILIT(237) +tagOf_PrimOp ReadMutVarOp = ILIT(238) +tagOf_PrimOp WriteMutVarOp = ILIT(239) +tagOf_PrimOp SameMutVarOp = ILIT(240) +tagOf_PrimOp CatchOp = ILIT(241) +tagOf_PrimOp RaiseOp = ILIT(242) +tagOf_PrimOp DataToTagOp = ILIT(243) +tagOf_PrimOp TagToEnumOp = ILIT(244) tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op) --panic# "tagOf_PrimOp: pattern-match" @@ -612,6 +640,9 @@ allThePrimOps ISllOp, ISraOp, ISrlOp, + IntAddCOp, + IntSubCOp, + IntMulCOp, Int2WordOp, Word2IntOp, Int2AddrOp, @@ -667,6 +698,7 @@ allThePrimOps IntegerDivModOp, IntegerNegOp, IntegerCmpOp, + IntegerCmpIntOp, Integer2IntOp, Integer2WordOp, Int2IntegerOp, @@ -676,9 +708,7 @@ allThePrimOps Int64ToIntegerOp, IntegerToWord64Op, Word64ToIntegerOp, - FloatEncodeOp, FloatDecodeOp, - DoubleEncodeOp, DoubleDecodeOp, NewArrayOp, NewByteArrayOp CharRep, @@ -750,6 +780,8 @@ allThePrimOps WriteOffAddrOp Word64Rep, UnsafeFreezeArrayOp, UnsafeFreezeByteArrayOp, + UnsafeThawArrayOp, + UnsafeThawByteArrayOp, SizeofByteArrayOp, SizeofMutableByteArrayOp, NewMutVarOp, @@ -767,7 +799,7 @@ allThePrimOps WriteForeignObjOp, MkWeakOp, DeRefWeakOp, - FinaliseWeakOp, + FinalizeWeakOp, MakeStableNameOp, EqStableNameOp, StableNameToIntOp, @@ -787,9 +819,13 @@ allThePrimOps ParOp, ForkOp, KillThreadOp, + YieldOp, + MyThreadIdOp, DelayOp, WaitReadOp, - WaitWriteOp + WaitWriteOp, + DataToTagOp, + TagToEnumOp ] \end{code} @@ -830,28 +866,26 @@ mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty Utility bits: \begin{code} -one_Integer_ty = [intPrimTy, intPrimTy, byteArrayPrimTy] +one_Integer_ty = [intPrimTy, byteArrayPrimTy] two_Integer_tys - = [intPrimTy, intPrimTy, byteArrayPrimTy, -- first Integer pieces - intPrimTy, intPrimTy, byteArrayPrimTy] -- second '' pieces + = [intPrimTy, byteArrayPrimTy, -- first Integer pieces + intPrimTy, byteArrayPrimTy] -- second '' pieces an_Integer_and_Int_tys - = [intPrimTy, intPrimTy, byteArrayPrimTy, -- Integer + = [intPrimTy, byteArrayPrimTy, -- Integer intPrimTy] unboxedPair = mkUnboxedTupleTy 2 unboxedTriple = mkUnboxedTupleTy 3 unboxedQuadruple = mkUnboxedTupleTy 4 -unboxedSexTuple = mkUnboxedTupleTy 6 integerMonadic name = mkGenPrimOp name [] one_Integer_ty - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedPair one_Integer_ty) integerDyadic name = mkGenPrimOp name [] two_Integer_tys - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedPair one_Integer_ty) integerDyadic2Results name = mkGenPrimOp name [] two_Integer_tys - (unboxedSexTuple [intPrimTy, intPrimTy, byteArrayPrimTy, - intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedQuadruple two_Integer_tys) integerCompare name = mkGenPrimOp name [] two_Integer_tys intPrimTy \end{code} @@ -871,8 +905,13 @@ primOpStrictness :: PrimOp -> ([Demand], Bool) -- the list of demands may be infinite! -- Use only the ones you ned. -primOpStrictness SeqOp = ([wwLazy], False) +primOpStrictness SeqOp = ([wwStrict], False) + -- Seq is strict in its argument; see notes in ConFold.lhs + primOpStrictness ParOp = ([wwLazy], False) + -- But Par is lazy, to avoid that the sparked thing + -- gets evaluted strictly, which it should *not* be + primOpStrictness ForkOp = ([wwLazy, wwPrim], False) primOpStrictness NewArrayOp = ([wwPrim, wwLazy, wwPrim], False) @@ -890,6 +929,8 @@ primOpStrictness MkWeakOp = ([wwLazy, wwLazy, wwLazy, wwPrim], False) primOpStrictness MakeStableNameOp = ([wwLazy, wwPrim], False) primOpStrictness MakeStablePtrOp = ([wwLazy, wwPrim], False) +primOpStrictness DataToTagOp = ([wwLazy], False) + -- The rest all have primitive-typed arguments primOpStrictness other = (repeat wwPrim, False) \end{code} @@ -980,6 +1021,18 @@ primOpInfo IntRemOp = mkDyadic SLIT("remInt#") intPrimTy primOpInfo IntNegOp = mkMonadic SLIT("negateInt#") intPrimTy primOpInfo IntAbsOp = mkMonadic SLIT("absInt#") intPrimTy + +primOpInfo IntAddCOp = + mkGenPrimOp SLIT("addIntC#") [] [intPrimTy, intPrimTy] + (unboxedPair [intPrimTy, intPrimTy]) + +primOpInfo IntSubCOp = + mkGenPrimOp SLIT("subIntC#") [] [intPrimTy, intPrimTy] + (unboxedPair [intPrimTy, intPrimTy]) + +primOpInfo IntMulCOp = + mkGenPrimOp SLIT("mulIntC#") [] [intPrimTy, intPrimTy] + (unboxedPair [intPrimTy, intPrimTy]) \end{code} %************************************************************************ @@ -1033,8 +1086,7 @@ primOpInfo Addr2IntOp = mkGenPrimOp SLIT("addr2Int#") [] [addrPrimTy] intPrimTy %* * %************************************************************************ -@encodeFloat#@ and @decodeFloat#@ are given w/ Integer-stuff (it's -similar). +@decodeFloat#@ is given w/ Integer-stuff (it's similar). \begin{code} primOpInfo FloatAddOp = mkDyadic SLIT("plusFloat#") floatPrimTy @@ -1067,8 +1119,7 @@ primOpInfo FloatPowerOp = mkDyadic SLIT("powerFloat#") floatPrimTy %* * %************************************************************************ -@encodeDouble#@ and @decodeDouble#@ are given w/ Integer-stuff (it's -similar). +@decodeDouble#@ is given w/ Integer-stuff (it's similar). \begin{code} primOpInfo DoubleAddOp = mkDyadic SLIT("+##") doublePrimTy @@ -1113,6 +1164,8 @@ primOpInfo IntegerMulOp = integerDyadic SLIT("timesInteger#") primOpInfo IntegerGcdOp = integerDyadic SLIT("gcdInteger#") primOpInfo IntegerCmpOp = integerCompare SLIT("cmpInteger#") +primOpInfo IntegerCmpIntOp + = mkGenPrimOp SLIT("cmpIntegerInt#") [] an_Integer_and_Int_tys intPrimTy primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#") primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#") @@ -1125,47 +1178,41 @@ primOpInfo Integer2WordOp primOpInfo Int2IntegerOp = mkGenPrimOp SLIT("int2Integer#") [] [intPrimTy] - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedPair one_Integer_ty) primOpInfo Word2IntegerOp = mkGenPrimOp SLIT("word2Integer#") [] [wordPrimTy] - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedPair one_Integer_ty) primOpInfo Addr2IntegerOp = mkGenPrimOp SLIT("addr2Integer#") [] [addrPrimTy] - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedPair one_Integer_ty) primOpInfo IntegerToInt64Op = mkGenPrimOp SLIT("integerToInt64#") [] one_Integer_ty int64PrimTy primOpInfo Int64ToIntegerOp = mkGenPrimOp SLIT("int64ToInteger#") [] [int64PrimTy] - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedPair one_Integer_ty) primOpInfo Word64ToIntegerOp = mkGenPrimOp SLIT("word64ToInteger#") [] [word64PrimTy] - (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedPair one_Integer_ty) primOpInfo IntegerToWord64Op = mkGenPrimOp SLIT("integerToWord64#") [] one_Integer_ty word64PrimTy \end{code} -Encoding and decoding of floating-point numbers is sorta -Integer-related. +Decoding of floating-point numbers is sorta Integer-related. Encoding +is done with plain ccalls now (see PrelNumExtra.lhs). \begin{code} -primOpInfo FloatEncodeOp - = mkGenPrimOp SLIT("encodeFloat#") [] an_Integer_and_Int_tys floatPrimTy - -primOpInfo DoubleEncodeOp - = mkGenPrimOp SLIT("encodeDouble#") [] an_Integer_and_Int_tys doublePrimTy - primOpInfo FloatDecodeOp = mkGenPrimOp SLIT("decodeFloat#") [] [floatPrimTy] - (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) primOpInfo DoubleDecodeOp = mkGenPrimOp SLIT("decodeDouble#") [] [doublePrimTy] - (unboxedQuadruple [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy]) + (unboxedTriple [intPrimTy, intPrimTy, byteArrayPrimTy]) \end{code} %************************************************************************ @@ -1174,6 +1221,11 @@ primOpInfo DoubleDecodeOp %* * %************************************************************************ +\begin{verbatim} +newArray# :: Int# -> a -> State# s -> (# State# s, MutArr# s a #) +newFooArray# :: Int# -> State# s -> (# State# s, MutByteArr# s #) +\end{verbatim} + \begin{code} primOpInfo NewArrayOp = let { @@ -1197,6 +1249,11 @@ primOpInfo (NewByteArrayOp kind) --------------------------------------------------------------------------- +{- +sameMutableArray# :: MutArr# s a -> MutArr# s a -> Bool +sameMutableByteArray# :: MutByteArr# s -> MutByteArr# s -> Bool +-} + primOpInfo SameMutableArrayOp = let { elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; @@ -1216,6 +1273,12 @@ primOpInfo SameMutableByteArrayOp --------------------------------------------------------------------------- -- Primitive arrays of Haskell pointers: +{- +readArray# :: MutArr# s a -> Int# -> State# s -> (# State# s, a #) +writeArray# :: MutArr# s a -> Int# -> a -> State# s -> State# s +indexArray# :: Array# a -> Int# -> (# a #) +-} + primOpInfo ReadArrayOp = let { elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; @@ -1237,7 +1300,7 @@ primOpInfo WriteArrayOp primOpInfo IndexArrayOp = let { elt = alphaTy; elt_tv = alphaTyVar } in mkGenPrimOp SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy] - (unboxedPair [realWorldStatePrimTy, elt]) + (mkUnboxedTupleTy 1 [elt]) --------------------------------------------------------------------------- -- Primitive arrays full of unboxed bytes: @@ -1296,6 +1359,13 @@ primOpInfo (WriteOffAddrOp kind) (mkStatePrimTy s) --------------------------------------------------------------------------- +{- +unsafeFreezeArray# :: MutArr# s a -> State# s -> (# State# s, Array# a #) +unsafeFreezeByteArray# :: MutByteArr# s -> State# s -> (# State# s, ByteArray# #) +unsafeThawArray# :: Array# a -> State# s -> (# State# s, MutArr# s a #) +unsafeThawByteArray# :: ByteArray# -> State# s -> (# State# s, MutByteArr# s #) +-} + primOpInfo UnsafeFreezeArrayOp = let { elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; @@ -1314,6 +1384,24 @@ primOpInfo UnsafeFreezeByteArrayOp [mkMutableByteArrayPrimTy s, state] (unboxedPair [state, byteArrayPrimTy]) +primOpInfo UnsafeThawArrayOp + = let { + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; + state = mkStatePrimTy s + } in + mkGenPrimOp SLIT("unsafeThawArray#") [s_tv, elt_tv] + [mkArrayPrimTy elt, state] + (unboxedPair [state, mkMutableArrayPrimTy s elt]) + +primOpInfo UnsafeThawByteArrayOp + = let { + s = alphaTy; s_tv = alphaTyVar; + state = mkStatePrimTy s + } in + mkGenPrimOp SLIT("unsafeThawByteArray#") [s_tv] + [byteArrayPrimTy, state] + (unboxedPair [state, mkMutableByteArrayPrimTy s]) + --------------------------------------------------------------------------- primOpInfo SizeofByteArrayOp = mkGenPrimOp @@ -1379,8 +1467,8 @@ primOpInfo SameMutVarOp %* * %************************************************************************ -catch :: IO a -> (IOError -> IO a) -> IO a -catch :: a -> (b -> a) -> a +catch :: IO a -> (IOError -> IO a) -> IO a +catch# :: a -> (b -> a) -> a \begin{code} primOpInfo CatchOp @@ -1491,11 +1579,23 @@ primOpInfo ForkOp [alphaTy, realWorldStatePrimTy] (unboxedPair [realWorldStatePrimTy, threadIdPrimTy]) --- killThread# :: ThreadId# -> State# RealWorld -> State# RealWorld +-- killThread# :: ThreadId# -> exception -> State# RealWorld -> State# RealWorld primOpInfo KillThreadOp - = mkGenPrimOp SLIT("killThread#") [] - [threadIdPrimTy, realWorldStatePrimTy] + = mkGenPrimOp SLIT("killThread#") [alphaTyVar] + [threadIdPrimTy, alphaTy, realWorldStatePrimTy] realWorldStatePrimTy + +-- yield# :: State# RealWorld -> State# RealWorld +primOpInfo YieldOp + = mkGenPrimOp SLIT("yield#") [] + [realWorldStatePrimTy] + realWorldStatePrimTy + +-- myThreadId# :: State# RealWorld -> (# State# RealWorld, ThreadId# #) +primOpInfo MyThreadIdOp + = mkGenPrimOp SLIT("myThreadId#") [] + [realWorldStatePrimTy] + (unboxedPair [realWorldStatePrimTy, threadIdPrimTy]) \end{code} ************************************************************************ @@ -1542,7 +1642,7 @@ primOpInfo MkWeakOp \end{code} The following operation dereferences a weak pointer. The weak pointer -may have been finalised, so the operation returns a result code which +may have been finalized, so the operation returns a result code which must be inspected before looking at the dereferenced value. deRefWeak# :: Weak# v -> State# RealWorld -> @@ -1561,15 +1661,26 @@ primOpInfo DeRefWeakOp (unboxedTriple [realWorldStatePrimTy, intPrimTy, alphaTy]) \end{code} -Weak pointers can be finalised early by using the finalise# operation: +Weak pointers can be finalized early by using the finalize# operation: - finalise# :: Weak# v -> State# RealWorld -> State# RealWorld + finalizeWeak# :: Weak# v -> State# RealWorld -> + (# State# RealWorld, Int#, IO () #) + +The Int# returned is either + + 0 if the weak pointer has already been finalized, or it has no + finalizer (the third component is then invalid). + + 1 if the weak pointer is still alive, with the finalizer returned + as the third component. \begin{code} -primOpInfo FinaliseWeakOp - = mkGenPrimOp SLIT("finaliseWeak#") [alphaTyVar] +primOpInfo FinalizeWeakOp + = mkGenPrimOp SLIT("finalizeWeak#") [alphaTyVar] [mkWeakPrimTy alphaTy, realWorldStatePrimTy] - realWorldStatePrimTy + (unboxedTriple [realWorldStatePrimTy, intPrimTy, + mkFunTy realWorldStatePrimTy + (unboxedPair [realWorldStatePrimTy,unitTy])]) \end{code} %************************************************************************ @@ -1584,7 +1695,7 @@ it is safe to pass a stable pointer to external systems such as C routines. \begin{verbatim} -makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, a #) +makeStablePtr# :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) freeStablePtr :: StablePtr# a -> State# RealWorld -> State# RealWorld deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) eqStablePtr# :: StablePtr# a -> StablePtr# a -> Int# @@ -1729,29 +1840,31 @@ primOpInfo ParOp -- par# :: a -> Int# -- HWL: The first 4 Int# in all par... annotations denote: -- name, granularity info, size of result, degree of parallelism -- Same structure as _seq_ i.e. returns Int# +-- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine +-- `the processor containing the expression v'; it is not evaluated -primOpInfo ParGlobalOp -- parGlobal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b +primOpInfo ParGlobalOp -- parGlobal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int# = mkGenPrimOp SLIT("parGlobal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy -primOpInfo ParLocalOp -- parLocal# :: Int# -> Int# -> Int# -> Int# -> a -> b -> b +primOpInfo ParLocalOp -- parLocal# :: a -> Int# -> Int# -> Int# -> Int# -> b -> Int# = mkGenPrimOp SLIT("parLocal#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy -primOpInfo ParAtOp -- parAt# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c +primOpInfo ParAtOp -- parAt# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int# = mkGenPrimOp SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy -primOpInfo ParAtAbsOp -- parAtAbs# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b +primOpInfo ParAtAbsOp -- parAtAbs# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# = mkGenPrimOp SLIT("parAtAbs#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy -primOpInfo ParAtRelOp -- parAtRel# :: Int# -> Int# -> Int# -> Int# -> Int# -> a -> b -> b +primOpInfo ParAtRelOp -- parAtRel# :: a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int# = mkGenPrimOp SLIT("parAtRel#") [alphaTyVar,betaTyVar] [alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,betaTy] intPrimTy -primOpInfo ParAtForNowOp -- parAtForNow# :: Int# -> Int# -> Int# -> Int# -> a -> b -> c -> c +primOpInfo ParAtForNowOp -- parAtForNow# :: a -> v -> Int# -> Int# -> Int# -> Int# -> b -> Int# = mkGenPrimOp SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [betaTy,alphaTy,intPrimTy,intPrimTy,intPrimTy,intPrimTy,gammaTy] intPrimTy -primOpInfo CopyableOp -- copyable# :: a -> a +primOpInfo CopyableOp -- copyable# :: a -> Int# = mkGenPrimOp SLIT("copyable#") [alphaTyVar] [alphaTy] intPrimTy -primOpInfo NoFollowOp -- noFollow# :: a -> a +primOpInfo NoFollowOp -- noFollow# :: a -> Int# = mkGenPrimOp SLIT("noFollow#") [alphaTyVar] [alphaTy] intPrimTy \end{code} @@ -1771,11 +1884,40 @@ primOpInfo (CCallOp _ _ _ _ arg_tys result_ty) where (result_tycon, tys_applied, _) = splitAlgTyConApp result_ty -} +\end{code} + +%************************************************************************ +%* * +\subsubsection[PrimOp-tag]{PrimOpInfo for @dataToTag#@ and @tagToEnum#@} +%* * +%************************************************************************ + +These primops are pretty wierd. + + dataToTag# :: a -> Int (arg must be an evaluated data type) + tagToEnum# :: Int -> a (result type must be an enumerated type) + +The constraints aren't currently checked by the front end, but the +code generator will fall over if they aren't satisfied. + +\begin{code} +primOpInfo DataToTagOp + = mkGenPrimOp SLIT("dataToTag#") [alphaTyVar] [alphaTy] intPrimTy + +primOpInfo TagToEnumOp + = mkGenPrimOp SLIT("tagToEnum#") [alphaTyVar] [intPrimTy] alphaTy + #ifdef DEBUG primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op))) #endif \end{code} +%************************************************************************ +%* * +\subsubsection[PrimOp-ool]{Which PrimOps are out-of-line} +%* * +%************************************************************************ + Some PrimOps need to be called out-of-line because they either need to perform a heap check or they block. @@ -1805,14 +1947,20 @@ primOpOutOfLine op FloatDecodeOp -> True DoubleDecodeOp -> True MkWeakOp -> True - FinaliseWeakOp -> True + FinalizeWeakOp -> True MakeStableNameOp -> True MakeForeignObjOp -> True NewMutVarOp -> True NewMVarOp -> True ForkOp -> True KillThreadOp -> True + YieldOp -> True CCallOp _ _ may_gc@True _ -> True -- _ccall_GC_ + -- the next one doesn't perform any heap checks, + -- but it is of such an esoteric nature that + -- it is done out-of-line rather than require + -- the NCG to implement it. + UnsafeThawArrayOp -> True _ -> False \end{code} @@ -1842,6 +1990,17 @@ than once. Evaluation order is unaffected. primOpIsCheap op = not (primOpHasSideEffects op || primOpOutOfLine op) \end{code} +primOpIsDupable means that the use of the primop is small enough to +duplicate into different case branches. See CoreUtils.exprIsDupable. + +\begin{code} +primOpIsDupable (CCallOp _ _ might_gc _) = not might_gc + -- If the ccall can't GC then the call is pretty cheap, and + -- we're happy to duplicate +primOpIsDupable op = not (primOpOutOfLine op) +\end{code} + + \begin{code} primOpCanFail :: PrimOp -> Bool -- Int. @@ -1881,13 +2040,14 @@ primOpHasSideEffects WaitWriteOp = True primOpHasSideEffects ParOp = True primOpHasSideEffects ForkOp = True primOpHasSideEffects KillThreadOp = True +primOpHasSideEffects YieldOp = True primOpHasSideEffects SeqOp = True primOpHasSideEffects MakeForeignObjOp = True primOpHasSideEffects WriteForeignObjOp = True primOpHasSideEffects MkWeakOp = True primOpHasSideEffects DeRefWeakOp = True -primOpHasSideEffects FinaliseWeakOp = True +primOpHasSideEffects FinalizeWeakOp = True primOpHasSideEffects MakeStablePtrOp = True primOpHasSideEffects MakeStableNameOp = True primOpHasSideEffects EqStablePtrOp = True -- SOF @@ -1919,6 +2079,7 @@ primOpNeedsWrapper (CCallOp _ _ _ _) = True primOpNeedsWrapper Integer2IntOp = True primOpNeedsWrapper Integer2WordOp = True primOpNeedsWrapper IntegerCmpOp = True +primOpNeedsWrapper IntegerCmpIntOp = True primOpNeedsWrapper FloatExpOp = True primOpNeedsWrapper FloatLogOp = True @@ -1933,7 +2094,6 @@ primOpNeedsWrapper FloatSinhOp = True primOpNeedsWrapper FloatCoshOp = True primOpNeedsWrapper FloatTanhOp = True primOpNeedsWrapper FloatPowerOp = True -primOpNeedsWrapper FloatEncodeOp = True primOpNeedsWrapper DoubleExpOp = True primOpNeedsWrapper DoubleLogOp = True @@ -1948,7 +2108,6 @@ primOpNeedsWrapper DoubleSinhOp = True primOpNeedsWrapper DoubleCoshOp = True primOpNeedsWrapper DoubleTanhOp = True primOpNeedsWrapper DoublePowerOp = True -primOpNeedsWrapper DoubleEncodeOp = True primOpNeedsWrapper MakeStableNameOp = True primOpNeedsWrapper DeRefStablePtrOp = True @@ -1961,19 +2120,7 @@ primOpNeedsWrapper other_op = False \end{code} \begin{code} -primOpOcc op - = case (primOpInfo op) of - Dyadic occ _ -> occ - Monadic occ _ -> occ - Compare occ _ -> occ - GenPrimOp occ _ _ _ -> occ -\end{code} - -\begin{code} -primOpUniq :: PrimOp -> Unique -primOpUniq op = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op)) - -primOpType :: PrimOp -> Type +primOpType :: PrimOp -> Type -- you may want to use primOpSig instead primOpType op = case (primOpInfo op) of Dyadic occ ty -> dyadic_fun_ty ty @@ -1982,6 +2129,140 @@ primOpType op GenPrimOp occ tyvars arg_tys res_ty -> mkForAllTys tyvars (mkFunTys arg_tys res_ty) + +mkPrimOpIdName :: PrimOp -> Id -> Name + -- Make the name for the PrimOp's Id + -- We have to pass in the Id itself because it's a WiredInId + -- and hence recursive +mkPrimOpIdName op id + = mkWiredInIdName key pREL_GHC occ_name id + where + occ_name = primOpOcc op + key = mkPrimOpIdUnique (IBOX(tagOf_PrimOp op)) + + +primOpRdrName :: PrimOp -> RdrName +primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op) + +primOpOcc :: PrimOp -> OccName +primOpOcc op = case (primOpInfo op) of + Dyadic occ _ -> occ + Monadic occ _ -> occ + Compare occ _ -> occ + GenPrimOp occ _ _ _ -> occ + +-- primOpSig is like primOpType but gives the result split apart: +-- (type variables, argument types, result type) + +primOpSig :: PrimOp -> ([TyVar],[Type],Type) +primOpSig op + = case (primOpInfo op) of + Monadic occ ty -> ([], [ty], ty ) + Dyadic occ ty -> ([], [ty,ty], ty ) + Compare occ ty -> ([], [ty,ty], boolTy) + GenPrimOp occ tyvars arg_tys res_ty + -> (tyvars, arg_tys, res_ty) + +-- primOpUsg is like primOpSig but the types it yields are the +-- appropriate sigma (i.e., usage-annotated) types, +-- as required by the UsageSP inference. + +primOpUsg :: PrimOp -> ([TyVar],[Type],Type) +primOpUsg op + = case op of + + -- Refer to comment by `otherwise' clause; we need consider here + -- *only* primops that have arguments or results containing Haskell + -- pointers (things that are pointed). Unpointed values are + -- irrelevant to the usage analysis. The issue is whether pointed + -- values may be entered or duplicated by the primop. + + -- Remember that primops are *never* partially applied. + + NewArrayOp -> mangle [mkP, mkM, mkP ] mkM + SameMutableArrayOp -> mangle [mkP, mkP ] mkM + ReadArrayOp -> mangle [mkM, mkP, mkP ] mkM + WriteArrayOp -> mangle [mkM, mkP, mkM, mkP] mkR + IndexArrayOp -> mangle [mkM, mkP ] mkM + UnsafeFreezeArrayOp -> mangle [mkM, mkP ] mkM + UnsafeThawArrayOp -> mangle [mkM, mkP ] mkM + + NewMutVarOp -> mangle [mkM, mkP ] mkM + ReadMutVarOp -> mangle [mkM, mkP ] mkM + WriteMutVarOp -> mangle [mkM, mkM, mkP ] mkR + SameMutVarOp -> mangle [mkP, mkP ] mkM + + CatchOp -> -- [mkO, mkO . (inFun mkM mkO)] mkO + mangle [mkM, mkM . (inFun mkM mkM)] mkM + -- might use caught action multiply + RaiseOp -> mangle [mkM ] mkM + + NewMVarOp -> mangle [mkP ] mkR + TakeMVarOp -> mangle [mkM, mkP ] mkM + PutMVarOp -> mangle [mkM, mkM, mkP ] mkR + SameMVarOp -> mangle [mkP, mkP ] mkM + IsEmptyMVarOp -> mangle [mkP, mkP ] mkM + + ForkOp -> mangle [mkO, mkP ] mkR + KillThreadOp -> mangle [mkP, mkM, mkP ] mkR + + MkWeakOp -> mangle [mkZ, mkM, mkM, mkP] mkM + DeRefWeakOp -> mangle [mkM, mkP ] mkM + FinalizeWeakOp -> mangle [mkM, mkP ] (mkR . (inUB [id,id,inFun mkR mkM])) + + MakeStablePtrOp -> mangle [mkM, mkP ] mkM + DeRefStablePtrOp -> mangle [mkM, mkP ] mkM + EqStablePtrOp -> mangle [mkP, mkP ] mkR + MakeStableNameOp -> mangle [mkZ, mkP ] mkR + EqStableNameOp -> mangle [mkP, mkP ] mkR + StableNameToIntOp -> mangle [mkP ] mkR + + ReallyUnsafePtrEqualityOp -> mangle [mkZ, mkZ ] mkR + + SeqOp -> mangle [mkO ] mkR + ParOp -> mangle [mkO ] mkR + ParGlobalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM + ParLocalOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM + ParAtOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM + ParAtAbsOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM + ParAtRelOp -> mangle [mkO, mkP, mkP, mkP, mkP, mkM] mkM + ParAtForNowOp -> mangle [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM + CopyableOp -> mangle [mkZ ] mkR + NoFollowOp -> mangle [mkZ ] mkR + + CCallOp _ _ _ _ -> mangle [ ] mkM + + -- Things with no Haskell pointers inside: in actuality, usages are + -- irrelevant here (hence it doesn't matter that some of these + -- apparently permit duplication; since such arguments are never + -- ENTERed anyway, the usage annotation they get is entirely irrelevant + -- except insofar as it propagates to infect other values that *are* + -- pointed. + + otherwise -> nomangle + + where mkZ = mkUsgTy UsOnce -- pointed argument used zero + mkO = mkUsgTy UsOnce -- pointed argument used once + mkM = mkUsgTy UsMany -- pointed argument used multiply + mkP = mkUsgTy UsOnce -- unpointed argument + mkR = mkUsgTy UsMany -- unpointed result + + (tyvars, arg_tys, res_ty) + = primOpSig op + + nomangle = (tyvars, map mkP arg_tys, mkR res_ty) + + mangle fs g = (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty) + + inFun f g ty = case splitFunTy_maybe ty of + Just (a,b) -> mkFunTy (f a) (g b) + Nothing -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty) + + inUB fs ty = case splitTyConApp_maybe ty of + Just (tc,tys) -> ASSERT( tc == unboxedTupleTyCon (length fs) ) + mkUnboxedTupleTy (length fs) (zipWithEqual "primOpUsg" + ($) fs tys) + Nothing -> pprPanic "primOpUsg:inUB" (ppr op <+> ppr ty) \end{code} \begin{code} @@ -1994,12 +2275,11 @@ data PrimOpResultInfo -- be out of line, or the code generator won't work. getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo - getPrimOpResultInfo op = case (primOpInfo op) of Dyadic _ ty -> ReturnsPrim (typePrimRep ty) Monadic _ ty -> ReturnsPrim (typePrimRep ty) - Compare _ ty -> ReturnsAlg boolTyCon + Compare _ ty -> ReturnsAlg boolTyCon GenPrimOp _ _ _ ty -> let rep = typePrimRep ty in case rep of @@ -2009,7 +2289,6 @@ getPrimOpResultInfo op other -> ReturnsPrim other isCompareOp :: PrimOp -> Bool - isCompareOp op = case primOpInfo op of Compare _ _ -> True