Add PrimCall to the STG layer and update Core -> STG translation
[ghc-hetmet.git] / compiler / prelude / PrimOp.lhs
index 6ac5caf..a9a8fa2 100644 (file)
@@ -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"
@@ -36,9 +38,11 @@ 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}