X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FPrimOp.lhs;h=29c5644346e8ea47e4f5b31d0d44fcf93b391776;hp=a65035228096c09f8408f3a2c8fe8fa8a688547b;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index a650352..29c5644 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -4,15 +4,26 @@ \section[PrimOp]{Primitive operations (machine-level)} \begin{code} +{-# OPTIONS -fno-warn-unused-binds #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module PrimOp ( PrimOp(..), allThePrimOps, primOpType, primOpSig, primOpTag, maxPrimOpTag, primOpOcc, - primOpOutOfLine, primOpNeedsWrapper, - primOpOkForSpeculation, primOpIsCheap, primOpIsDupable, + tagToEnumKey, + + primOpOutOfLine, primOpCodeSize, + primOpOkForSpeculation, primOpIsCheap, - getPrimOpResultInfo, PrimOpResultInfo(..) + getPrimOpResultInfo, PrimOpResultInfo(..), + + PrimCall(..) ) where #include "HsVersions.h" @@ -20,15 +31,19 @@ module PrimOp ( import TysPrim import TysWiredIn -import NewDemand +import Demand import Var ( TyVar ) import OccName ( OccName, pprOccName, mkVarOccFS ) import TyCon ( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) ) import Type ( Type, mkForAllTys, mkFunTy, mkFunTys, tyConAppTyCon, typePrimRep ) import BasicTypes ( Arity, Boxity(..) ) +import ForeignCall ( CLabelString ) +import Unique ( Unique, mkPrimOpIdUnique ) import Outputable import FastTypes +import FastString +import Module ( PackageId ) \end{code} %************************************************************************ @@ -84,6 +99,13 @@ allThePrimOps = #include "primop-list.hs-incl" \end{code} +\begin{code} +tagToEnumKey :: Unique +tagToEnumKey = mkPrimOpIdUnique (primOpTag TagToEnumOp) +\end{code} + + + %************************************************************************ %* * \subsection[PrimOp-info]{The essential info about each @PrimOp@} @@ -113,9 +135,12 @@ data PrimOpInfo [Type] Type +mkDyadic, mkMonadic, mkCompare :: FastString -> Type -> PrimOpInfo mkDyadic str ty = Dyadic (mkVarOccFS str) ty mkMonadic str ty = Monadic (mkVarOccFS str) ty mkCompare str ty = Compare (mkVarOccFS str) ty + +mkGenPrimOp :: FastString -> [TyVar] -> [Type] -> Type -> PrimOpInfo mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty \end{code} @@ -265,12 +290,6 @@ These primops are pretty wierd. The constraints aren't currently checked by the front end, but the code generator will fall over if they aren't satisfied. -\begin{code} -#ifdef DEBUG -primOpInfo op = pprPanic "primOpInfo:" (ppr op) -#endif -\end{code} - %************************************************************************ %* * \subsubsection[PrimOp-ool]{Which PrimOps are out-of-line} @@ -344,18 +363,23 @@ primOpIsCheap op = primOpOkForSpeculation op -- even if primOpIsCheap sometimes says 'True'. \end{code} -primOpIsDupable -~~~~~~~~~~~~~~~ -primOpIsDupable means that the use of the primop is small enough to -duplicate into different case branches. See CoreUtils.exprIsDupable. +primOpCodeSize +~~~~~~~~~~~~~~ +Gives an indication of the code size of a primop, for the purposes of +calculating unfolding sizes; see CoreUnfold.sizeExpr. \begin{code} -primOpIsDupable :: PrimOp -> Bool - -- See comments with CoreUtils.exprIsDupable - -- We say it's dupable it isn't implemented by a C call with a wrapper -primOpIsDupable op = not (primOpNeedsWrapper op) -\end{code} +primOpCodeSize :: PrimOp -> Int +#include "primop-code-size.hs-incl" + +primOpCodeSizeDefault :: Int +primOpCodeSizeDefault = 1 + -- CoreUnfold.primOpSize already takes into account primOpOutOfLine + -- and adds some further costs for the args in that case. +primOpCodeSizeForeignCall :: Int +primOpCodeSizeForeignCall = 4 +\end{code} \begin{code} primOpCanFail :: PrimOp -> Bool @@ -365,36 +389,60 @@ primOpCanFail :: PrimOp -> Bool And some primops have side-effects and so, for example, must not be duplicated. +This predicate means a little more than just "modifies the state of +the world". What it really means is "it cosumes the state on its +input". To see what this means, consider + + let + t = case readMutVar# v s0 of (# s1, x #) -> (S# s1, x) + y = case t of (s,x) -> x + in + ... y ... y ... + +Now, this is part of an ST or IO thread, so we are guaranteed by +construction that the program uses the state in a single-threaded way. +Whenever the state resulting from the readMutVar# is demanded, the +readMutVar# will be performed, and it will be ordered correctly with +respect to other operations in the monad. + +But there's another way this could go wrong: GHC can inline t into y, +and inline y. Then although the original readMutVar# will still be +correctly ordered with respect to the other operations, there will be +one or more extra readMutVar#s performed later, possibly out-of-order. +This really happened; see #3207. + +The property we need to capture about readMutVar# is that it consumes +the State# value on its input. We must retain the linearity of the +State#. + +Our fix for this is to declare any primop that must be used linearly +as having side-effects. When primOpHasSideEffects is True, +primOpOkForSpeculation will be False, and hence primOpIsCheap will +also be False, and applications of the primop will never be +duplicated. + \begin{code} primOpHasSideEffects :: PrimOp -> Bool #include "primop-has-side-effects.hs-incl" \end{code} -Inline primitive operations that perform calls need wrappers to save -any live variables that are stored in caller-saves registers. - -\begin{code} -primOpNeedsWrapper :: PrimOp -> Bool -#include "primop-needs-wrapper.hs-incl" -\end{code} - \begin{code} primOpType :: PrimOp -> Type -- you may want to use primOpSig instead primOpType op - = case (primOpInfo op) of - Dyadic occ ty -> dyadic_fun_ty ty - Monadic occ ty -> monadic_fun_ty ty - Compare occ ty -> compare_fun_ty ty + = case primOpInfo op of + Dyadic _occ ty -> dyadic_fun_ty ty + Monadic _occ ty -> monadic_fun_ty ty + Compare _occ ty -> compare_fun_ty ty - GenPrimOp occ tyvars arg_tys res_ty -> - mkForAllTys tyvars (mkFunTys arg_tys res_ty) + GenPrimOp _occ tyvars arg_tys res_ty -> + mkForAllTys tyvars (mkFunTys arg_tys res_ty) primOpOcc :: PrimOp -> OccName -primOpOcc op = case (primOpInfo op) of - Dyadic occ _ -> occ - Monadic occ _ -> occ - Compare occ _ -> occ - GenPrimOp occ _ _ _ -> occ +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) @@ -407,11 +455,10 @@ primOpSig op arity = length arg_tys (tyvars, arg_tys, res_ty) = 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) + 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) \end{code} \begin{code} @@ -428,7 +475,7 @@ getPrimOpResultInfo op = case (primOpInfo op) of Dyadic _ ty -> ReturnsPrim (typePrimRep ty) Monadic _ ty -> ReturnsPrim (typePrimRep ty) - Compare _ ty -> ReturnsAlg boolTyCon + Compare _ _ -> ReturnsAlg boolTyCon GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep tc) | otherwise -> ReturnsAlg tc where @@ -448,6 +495,7 @@ commutableOp :: PrimOp -> Bool Utils: \begin{code} +dyadic_fun_ty, monadic_fun_ty, compare_fun_ty :: Type -> Type dyadic_fun_ty ty = mkFunTys [ty, ty] ty monadic_fun_ty ty = mkFunTy ty ty compare_fun_ty ty = mkFunTys [ty, ty] boolTy @@ -459,3 +507,18 @@ pprPrimOp :: PrimOp -> SDoc pprPrimOp other_op = pprOccName (primOpOcc other_op) \end{code} + +%************************************************************************ +%* * +\subsubsection[PrimCall]{User-imported primitive calls} +%* * +%************************************************************************ + +\begin{code} +data PrimCall = PrimCall CLabelString PackageId + +instance Outputable PrimCall where + ppr (PrimCall lbl pkgId) + = text "__primcall" <+> ppr pkgId <+> ppr lbl + +\end{code}