X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FPrimOp.lhs;h=4ac157770703a7ca08057df2fa92ee06c4cda561;hp=6ac5caf5d7c07a44f45a5caba1f57692fc763271;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hpb=ad94d40948668032189ad22a0ad741ac1f645f50 diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs index 6ac5caf..4ac1577 100644 --- a/compiler/prelude/PrimOp.lhs +++ b/compiler/prelude/PrimOp.lhs @@ -4,11 +4,11 @@ \section[PrimOp]{Primitive operations (machine-level)} \begin{code} -{-# OPTIONS -w #-} +{-# 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/CodingStyle#Warnings +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module PrimOp ( @@ -21,7 +21,9 @@ module PrimOp ( primOpOutOfLine, primOpNeedsWrapper, primOpOkForSpeculation, primOpIsCheap, primOpIsDupable, - getPrimOpResultInfo, PrimOpResultInfo(..) + getPrimOpResultInfo, PrimOpResultInfo(..), + + PrimCall(..) ) where #include "HsVersions.h" @@ -29,16 +31,18 @@ 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 \end{code} %************************************************************************ @@ -130,9 +134,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} @@ -282,12 +289,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} @@ -382,6 +383,38 @@ 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" @@ -398,20 +431,20 @@ primOpNeedsWrapper :: PrimOp -> Bool \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) @@ -424,11 +457,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} @@ -445,7 +477,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 @@ -465,6 +497,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 @@ -476,3 +509,17 @@ pprPrimOp :: PrimOp -> SDoc pprPrimOp other_op = pprOccName (primOpOcc other_op) \end{code} + +%************************************************************************ +%* * +\subsubsection[PrimCall]{User-imported primitive calls} +%* * +%************************************************************************ + +\begin{code} +newtype PrimCall = PrimCall CLabelString + +instance Outputable PrimCall where + ppr (PrimCall lbl) = ppr lbl + +\end{code}