X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Fprelude%2FPrimOp.lhs;fp=ghc%2Fcompiler%2Fprelude%2FPrimOps.lhs;h=5dd0ccbb3f66a991d7f763f846b2031bcfbd46d2;hb=6c381e873e222417d9a67aeec77b9555eca7b7a8;hp=6aca5a01dbfce63a34d4d29ccf1e109d68544c5d;hpb=8147a9f0bcc48ef0db1e91f8b985a4f5c3fed560;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrimOps.lhs b/ghc/compiler/prelude/PrimOp.lhs similarity index 75% rename from ghc/compiler/prelude/PrimOps.lhs rename to ghc/compiler/prelude/PrimOp.lhs index 6aca5a0..5dd0ccb 100644 --- a/ghc/compiler/prelude/PrimOps.lhs +++ b/ghc/compiler/prelude/PrimOp.lhs @@ -1,63 +1,60 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 % -\section[PrimOps]{Primitive operations (machine-level)} +\section[PrimOp]{Primitive operations (machine-level)} \begin{code} #include "HsVersions.h" -module PrimOps ( - PrimOp(..), +module PrimOp ( + PrimOp(..), allThePrimOps, tagOf_PrimOp, -- ToDo: rm - primOpNameInfo, primOpId, - typeOfPrimOp, isCompareOp, - primOpCanTriggerGC, primOpNeedsWrapper, - primOpOkForSpeculation, primOpIsCheap, - fragilePrimOp, + primOp_str, -- sigh + primOpType, isCompareOp, PrimOpResultInfo(..), getPrimOpResultInfo, - HeapRequirement(..), primOpHeapReq, +--MOVE: primOpCanTriggerGC, primOpNeedsWrapper, +--MOVE: primOpOkForSpeculation, primOpIsCheap, +--MOVE: fragilePrimOp, +--MOVE: HeapRequirement(..), primOpHeapReq, -- export for the Native Code Generator --- primOpInfo, not exported - PrimOpInfo(..), + primOpInfo, -- needed for primOpNameInfo + PrimOpInfo(..), - pprPrimOp, showPrimOp, + pprPrimOp, showPrimOp -- and to make the interface self-sufficient.... - PrimKind, HeapOffset, Id, Name, TyCon, UniType, TyVarTemplate ) where -import PrelFuns -- help stuff for prelude -import PrimKind -- most of it +import Ubiq{-uitous-} + +import PrimRep -- most of it import TysPrim import TysWiredIn -import AbsUniType -- lots of things -import CLabelInfo ( identToC ) +import CStrings ( identToC ) import CgCompInfo ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE ) -import BasicLit ( BasicLit(..) ) -import HeapOffs ( addOff, intOff, totHdrSize, HeapOffset ) -import Id -- lots -import IdInfo -- plenty of this, too -import Maybes ( Maybe(..) ) import NameTypes ( mkPreludeCoreName, FullName, ShortName ) -import Outputable -import PlainCore -- all of it +import PprStyle ( codeStyle ) import Pretty import SMRep ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) ) -import Unique -import Util -#ifdef DPH -import TyPod -#endif {- Data Parallel Haskell -} +import TyCon ( TyCon{-instances-} ) +import Type ( getAppDataTyCon, maybeAppDataTyCon, + mkForAllTys, mkFunTys, applyTyCon ) +import TyVar ( alphaTyVar, betaTyVar ) +import Util ( panic#, assoc, panic{-ToDo:rm-} ) + +glueTyArgs = panic "PrimOp:glueTyArgs" +pprParendType = panic "PrimOp:pprParendType" +primRepFromType = panic "PrimOp:primRepFromType" \end{code} %************************************************************************ %* * -\subsection[PrimOps-datatype]{Datatype for @PrimOp@ (an enumeration)} +\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)} %* * %************************************************************************ @@ -82,7 +79,7 @@ data PrimOp -- Int#-related ops: -- IntAbsOp unused?? ADR | IntAddOp | IntSubOp | IntMulOp | IntQuotOp - | IntDivOp{-UNUSED-} | IntRemOp | IntNegOp | IntAbsOp + | IntRemOp | IntNegOp | IntAbsOp -- Word#-related ops: | AndOp | OrOp | NotOp @@ -136,20 +133,20 @@ data PrimOp -- primitive ops for primitive arrays | NewArrayOp - | NewByteArrayOp PrimKind + | NewByteArrayOp PrimRep | SameMutableArrayOp | SameMutableByteArrayOp | ReadArrayOp | WriteArrayOp | IndexArrayOp -- for arrays of Haskell ptrs - | ReadByteArrayOp PrimKind - | WriteByteArrayOp PrimKind - | IndexByteArrayOp PrimKind - | IndexOffAddrOp PrimKind - -- PrimKind can be one of {Char,Int,Addr,Float,Double}Kind. + | ReadByteArrayOp PrimRep + | WriteByteArrayOp PrimRep + | IndexByteArrayOp PrimRep + | IndexOffAddrOp PrimRep + -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind. -- This is just a cheesy encoding of a bunch of ops. - -- Note that MallocPtrKind is not included -- the only way of + -- Note that MallocPtrRep is not included -- the only way of -- creating a MallocPtr is with a ccall or casm. | UnsafeFreezeArrayOp | UnsafeFreezeByteArrayOp @@ -166,9 +163,9 @@ A special ``trap-door'' to use in making calls direct to C functions: | CCallOp FAST_STRING -- An "unboxed" ccall# to this named function Bool -- True <=> really a "casm" Bool -- True <=> might invoke Haskell GC - [UniType] -- Unboxed argument; the state-token + [Type] -- Unboxed argument; the state-token -- argument will have been put *first* - UniType -- Return type; one of the "StateAnd#" types + Type -- Return type; one of the "StateAnd#" types -- (... to be continued ... ) \end{code} @@ -186,39 +183,39 @@ For example, we represent \end{pseudocode} by \begin{pseudocode} -CoCase - ( CoPrim - (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False) +Case + ( Prim + (CCallOp "foo" [Universe#, StablePtr# a, Int#] FloatPrimAndUniverse False) -- :: Universe# -> StablePtr# a -> Int# -> FloatPrimAndUniverse [] [w#, sp# i#] ) - (CoAlgAlts [ ( FloatPrimAndIoWorld, - [f#, w#], - CoCon (TupleCon 2) [Float, IoWorld] [F# f#, World w#] - ) ] - CoNoDefault + (AlgAlts [ ( FloatPrimAndIoWorld, + [f#, w#], + Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#] + ) ] + NoDefault ) \end{pseudocode} Nota Bene: there are some people who find the empty list of types in -the @CoPrim@ somewhat puzzling and would represent the above by +the @Prim@ somewhat puzzling and would represent the above by \begin{pseudocode} -CoCase - ( CoPrim +Case + ( Prim (CCallOp "foo" [alpha1, alpha2, alpha3] alpha4 False) - -- :: /\ alpha1, alpha2 alpha3, alpha4. + -- :: /\ alpha1, alpha2 alpha3, alpha4. -- alpha1 -> alpha2 -> alpha3 -> alpha4 [Universe#, StablePtr# a, Int#, FloatPrimAndIoWorld] [w#, sp# i#] ) - (CoAlgAlts [ ( FloatPrimAndIoWorld, - [f#, w#], - CoCon (TupleCon 2) [Float, IoWorld] [F# f#, World w#] - ) ] - CoNoDefault + (AlgAlts [ ( FloatPrimAndIoWorld, + [f#, w#], + Con (TupleCon 2) [Float, IoWorld] [F# f#, World w#] + ) ] + NoDefault ) -\end{pseudocode} +\end{pseudocode} But, this is a completely different way of using @CCallOp@. The most major changes required if we switch to this are in @primOpInfo@, and @@ -256,17 +253,6 @@ about using it this way?? ADR) | CopyableOp -- marks copyable code | NoFollowOp -- marks non-followup expression #endif {-GRAN-} - -#ifdef DPH --- Shadow all the the above primitive OPs for N dimensioned objects. - | PodNPrimOp Int PrimOp - --- Primitive conversion functions. - - | Int2PodNOp Int | Char2PodNOp Int | Float2PodNOp Int - | Double2PodNOp Int | String2PodNOp Int - -#endif {-Data Parallel Haskell -} \end{code} Deriving Ix is what we really want! ToDo @@ -314,7 +300,6 @@ tagOf_PrimOp IntAddOp = ILIT( 39) tagOf_PrimOp IntSubOp = ILIT( 40) tagOf_PrimOp IntMulOp = ILIT( 41) tagOf_PrimOp IntQuotOp = ILIT( 42) ---UNUSED:tagOf_PrimOp IntDivOp = ILIT( 43) tagOf_PrimOp IntRemOp = ILIT( 44) tagOf_PrimOp IntNegOp = ILIT( 45) tagOf_PrimOp IntAbsOp = ILIT( 46) @@ -389,36 +374,36 @@ tagOf_PrimOp FloatDecodeOp = ILIT(114) tagOf_PrimOp DoubleEncodeOp = ILIT(115) tagOf_PrimOp DoubleDecodeOp = ILIT(116) tagOf_PrimOp NewArrayOp = ILIT(117) -tagOf_PrimOp (NewByteArrayOp CharKind) = ILIT(118) -tagOf_PrimOp (NewByteArrayOp IntKind) = ILIT(119) -tagOf_PrimOp (NewByteArrayOp AddrKind) = ILIT(120) -tagOf_PrimOp (NewByteArrayOp FloatKind) = ILIT(121) -tagOf_PrimOp (NewByteArrayOp DoubleKind)= ILIT(122) +tagOf_PrimOp (NewByteArrayOp CharRep) = ILIT(118) +tagOf_PrimOp (NewByteArrayOp IntRep) = ILIT(119) +tagOf_PrimOp (NewByteArrayOp AddrRep) = ILIT(120) +tagOf_PrimOp (NewByteArrayOp FloatRep) = ILIT(121) +tagOf_PrimOp (NewByteArrayOp DoubleRep)= ILIT(122) tagOf_PrimOp SameMutableArrayOp = ILIT(123) tagOf_PrimOp SameMutableByteArrayOp = ILIT(124) tagOf_PrimOp ReadArrayOp = ILIT(125) tagOf_PrimOp WriteArrayOp = ILIT(126) tagOf_PrimOp IndexArrayOp = ILIT(127) -tagOf_PrimOp (ReadByteArrayOp CharKind) = ILIT(128) -tagOf_PrimOp (ReadByteArrayOp IntKind) = ILIT(129) -tagOf_PrimOp (ReadByteArrayOp AddrKind) = ILIT(130) -tagOf_PrimOp (ReadByteArrayOp FloatKind) = ILIT(131) -tagOf_PrimOp (ReadByteArrayOp DoubleKind) = ILIT(132) -tagOf_PrimOp (WriteByteArrayOp CharKind) = ILIT(133) -tagOf_PrimOp (WriteByteArrayOp IntKind) = ILIT(134) -tagOf_PrimOp (WriteByteArrayOp AddrKind) = ILIT(135) -tagOf_PrimOp (WriteByteArrayOp FloatKind) = ILIT(136) -tagOf_PrimOp (WriteByteArrayOp DoubleKind) = ILIT(137) -tagOf_PrimOp (IndexByteArrayOp CharKind) = ILIT(138) -tagOf_PrimOp (IndexByteArrayOp IntKind) = ILIT(139) -tagOf_PrimOp (IndexByteArrayOp AddrKind) = ILIT(140) -tagOf_PrimOp (IndexByteArrayOp FloatKind) = ILIT(141) -tagOf_PrimOp (IndexByteArrayOp DoubleKind) = ILIT(142) -tagOf_PrimOp (IndexOffAddrOp CharKind) = ILIT(143) -tagOf_PrimOp (IndexOffAddrOp IntKind) = ILIT(144) -tagOf_PrimOp (IndexOffAddrOp AddrKind) = ILIT(145) -tagOf_PrimOp (IndexOffAddrOp FloatKind) = ILIT(146) -tagOf_PrimOp (IndexOffAddrOp DoubleKind) = ILIT(147) +tagOf_PrimOp (ReadByteArrayOp CharRep) = ILIT(128) +tagOf_PrimOp (ReadByteArrayOp IntRep) = ILIT(129) +tagOf_PrimOp (ReadByteArrayOp AddrRep) = ILIT(130) +tagOf_PrimOp (ReadByteArrayOp FloatRep) = ILIT(131) +tagOf_PrimOp (ReadByteArrayOp DoubleRep) = ILIT(132) +tagOf_PrimOp (WriteByteArrayOp CharRep) = ILIT(133) +tagOf_PrimOp (WriteByteArrayOp IntRep) = ILIT(134) +tagOf_PrimOp (WriteByteArrayOp AddrRep) = ILIT(135) +tagOf_PrimOp (WriteByteArrayOp FloatRep) = ILIT(136) +tagOf_PrimOp (WriteByteArrayOp DoubleRep) = ILIT(137) +tagOf_PrimOp (IndexByteArrayOp CharRep) = ILIT(138) +tagOf_PrimOp (IndexByteArrayOp IntRep) = ILIT(139) +tagOf_PrimOp (IndexByteArrayOp AddrRep) = ILIT(140) +tagOf_PrimOp (IndexByteArrayOp FloatRep) = ILIT(141) +tagOf_PrimOp (IndexByteArrayOp DoubleRep) = ILIT(142) +tagOf_PrimOp (IndexOffAddrOp CharRep) = ILIT(143) +tagOf_PrimOp (IndexOffAddrOp IntRep) = ILIT(144) +tagOf_PrimOp (IndexOffAddrOp AddrRep) = ILIT(145) +tagOf_PrimOp (IndexOffAddrOp FloatRep) = ILIT(146) +tagOf_PrimOp (IndexOffAddrOp DoubleRep) = ILIT(147) tagOf_PrimOp UnsafeFreezeArrayOp = ILIT(148) tagOf_PrimOp UnsafeFreezeByteArrayOp = ILIT(149) tagOf_PrimOp NewSynchVarOp = ILIT(150) @@ -446,27 +431,187 @@ tagOf_PrimOp CopyableOp = ILIT(169) tagOf_PrimOp NoFollowOp = ILIT(170) #endif {-GRAN-} -#ifdef DPH -tagOf_PrimOp (PodNPrimOp _ _) = panic "ToDo:DPH:tagOf_PrimOp" -tagOf_PrimOp (Int2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" -tagOf_PrimOp (Char2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" -tagOf_PrimOp (Float2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" -tagOf_PrimOp (Double2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" -tagOf_PrimOp (String2PodNOp _) = panic "ToDo:DPH:tagOf_PrimOp" -#endif {-Data Parallel Haskell -} - --- avoid BUG -tagOf_PrimOp _ = case (panic "tagOf_PrimOp: pattern-match") of { o -> - tagOf_PrimOp o - } +tagOf_PrimOp _ = panic# "tagOf_PrimOp: pattern-match" instance Eq PrimOp where op == op2 = tagOf_PrimOp op _EQ_ tagOf_PrimOp op2 \end{code} +An @Enum@-derived list would be better; meanwhile... (ToDo) +\begin{code} +allThePrimOps + = [ CharGtOp, + CharGeOp, + CharEqOp, + CharNeOp, + CharLtOp, + CharLeOp, + IntGtOp, + IntGeOp, + IntEqOp, + IntNeOp, + IntLtOp, + IntLeOp, + WordGtOp, + WordGeOp, + WordEqOp, + WordNeOp, + WordLtOp, + WordLeOp, + AddrGtOp, + AddrGeOp, + AddrEqOp, + AddrNeOp, + AddrLtOp, + AddrLeOp, + FloatGtOp, + FloatGeOp, + FloatEqOp, + FloatNeOp, + FloatLtOp, + FloatLeOp, + DoubleGtOp, + DoubleGeOp, + DoubleEqOp, + DoubleNeOp, + DoubleLtOp, + DoubleLeOp, + OrdOp, + ChrOp, + IntAddOp, + IntSubOp, + IntMulOp, + IntQuotOp, + IntRemOp, + IntNegOp, + AndOp, + OrOp, + NotOp, + SllOp, + SraOp, + SrlOp, + ISllOp, + ISraOp, + ISrlOp, + Int2WordOp, + Word2IntOp, + Int2AddrOp, + Addr2IntOp, + FloatAddOp, + FloatSubOp, + FloatMulOp, + FloatDivOp, + FloatNegOp, + Float2IntOp, + Int2FloatOp, + FloatExpOp, + FloatLogOp, + FloatSqrtOp, + FloatSinOp, + FloatCosOp, + FloatTanOp, + FloatAsinOp, + FloatAcosOp, + FloatAtanOp, + FloatSinhOp, + FloatCoshOp, + FloatTanhOp, + FloatPowerOp, + DoubleAddOp, + DoubleSubOp, + DoubleMulOp, + DoubleDivOp, + DoubleNegOp, + Double2IntOp, + Int2DoubleOp, + Double2FloatOp, + Float2DoubleOp, + DoubleExpOp, + DoubleLogOp, + DoubleSqrtOp, + DoubleSinOp, + DoubleCosOp, + DoubleTanOp, + DoubleAsinOp, + DoubleAcosOp, + DoubleAtanOp, + DoubleSinhOp, + DoubleCoshOp, + DoubleTanhOp, + DoublePowerOp, + IntegerAddOp, + IntegerSubOp, + IntegerMulOp, + IntegerQuotRemOp, + IntegerDivModOp, + IntegerNegOp, + IntegerCmpOp, + Integer2IntOp, + Int2IntegerOp, + Word2IntegerOp, + Addr2IntegerOp, + FloatEncodeOp, + FloatDecodeOp, + DoubleEncodeOp, + DoubleDecodeOp, + NewArrayOp, + NewByteArrayOp CharRep, + NewByteArrayOp IntRep, + NewByteArrayOp AddrRep, + NewByteArrayOp FloatRep, + NewByteArrayOp DoubleRep, + SameMutableArrayOp, + SameMutableByteArrayOp, + ReadArrayOp, + WriteArrayOp, + IndexArrayOp, + ReadByteArrayOp CharRep, + ReadByteArrayOp IntRep, + ReadByteArrayOp AddrRep, + ReadByteArrayOp FloatRep, + ReadByteArrayOp DoubleRep, + WriteByteArrayOp CharRep, + WriteByteArrayOp IntRep, + WriteByteArrayOp AddrRep, + WriteByteArrayOp FloatRep, + WriteByteArrayOp DoubleRep, + IndexByteArrayOp CharRep, + IndexByteArrayOp IntRep, + IndexByteArrayOp AddrRep, + IndexByteArrayOp FloatRep, + IndexByteArrayOp DoubleRep, + IndexOffAddrOp CharRep, + IndexOffAddrOp IntRep, + IndexOffAddrOp AddrRep, + IndexOffAddrOp FloatRep, + IndexOffAddrOp DoubleRep, + UnsafeFreezeArrayOp, + UnsafeFreezeByteArrayOp, + NewSynchVarOp, + ReadArrayOp, + TakeMVarOp, + PutMVarOp, + ReadIVarOp, + WriteIVarOp, + MakeStablePtrOp, + DeRefStablePtrOp, + ReallyUnsafePtrEqualityOp, + ErrorIOPrimOp, +#ifdef GRAN + ParGlobalOp, + ParLocalOp, +#endif {-GRAN-} + SeqOp, + ParOp, + ForkOp, + DelayOp, + WaitOp + ] +\end{code} + %************************************************************************ %* * -\subsection[PrimOps-info]{The essential info about each @PrimOp@} +\subsection[PrimOp-info]{The essential info about each @PrimOp@} %* * %************************************************************************ @@ -482,33 +627,28 @@ We use @PrimKinds@ for the ``type'' information, because they're \begin{code} data PrimOpInfo = Dyadic FAST_STRING -- string :: T -> T -> T - UniType + Type | Monadic FAST_STRING -- string :: T -> T - UniType + Type | Compare FAST_STRING -- string :: T -> T -> Bool - UniType + Type | Coerce FAST_STRING -- string :: T1 -> T2 - UniType - UniType + Type + Type | PrimResult FAST_STRING - [TyVarTemplate] [UniType] TyCon PrimKind [UniType] + [TyVar] [Type] TyCon PrimRep [Type] -- "PrimResult tvs [t1,..,tn] D# kind [s1,..,sm]" -- has type Forall tvs. t1 -> ... -> tn -> (D# s1 ... sm) -- D# is a primitive type constructor. -- (the kind is the same info as D#, in another convenient form) | AlgResult FAST_STRING - [TyVarTemplate] [UniType] TyCon [UniType] + [TyVar] [Type] TyCon [Type] -- "AlgResult tvs [t1,..,tn] T [s1,..,sm]" -- has type Forall tvs. t1 -> ... -> tn -> (T s1 ... sm) -- ToDo: Specialised calls to PrimOps are prohibited but may be desirable - -#ifdef DPH - | PodNInfo Int - PrimOpInfo -#endif {- Data Parallel Haskell -} \end{code} Utility bits: @@ -527,7 +667,7 @@ integerDyadic name = AlgResult name [] two_Integer_tys integerTyCon [] integerDyadic2Results name = AlgResult name [] two_Integer_tys return2GMPsTyCon [] -integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntKind [] +integerCompare name = PrimResult name [] two_Integer_tys intPrimTyCon IntRep [] \end{code} @primOpInfo@ gives all essential information (from which everything @@ -541,7 +681,7 @@ There's plenty of this stuff! %************************************************************************ %* * -\subsubsection[PrimOps-comparison]{PrimOpInfo basic comparison ops} +\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops} %* * %************************************************************************ @@ -552,35 +692,35 @@ primOpInfo CharEqOp = Compare SLIT("eqChar#") charPrimTy primOpInfo CharNeOp = Compare SLIT("neChar#") charPrimTy primOpInfo CharLtOp = Compare SLIT("ltChar#") charPrimTy primOpInfo CharLeOp = Compare SLIT("leChar#") charPrimTy - + primOpInfo IntGtOp = Compare SLIT("gtInt#") intPrimTy primOpInfo IntGeOp = Compare SLIT("geInt#") intPrimTy primOpInfo IntEqOp = Compare SLIT("eqInt#") intPrimTy primOpInfo IntNeOp = Compare SLIT("neInt#") intPrimTy primOpInfo IntLtOp = Compare SLIT("ltInt#") intPrimTy primOpInfo IntLeOp = Compare SLIT("leInt#") intPrimTy - + primOpInfo WordGtOp = Compare SLIT("gtWord#") wordPrimTy primOpInfo WordGeOp = Compare SLIT("geWord#") wordPrimTy primOpInfo WordEqOp = Compare SLIT("eqWord#") wordPrimTy primOpInfo WordNeOp = Compare SLIT("neWord#") wordPrimTy primOpInfo WordLtOp = Compare SLIT("ltWord#") wordPrimTy primOpInfo WordLeOp = Compare SLIT("leWord#") wordPrimTy - + primOpInfo AddrGtOp = Compare SLIT("gtAddr#") addrPrimTy primOpInfo AddrGeOp = Compare SLIT("geAddr#") addrPrimTy primOpInfo AddrEqOp = Compare SLIT("eqAddr#") addrPrimTy primOpInfo AddrNeOp = Compare SLIT("neAddr#") addrPrimTy primOpInfo AddrLtOp = Compare SLIT("ltAddr#") addrPrimTy primOpInfo AddrLeOp = Compare SLIT("leAddr#") addrPrimTy - + primOpInfo FloatGtOp = Compare SLIT("gtFloat#") floatPrimTy primOpInfo FloatGeOp = Compare SLIT("geFloat#") floatPrimTy primOpInfo FloatEqOp = Compare SLIT("eqFloat#") floatPrimTy primOpInfo FloatNeOp = Compare SLIT("neFloat#") floatPrimTy primOpInfo FloatLtOp = Compare SLIT("ltFloat#") floatPrimTy primOpInfo FloatLeOp = Compare SLIT("leFloat#") floatPrimTy - + primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy @@ -591,7 +731,7 @@ primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy %************************************************************************ %* * -\subsubsection[PrimOps-Char]{PrimOpInfo for @Char#@s} +\subsubsection[PrimOp-Char]{PrimOpInfo for @Char#@s} %* * %************************************************************************ @@ -602,7 +742,7 @@ primOpInfo ChrOp = Coerce SLIT("chr#") intPrimTy charPrimTy %************************************************************************ %* * -\subsubsection[PrimOps-Int]{PrimOpInfo for @Int#@s} +\subsubsection[PrimOp-Int]{PrimOpInfo for @Int#@s} %* * %************************************************************************ @@ -611,7 +751,6 @@ primOpInfo IntAddOp = Dyadic SLIT("plusInt#") intPrimTy primOpInfo IntSubOp = Dyadic SLIT("minusInt#") intPrimTy primOpInfo IntMulOp = Dyadic SLIT("timesInt#") intPrimTy primOpInfo IntQuotOp = Dyadic SLIT("quotInt#") intPrimTy ---UNUSED:primOpInfo IntDivOp = Dyadic SLIT("divInt#") intPrimTy primOpInfo IntRemOp = Dyadic SLIT("remInt#") intPrimTy primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy @@ -619,7 +758,7 @@ primOpInfo IntNegOp = Monadic SLIT("negateInt#") intPrimTy %************************************************************************ %* * -\subsubsection[PrimOps-Word]{PrimOpInfo for @Word#@s} +\subsubsection[PrimOp-Word]{PrimOpInfo for @Word#@s} %* * %************************************************************************ @@ -631,18 +770,18 @@ primOpInfo OrOp = Dyadic SLIT("or#") wordPrimTy primOpInfo NotOp = Monadic SLIT("not#") wordPrimTy primOpInfo SllOp - = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordKind [] + = PrimResult SLIT("shiftL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep [] primOpInfo SraOp - = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordKind [] + = PrimResult SLIT("shiftRA#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep [] primOpInfo SrlOp - = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordKind [] + = PrimResult SLIT("shiftRL#") [] [wordPrimTy, intPrimTy] wordPrimTyCon WordRep [] primOpInfo ISllOp - = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntKind [] + = PrimResult SLIT("iShiftL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep [] primOpInfo ISraOp - = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntKind [] + = PrimResult SLIT("iShiftRA#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep [] primOpInfo ISrlOp - = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntKind [] + = PrimResult SLIT("iShiftRL#") [] [intPrimTy, intPrimTy] intPrimTyCon IntRep [] primOpInfo Int2WordOp = Coerce SLIT("int2Word#") intPrimTy wordPrimTy primOpInfo Word2IntOp = Coerce SLIT("word2Int#") wordPrimTy intPrimTy @@ -650,7 +789,7 @@ primOpInfo Word2IntOp = Coerce SLIT("word2Int#") wordPrimTy intPrimTy %************************************************************************ %* * -\subsubsection[PrimOps-Addr]{PrimOpInfo for @Addr#@s} +\subsubsection[PrimOp-Addr]{PrimOpInfo for @Addr#@s} %* * %************************************************************************ @@ -661,7 +800,7 @@ primOpInfo Addr2IntOp = Coerce SLIT("addr2Int#") addrPrimTy intPrimTy %************************************************************************ %* * -\subsubsection[PrimOps-Float]{PrimOpInfo for @Float#@s} +\subsubsection[PrimOp-Float]{PrimOpInfo for @Float#@s} %* * %************************************************************************ @@ -695,7 +834,7 @@ primOpInfo FloatPowerOp = Dyadic SLIT("powerFloat#") floatPrimTy %************************************************************************ %* * -\subsubsection[PrimOps-Double]{PrimOpInfo for @Double#@s} +\subsubsection[PrimOp-Double]{PrimOpInfo for @Double#@s} %* * %************************************************************************ @@ -732,7 +871,7 @@ primOpInfo DoublePowerOp= Dyadic SLIT("powerDouble#") doublePrimTy %************************************************************************ %* * -\subsubsection[PrimOps-Integer]{PrimOpInfo for @Integer@ (and related!)} +\subsubsection[PrimOp-Integer]{PrimOpInfo for @Integer@ (and related!)} %* * %************************************************************************ @@ -749,7 +888,7 @@ primOpInfo IntegerQuotRemOp = integerDyadic2Results SLIT("quotRemInteger#") primOpInfo IntegerDivModOp = integerDyadic2Results SLIT("divModInteger#") primOpInfo Integer2IntOp - = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntKind [] + = PrimResult SLIT("integer2Int#") [] one_Integer_ty intPrimTyCon IntRep [] primOpInfo Int2IntegerOp = AlgResult SLIT("int2Integer#") [] [intPrimTy] integerTyCon [] @@ -767,11 +906,11 @@ Integer-related. \begin{code} primOpInfo FloatEncodeOp = PrimResult SLIT("encodeFloat#") [] an_Integer_and_Int_tys - floatPrimTyCon FloatKind [] + floatPrimTyCon FloatRep [] primOpInfo DoubleEncodeOp = PrimResult SLIT("encodeDouble#") [] an_Integer_and_Int_tys - doublePrimTyCon DoubleKind [] + doublePrimTyCon DoubleRep [] primOpInfo FloatDecodeOp = AlgResult SLIT("decodeFloat#") [] [floatPrimTy] returnIntAndGMPTyCon [] @@ -782,35 +921,35 @@ primOpInfo DoubleDecodeOp %************************************************************************ %* * -\subsubsection[PrimOps-Arrays]{PrimOpInfo for primitive arrays} +\subsubsection[PrimOp-Arrays]{PrimOpInfo for primitive arrays} %* * %************************************************************************ \begin{code} primOpInfo NewArrayOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("newArray#") [s_tv, elt_tv] [intPrimTy, elt, mkStatePrimTy s] stateAndMutableArrayPrimTyCon [s, elt] primOpInfo (NewByteArrayOp kind) = let - s = alpha; s_tv = alpha_tv + s = alphaTy; s_tv = alphaTyVar - (str, _, prim_tycon) = getKindInfo kind + (str, _, prim_tycon) = getPrimRepInfo kind op_str = _PK_ ("new" ++ str ++ "Array#") in - AlgResult op_str [s_tv] - [intPrimTy, mkStatePrimTy s] + AlgResult op_str [s_tv] + [intPrimTy, mkStatePrimTy s] stateAndMutableByteArrayPrimTyCon [s] --------------------------------------------------------------------------- primOpInfo SameMutableArrayOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv; + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar; mut_arr_ty = mkMutableArrayPrimTy s elt } in AlgResult SLIT("sameMutableArray#") [s_tv, elt_tv] [mut_arr_ty, mut_arr_ty] @@ -818,7 +957,7 @@ primOpInfo SameMutableArrayOp primOpInfo SameMutableByteArrayOp = let { - s = alpha; s_tv = alpha_tv; + s = alphaTy; s_tv = alphaTyVar; mut_arr_ty = mkMutableByteArrayPrimTy s } in AlgResult SLIT("sameMutableByteArray#") [s_tv] [mut_arr_ty, mut_arr_ty] @@ -829,7 +968,7 @@ primOpInfo SameMutableByteArrayOp primOpInfo ReadArrayOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("readArray#") [s_tv, elt_tv] [mkMutableArrayPrimTy s elt, intPrimTy, mkStatePrimTy s] @@ -838,14 +977,14 @@ primOpInfo ReadArrayOp primOpInfo WriteArrayOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in PrimResult SLIT("writeArray#") [s_tv, elt_tv] [mkMutableArrayPrimTy s elt, intPrimTy, elt, mkStatePrimTy s] - statePrimTyCon VoidKind [s] + statePrimTyCon VoidRep [s] primOpInfo IndexArrayOp - = let { elt = alpha; elt_tv = alpha_tv } in + = let { elt = alphaTy; elt_tv = alphaTyVar } in AlgResult SLIT("indexArray#") [elt_tv] [mkArrayPrimTy elt, intPrimTy] liftTyCon [elt] @@ -854,9 +993,9 @@ primOpInfo IndexArrayOp primOpInfo (ReadByteArrayOp kind) = let - s = alpha; s_tv = alpha_tv + s = alphaTy; s_tv = alphaTyVar - (str, _, prim_tycon) = getKindInfo kind + (str, _, prim_tycon) = getPrimRepInfo kind op_str = _PK_ ("read" ++ str ++ "Array#") relevant_tycon = assoc "primOpInfo" tbl kind @@ -865,29 +1004,29 @@ primOpInfo (ReadByteArrayOp kind) [mkMutableByteArrayPrimTy s, intPrimTy, mkStatePrimTy s] relevant_tycon [s] where - tbl = [ (CharKind, stateAndCharPrimTyCon), - (IntKind, stateAndIntPrimTyCon), - (AddrKind, stateAndAddrPrimTyCon), - (FloatKind, stateAndFloatPrimTyCon), - (DoubleKind, stateAndDoublePrimTyCon) ] + tbl = [ (CharRep, stateAndCharPrimTyCon), + (IntRep, stateAndIntPrimTyCon), + (AddrRep, stateAndAddrPrimTyCon), + (FloatRep, stateAndFloatPrimTyCon), + (DoubleRep, stateAndDoublePrimTyCon) ] -- How come there's no Word byte arrays? ADR primOpInfo (WriteByteArrayOp kind) = let - s = alpha; s_tv = alpha_tv + s = alphaTy; s_tv = alphaTyVar - (str, prim_ty, _) = getKindInfo kind + (str, prim_ty, _) = getPrimRepInfo kind op_str = _PK_ ("write" ++ str ++ "Array#") in -- NB: *Prim*Result -- PrimResult op_str [s_tv] [mkMutableByteArrayPrimTy s, intPrimTy, prim_ty, mkStatePrimTy s] - statePrimTyCon VoidKind [s] + statePrimTyCon VoidRep [s] primOpInfo (IndexByteArrayOp kind) = let - (str, _, prim_tycon) = getKindInfo kind + (str, _, prim_tycon) = getPrimRepInfo kind op_str = _PK_ ("index" ++ str ++ "Array#") in -- NB: *Prim*Result -- @@ -895,7 +1034,7 @@ primOpInfo (IndexByteArrayOp kind) primOpInfo (IndexOffAddrOp kind) = let - (str, _, prim_tycon) = getKindInfo kind + (str, _, prim_tycon) = getPrimRepInfo kind op_str = _PK_ ("index" ++ str ++ "OffAddr#") in PrimResult op_str [] [addrPrimTy, intPrimTy] prim_tycon kind [] @@ -903,14 +1042,14 @@ primOpInfo (IndexOffAddrOp kind) --------------------------------------------------------------------------- primOpInfo UnsafeFreezeArrayOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("unsafeFreezeArray#") [s_tv, elt_tv] [mkMutableArrayPrimTy s elt, mkStatePrimTy s] stateAndArrayPrimTyCon [s, elt] primOpInfo UnsafeFreezeByteArrayOp - = let { s = alpha; s_tv = alpha_tv } in + = let { s = alphaTy; s_tv = alphaTyVar } in AlgResult SLIT("unsafeFreezeByteArray#") [s_tv] [mkMutableByteArrayPrimTy s, mkStatePrimTy s] stateAndByteArrayPrimTyCon [s] @@ -918,21 +1057,21 @@ primOpInfo UnsafeFreezeByteArrayOp %************************************************************************ %* * -\subsubsection[PrimOps-SynchVars]{PrimOpInfo for synchronizing Variables} +\subsubsection[PrimOp-SynchVars]{PrimOpInfo for synchronizing Variables} %* * %************************************************************************ \begin{code} primOpInfo NewSynchVarOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("newSynchVar#") [s_tv, elt_tv] [mkStatePrimTy s] stateAndSynchVarPrimTyCon [s, elt] primOpInfo TakeMVarOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("takeMVar#") [s_tv, elt_tv] [mkSynchVarPrimTy s elt, mkStatePrimTy s] @@ -940,7 +1079,7 @@ primOpInfo TakeMVarOp primOpInfo PutMVarOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("putMVar#") [s_tv, elt_tv] [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s] @@ -948,7 +1087,7 @@ primOpInfo PutMVarOp primOpInfo ReadIVarOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("readIVar#") [s_tv, elt_tv] [mkSynchVarPrimTy s elt, mkStatePrimTy s] @@ -956,7 +1095,7 @@ primOpInfo ReadIVarOp primOpInfo WriteIVarOp = let { - elt = alpha; elt_tv = alpha_tv; s = beta; s_tv = beta_tv + elt = alphaTy; elt_tv = alphaTyVar; s = betaTy; s_tv = betaTyVar } in AlgResult SLIT("writeIVar#") [s_tv, elt_tv] [mkSynchVarPrimTy s elt, elt, mkStatePrimTy s] @@ -966,7 +1105,7 @@ primOpInfo WriteIVarOp %************************************************************************ %* * -\subsubsection[PrimOps-Wait]{PrimOpInfo for delay/wait operations} +\subsubsection[PrimOp-Wait]{PrimOpInfo for delay/wait operations} %* * %************************************************************************ @@ -974,26 +1113,26 @@ primOpInfo WriteIVarOp primOpInfo DelayOp = let { - s = alpha; s_tv = alpha_tv + s = alphaTy; s_tv = alphaTyVar } in PrimResult SLIT("delay#") [s_tv] [intPrimTy, mkStatePrimTy s] - statePrimTyCon VoidKind [s] + statePrimTyCon VoidRep [s] primOpInfo WaitOp = let { - s = alpha; s_tv = alpha_tv + s = alphaTy; s_tv = alphaTyVar } in PrimResult SLIT("wait#") [s_tv] [intPrimTy, mkStatePrimTy s] - statePrimTyCon VoidKind [s] + statePrimTyCon VoidRep [s] \end{code} %************************************************************************ %* * -\subsubsection[PrimOps-stable-pointers]{PrimOpInfo for ``stable pointers''} +\subsubsection[PrimOp-stable-pointers]{PrimOpInfo for ``stable pointers''} %* * %************************************************************************ @@ -1028,19 +1167,19 @@ Question: Why @_RealWorld@ - won't any instance of @_ST@ do the job? [ADR] \begin{code} primOpInfo MakeStablePtrOp - = AlgResult SLIT("makeStablePtr#") [alpha_tv] - [alpha, realWorldStatePrimTy] - stateAndStablePtrPrimTyCon [realWorldTy, alpha] + = AlgResult SLIT("makeStablePtr#") [alphaTyVar] + [alphaTy, realWorldStatePrimTy] + stateAndStablePtrPrimTyCon [realWorldTy, alphaTy] primOpInfo DeRefStablePtrOp - = AlgResult SLIT("deRefStablePtr#") [alpha_tv] - [mkStablePtrPrimTy alpha, realWorldStatePrimTy] - stateAndPtrPrimTyCon [realWorldTy, alpha] + = AlgResult SLIT("deRefStablePtr#") [alphaTyVar] + [mkStablePtrPrimTy alphaTy, realWorldStatePrimTy] + stateAndPtrPrimTyCon [realWorldTy, alphaTy] \end{code} %************************************************************************ %* * -\subsubsection[PrimOps-unsafePointerEquality]{PrimOpInfo for Pointer Equality} +\subsubsection[PrimOp-unsafePointerEquality]{PrimOpInfo for Pointer Equality} %* * %************************************************************************ @@ -1079,25 +1218,25 @@ removed...) \begin{code} primOpInfo ReallyUnsafePtrEqualityOp - = PrimResult SLIT("reallyUnsafePtrEquality#") [alpha_tv] - [alpha, alpha] intPrimTyCon IntKind [] + = PrimResult SLIT("reallyUnsafePtrEquality#") [alphaTyVar] + [alphaTy, alphaTy] intPrimTyCon IntRep [] \end{code} %************************************************************************ %* * -\subsubsection[PrimOps-parallel]{PrimOpInfo for parallelism op(s)} +\subsubsection[PrimOp-parallel]{PrimOpInfo for parallelism op(s)} %* * %************************************************************************ \begin{code} primOpInfo SeqOp -- seq# :: a -> Int# - = PrimResult SLIT("seq#") [alpha_tv] [alpha] intPrimTyCon IntKind [] + = PrimResult SLIT("seq#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] primOpInfo ParOp -- par# :: a -> Int# - = PrimResult SLIT("par#") [alpha_tv] [alpha] intPrimTyCon IntKind [] + = PrimResult SLIT("par#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] primOpInfo ForkOp -- fork# :: a -> Int# - = PrimResult SLIT("fork#") [alpha_tv] [alpha] intPrimTyCon IntKind [] + = PrimResult SLIT("fork#") [alphaTyVar] [alphaTy] intPrimTyCon IntRep [] \end{code} @@ -1105,29 +1244,29 @@ primOpInfo ForkOp -- fork# :: a -> Int# #ifdef GRAN primOpInfo ParGlobalOp -- parGlobal# :: Int -> a -> b -> b - = AlgResult SLIT("parGlobal#") [alpha_tv,beta_tv] [intPrimTy,alpha,beta] liftTyCon [beta] + = AlgResult SLIT("parGlobal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy] primOpInfo ParLocalOp -- parLocal# :: Int -> a -> b -> b - = AlgResult SLIT("parLocal#") [alpha_tv,beta_tv] [intPrimTy,alpha,beta] liftTyCon [beta] + = AlgResult SLIT("parLocal#") [alphaTyVar,betaTyVar] [intPrimTy,alphaTy,betaTy] liftTyCon [betaTy] primOpInfo ParAtOp -- parAt# :: Int -> a -> b -> c -> c - = AlgResult SLIT("parAt#") [alpha_tv,beta_tv,gamma_tv] [intPrimTy,alpha,beta,gamma] liftTyCon [gamma] + = AlgResult SLIT("parAt#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy] primOpInfo ParAtForNowOp -- parAtForNow# :: Int -> a -> b -> c -> c - = AlgResult SLIT("parAtForNow#") [alpha_tv,beta_tv,gamma_tv] [intPrimTy,alpha,beta,gamma] liftTyCon [gamma] + = AlgResult SLIT("parAtForNow#") [alphaTyVar,betaTyVar,gammaTyVar] [intPrimTy,alphaTy,betaTy,gammaTy] liftTyCon [gammaTy] primOpInfo CopyableOp -- copyable# :: a -> a - = AlgResult SLIT("copyable#") [alpha_tv] [alpha] liftTyCon [alpha] + = AlgResult SLIT("copyable#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy] primOpInfo NoFollowOp -- noFollow# :: a -> a - = AlgResult SLIT("noFollow#") [alpha_tv] [alpha] liftTyCon [alpha] + = AlgResult SLIT("noFollow#") [alphaTyVar] [alphaTy] liftTyCon [alphaTy] #endif {-GRAN-} \end{code} %************************************************************************ %* * -\subsubsection[PrimOps-errorIO]{PrimOpInfo for @errorIO#@} +\subsubsection[PrimOp-errorIO]{PrimOpInfo for @errorIO#@} %* * %************************************************************************ @@ -1135,12 +1274,12 @@ primOpInfo NoFollowOp -- noFollow# :: a -> a primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld# = PrimResult SLIT("errorIO#") [] [mkPrimIoTy unitTy] - statePrimTyCon VoidKind [realWorldTy] + statePrimTyCon VoidRep [realWorldTy] \end{code} %************************************************************************ %* * -\subsubsection[PrimOps-IO-etc]{PrimOpInfo for C calls, and I/O-ish things} +\subsubsection[PrimOp-IO-etc]{PrimOpInfo for C calls, and I/O-ish things} %* * %************************************************************************ @@ -1148,52 +1287,12 @@ primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld# primOpInfo (CCallOp _ _ _ arg_tys result_ty) = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied where - (result_tycon, tys_applied, _) = getUniDataTyCon result_ty -\end{code} - -%************************************************************************ -%* * -\subsubsection[PrimOps-DPH]{PrimOpInfo for Data Parallel Haskell} -%* * -%************************************************************************ - -\begin{code} -#ifdef DPH --- ToDo:DPH: various things need doing here - -primOpInfo (Int2PodNOp d) = Coerce ("int2Pod" ++ show d) - IntKind - (PodNKind d IntKind) - -primOpInfo (Char2PodNOp d) = Coerce ("char2Pod" ++ show d) - CharKind - (PodNKind d CharKind) - -primOpInfo (Float2PodNOp d) = Coerce ("float2Pod" ++ show d) - FloatKind - (PodNKind d FloatKind) - -primOpInfo (Double2PodNOp d) = Coerce ("double2Pod" ++ show d) - DoubleKind - (PodNKind d DoubleKind) - -{- -primOpInfo (Integer2PodNOp d) = Coerce ("integer2Pod" ++ show d) - IntegerKind - (PodNKind d IntegerKind) --} - -primOpInfo (String2PodNOp d) = Coerce ("string2Pod" ++ show d) - LitStringKind - (PodNKind d LitStringKind) - -primOpInfo (PodNPrimOp d p) = PodNInfo d (primOpInfo p) -#endif {- Data Parallel Haskell -} + (result_tycon, tys_applied, _) = getAppDataTyCon result_ty \end{code} %************************************************************************ %* * -\subsection[PrimOps-utils]{Utilities for @PrimitiveOps@} +\subsection[PrimOp-utils]{Utilities for @PrimitiveOps@} %* * %************************************************************************ @@ -1203,12 +1302,13 @@ of the various @PrimOps@. For most, no heap is required. For a few, a fixed amount of heap is required, and the needs of the @PrimOp@ can be combined with the rest of the heap usage in the basic block. For an unfortunate few, some unknown amount of heap is required (these are the -ops which can trigger GC). +ops which can trigger GC). \begin{code} -data HeapRequirement - = NoHeapRequired - | FixedHeapRequired HeapOffset +{- MOVE: +data HeapRequirement + = NoHeapRequired + | FixedHeapRequired HeapOffset | VariableHeapRequired primOpHeapReq :: PrimOp -> HeapRequirement @@ -1222,19 +1322,19 @@ primOpHeapReq IntegerMulOp = VariableHeapRequired primOpHeapReq IntegerQuotRemOp = VariableHeapRequired primOpHeapReq IntegerDivModOp = VariableHeapRequired primOpHeapReq IntegerNegOp = VariableHeapRequired -primOpHeapReq Int2IntegerOp = FixedHeapRequired +primOpHeapReq Int2IntegerOp = FixedHeapRequired (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) (intOff mIN_MP_INT_SIZE)) -primOpHeapReq Word2IntegerOp = FixedHeapRequired +primOpHeapReq Word2IntegerOp = FixedHeapRequired (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) (intOff mIN_MP_INT_SIZE)) primOpHeapReq Addr2IntegerOp = VariableHeapRequired -primOpHeapReq FloatDecodeOp = FixedHeapRequired - (addOff (intOff (getKindSize IntKind + mP_STRUCT_SIZE)) +primOpHeapReq FloatDecodeOp = FixedHeapRequired + (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE)) (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) (intOff mIN_MP_INT_SIZE))) -primOpHeapReq DoubleDecodeOp = FixedHeapRequired - (addOff (intOff (getKindSize IntKind + mP_STRUCT_SIZE)) +primOpHeapReq DoubleDecodeOp = FixedHeapRequired + (addOff (intOff (getPrimRepSize IntRep + mP_STRUCT_SIZE)) (addOff (totHdrSize (DataRep mIN_MP_INT_SIZE)) (intOff mIN_MP_INT_SIZE))) @@ -1248,7 +1348,7 @@ primOpHeapReq (CCallOp _ _ mayGC@False _ return_ty) else NoHeapRequired where returnsMallocPtr - = case (getUniDataTyCon_maybe return_ty) of + = case (maybeAppDataTyCon return_ty) of Nothing -> False Just (tycon, _, _) -> tycon == stateAndMallocPtrPrimTyCon @@ -1264,7 +1364,7 @@ primOpHeapReq FloatEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE) primOpHeapReq DoubleEncodeOp = FixedHeapRequired (intOff mP_STRUCT_SIZE) -- a NewSynchVarOp creates a three-word mutuple in the heap. -primOpHeapReq NewSynchVarOp = FixedHeapRequired +primOpHeapReq NewSynchVarOp = FixedHeapRequired (addOff (totHdrSize (MuTupleRep 3)) (intOff 3)) -- Sparking ops no longer allocate any heap; however, _fork_ may @@ -1295,24 +1395,26 @@ primOpHeapReq ParLocalOp = trace "primOpHeapReq:ParLocalOp:verify!" ( #endif {-GRAN-} primOpHeapReq other_op = NoHeapRequired +-} \end{code} Primops which can trigger GC have to be called carefully. -In particular, their arguments are guaranteed to be in registers, +In particular, their arguments are guaranteed to be in registers, and a liveness mask tells which regs are live. \begin{code} -primOpCanTriggerGC op = +{- MOVE: +primOpCanTriggerGC op = case op of TakeMVarOp -> True ReadIVarOp -> True DelayOp -> True WaitOp -> True - _ -> - case primOpHeapReq op of + _ -> + case primOpHeapReq op of VariableHeapRequired -> True _ -> False - +-} \end{code} Sometimes we may choose to execute a PrimOp even though it isn't @@ -1327,10 +1429,10 @@ There should be no worries about side effects; that's all taken care of by data dependencies. \begin{code} +{- MOVE: primOpOkForSpeculation :: PrimOp -> Bool -- Int. ---UNUSED:primOpOkForSpeculation IntDivOp = False -- Divide by zero primOpOkForSpeculation IntQuotOp = False -- Divide by zero primOpOkForSpeculation IntRemOp = False -- Divide by zero @@ -1368,20 +1470,24 @@ primOpOkForSpeculation ParLocalOp = False -- Could be expensive! -- The default is "yes it's ok for speculation" primOpOkForSpeculation other_op = True +-} \end{code} @primOpIsCheap@, as used in \tr{SimplUtils.lhs}. For now (HACK WARNING), we just borrow some other predicates for a what-should-be-good-enough test. \begin{code} +{-MOVE: primOpIsCheap op = primOpOkForSpeculation op && not (primOpCanTriggerGC op) +-} \end{code} And some primops have side-effects and so, for example, must not be duplicated. \begin{code} +{- MOVE: fragilePrimOp :: PrimOp -> Bool fragilePrimOp ParOp = True @@ -1398,18 +1504,18 @@ fragilePrimOp NoFollowOp = trace "fragilePrimOp:NoFollowOp" True -- Possibly no #endif {-GRAN-} fragilePrimOp other = False +-} \end{code} Primitive operations that perform calls need wrappers to save any live variables that are stored in caller-saves registers \begin{code} +{- MOVE: primOpNeedsWrapper :: PrimOp -> Bool primOpNeedsWrapper (CCallOp _ _ _ _ _) = True ---UNUSED:primOpNeedsWrapper IntDivOp = True - primOpNeedsWrapper NewArrayOp = True -- ToDo: for nativeGen only!(JSM) primOpNeedsWrapper (NewByteArrayOp _) = True @@ -1468,122 +1574,42 @@ primOpNeedsWrapper DelayOp = True primOpNeedsWrapper WaitOp = True primOpNeedsWrapper other_op = False +-} \end{code} \begin{code} -primOpId :: PrimOp -> Id -primOpNameInfo :: PrimOp -> (FAST_STRING, Name) - --- the *NameInfo ones are trivial: - -primOpNameInfo op = (primOp_str op, WiredInVal (primOpId op)) - primOp_str op = case (primOpInfo op) of Dyadic str _ -> str Monadic str _ -> str Compare str _ -> str - Coerce str _ _ -> str + Coerce str _ _ -> str PrimResult str _ _ _ _ _ -> str AlgResult str _ _ _ _ -> str -#ifdef DPH - PodNInfo d i -> case i of - Dyadic str _ -> (str ++ ".POD" ++ show d ++ "#") - Monadic str _ -> (str ++ ".POD" ++ show d ++ "#") - Compare str _ -> (str ++ ".POD" ++ show d ++ "#") - Coerce str _ _ -> (str ++ ".POD" ++ show d ++ "#") - PrimResult str _ _ _ _ _ -> (str ++ ".POD" ++ show d) - AlgResult str _ _ _ _ -> (str ++ ".POD" ++ show d) -#endif {- Data Parallel Haskell -} \end{code} -@typeOfPrimOp@ duplicates some work of @primOpId@, but since we +@primOpType@ duplicates some work of @primOpId@, but since we grab types pretty often... \begin{code} -typeOfPrimOp :: PrimOp -> UniType +primOpType :: PrimOp -> Type -#ifdef DPH -typeOfPrimOp (PodNPrimOp d p) - = mkPodizedPodNTy d (typeOfPrimOp p) -#endif {- Data Parallel Haskell -} - -typeOfPrimOp op +primOpType op = case (primOpInfo op) of Dyadic str ty -> dyadic_fun_ty ty Monadic str ty -> monadic_fun_ty ty - Compare str ty -> prim_compare_fun_ty ty - Coerce str ty1 ty2 -> UniFun ty1 ty2 - - PrimResult str tyvars arg_tys prim_tycon kind res_tys -> - mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon prim_tycon res_tys)) - - AlgResult str tyvars arg_tys tycon res_tys -> - mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon tycon res_tys)) -\end{code} - -\begin{code} -primOpId op - = case (primOpInfo op) of - Dyadic str ty -> - mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (dyadic_fun_ty ty) 2 - - Monadic str ty -> - mk_prim_Id op pRELUDE_BUILTIN str [] [ty] (monadic_fun_ty ty) 1 - - Compare str ty -> - mk_prim_Id op pRELUDE_BUILTIN str [] [ty,ty] (prim_compare_fun_ty ty) 2 - - Coerce str ty1 ty2 -> - mk_prim_Id op pRELUDE_BUILTIN str [] [ty1] (UniFun ty1 ty2) 1 + Compare str ty -> compare_fun_ty ty + Coerce str ty1 ty2 -> mkFunTys [ty1] ty2 PrimResult str tyvars arg_tys prim_tycon kind res_tys -> - mk_prim_Id op pRELUDE_BUILTIN str - tyvars - arg_tys - (mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon prim_tycon res_tys))) - (length arg_tys) -- arity + mkForAllTys tyvars (glueTyArgs arg_tys (applyTyCon prim_tycon res_tys)) AlgResult str tyvars arg_tys tycon res_tys -> - mk_prim_Id op pRELUDE_BUILTIN str - tyvars - arg_tys - (mkForallTy tyvars (glueTyArgs arg_tys (applyTyCon tycon res_tys))) - (length arg_tys) -- arity - -#ifdef DPH - PodNInfo d i -> panic "primOpId : Oi lazy, PodNInfo needs sorting out" -#endif {- Data Parallel Haskell -} - where - mk_prim_Id prim_op mod name tyvar_tmpls arg_tys ty arity - = mkPreludeId - (mkPrimOpIdUnique prim_op) - (mkPreludeCoreName mod name) - ty - (noIdInfo - `addInfo` (mkArityInfo arity) - `addInfo_UF` (mkUnfolding EssentialUnfolding - (mk_prim_unfold prim_op tyvar_tmpls arg_tys))) -\end{code} - -The functions to make common unfoldings are tedious. - -\begin{code} -mk_prim_unfold :: PrimOp -> [TyVarTemplate] -> [UniType] -> PlainCoreExpr{-template-} - -mk_prim_unfold prim_op tv_tmpls arg_tys - = let - (inst_env, tyvars, tyvar_tys) = instantiateTyVarTemplates tv_tmpls (map getTheUnique tv_tmpls) - inst_arg_tys = map (instantiateTauTy inst_env) arg_tys - vars = mkTemplateLocals inst_arg_tys - in - foldr CoTyLam (mkCoLam vars - (CoPrim prim_op tyvar_tys [CoVarAtom v | v <- vars])) - tyvars + mkForAllTys tyvars (glueTyArgs arg_tys (applyTyCon tycon res_tys)) \end{code} \begin{code} data PrimOpResultInfo - = ReturnsPrim PrimKind + = ReturnsPrim PrimRep | ReturnsAlg TyCon -- ToDo: Deal with specialised PrimOps @@ -1593,15 +1619,12 @@ getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo getPrimOpResultInfo op = case (primOpInfo op) of - Dyadic _ ty -> ReturnsPrim (kindFromType ty) - Monadic _ ty -> ReturnsPrim (kindFromType ty) + Dyadic _ ty -> ReturnsPrim (primRepFromType ty) + Monadic _ ty -> ReturnsPrim (primRepFromType ty) Compare _ ty -> ReturnsAlg boolTyCon - Coerce _ _ ty -> ReturnsPrim (kindFromType ty) + Coerce _ _ ty -> ReturnsPrim (primRepFromType ty) PrimResult _ _ _ _ kind _ -> ReturnsPrim kind AlgResult _ _ _ tycon _ -> ReturnsAlg tycon -#ifdef DPH - PodNInfo d i -> panic "getPrimOpResultInfo:PodNInfo" -#endif {- Data Parallel Haskell -} isCompareOp :: PrimOp -> Bool @@ -1613,11 +1636,9 @@ isCompareOp op Utils: \begin{code} -dyadic_fun_ty ty = ty `UniFun` (ty `UniFun` ty) -monadic_fun_ty ty = ty `UniFun` ty - -compare_fun_ty ty = ty `UniFun` (ty `UniFun` boolTy) -prim_compare_fun_ty ty = ty `UniFun` (ty `UniFun` boolTy) +dyadic_fun_ty ty = mkFunTys [ty, ty] ty +monadic_fun_ty ty = mkFunTys [ty] ty +compare_fun_ty ty = mkFunTys [ty, ty] boolTy \end{code} Output stuff: @@ -1641,14 +1662,11 @@ pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty) pp_tys = ppBesides [ppStr " { [", - ppIntersperse pp'SP{-'-} (map (pprParendUniType sty) arg_tys), - ppRbrack, ppSP, pprParendUniType sty res_ty, ppStr " })"] + ppIntersperse pp'SP{-'-} (map (pprParendType sty) arg_tys), + ppRbrack, ppSP, pprParendType sty res_ty, ppStr " })"] in ppBesides [ppStr before, ppPStr fun, after, pp_tys] -#ifdef DPH - = fun -- Comment buggers up machine code :-) -- ToDo:DPH -#endif {- Data Parallel Haskell -} pprPrimOp sty other_op = let