Remove the (very) old strictness analyser

[ghc-hetmet.git] / compiler / prelude / PrimOp.lhs

diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
index 6ac5caf..4ac1577 100644 (file)
--- a/compiler/prelude/PrimOp.lhs
+++ b/compiler/prelude/PrimOp.lhs
@@ -4,11 +4,11 @@
 \section[PrimOp]{Primitive operations (machine-level)}
 
 \begin{code}
 \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
 -- 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 (
 -- for details
 
 module PrimOp (

@@ -21,7 +21,9 @@ module PrimOp (
        primOpOutOfLine, primOpNeedsWrapper, 
        primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
 
        primOpOutOfLine, primOpNeedsWrapper, 
        primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
 

-       getPrimOpResultInfo,  PrimOpResultInfo(..)
+       getPrimOpResultInfo,  PrimOpResultInfo(..),
+
+        PrimCall(..)

     ) where
 
 #include "HsVersions.h"
     ) where
 
 #include "HsVersions.h"

@@ -29,16 +31,18 @@ module PrimOp (
 import TysPrim
 import TysWiredIn
 
 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 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 Unique          ( Unique, mkPrimOpIdUnique )
 import Outputable
 import FastTypes

+import FastString

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -130,9 +134,12 @@ data PrimOpInfo
                [Type] 
                Type 
 
                [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
 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}
 
 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.
 
 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}
 %************************************************************************
 %*                                                                     *
 \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.
 
 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"
 \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
 \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 :: 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)
 
 -- 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
     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}
 \end{code}
 
 \begin{code}

@@ -445,7 +477,7 @@ getPrimOpResultInfo op
   = case (primOpInfo op) of
       Dyadic  _ ty                       -> ReturnsPrim (typePrimRep ty)
       Monadic _ ty                       -> ReturnsPrim (typePrimRep ty)
   = 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
       GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep tc)
                         | otherwise      -> ReturnsAlg tc
                         where

@@ -465,6 +497,7 @@ commutableOp :: PrimOp -> Bool
 
 Utils:
 \begin{code}
 
 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
 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}
 
 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}