[project @ 2002-03-05 14:18:53 by simonmar]

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

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 5259fc1..82a60e0 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -6,7 +6,7 @@
 \begin{code}
 module PrimOp (
        PrimOp(..), allThePrimOps,
-       primOpType, primOpSig, primOpUsg, primOpArity,
+       primOpType, primOpSig, primOpArity,
        mkPrimOpIdName, primOpRdrName, primOpTag, primOpOcc,
 
        commutableOp,
@@ -15,7 +15,9 @@ module PrimOp (
        primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
        primOpHasSideEffects,
 
-       getPrimOpResultInfo,  PrimOpResultInfo(..)
+       getPrimOpResultInfo,  PrimOpResultInfo(..),
+
+       eqCharName, eqIntName, eqFloatName, eqDoubleName, neqIntName,
     ) where
 
 #include "HsVersions.h"
@@ -30,16 +32,12 @@ import Name         ( Name, mkWiredInName )
 import RdrName         ( RdrName, mkRdrOrig )
 import OccName         ( OccName, pprOccName, mkVarOcc )
 import TyCon           ( TyCon, isPrimTyCon, tyConPrimRep )
-import Type            ( Type, mkForAllTys, mkFunTy, mkFunTys, typePrimRep,
-                         splitFunTy_maybe, tyConAppTyCon, splitTyConApp,
-                          mkUTy, usOnce, usMany
-                       )
+import Type            ( Type, mkForAllTys, mkFunTy, mkFunTys, typePrimRep, tyConAppTyCon )
 import PprType          () -- get at Outputable Type instance.
 import Unique          ( mkPrimOpIdUnique )
 import BasicTypes      ( Arity, Boxity(..) )
-import PrelNames       ( pREL_GHC, pREL_GHC_Name )
+import PrelNames       ( gHC_PRIM, gHC_PRIM_Name )
 import Outputable
-import Util            ( zipWithEqual )
 import FastTypes
 \end{code}
 
@@ -399,10 +397,10 @@ mkPrimOpIdName :: PrimOp -> Name
        -- We have to pass in the Id itself because it's a WiredInId
        -- and hence recursive
 mkPrimOpIdName op
-  = mkWiredInName pREL_GHC (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
+  = mkWiredInName gHC_PRIM (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
 
 primOpRdrName :: PrimOp -> RdrName 
-primOpRdrName op = mkRdrOrig pREL_GHC_Name (primOpOcc op)
+primOpRdrName op = mkRdrOrig gHC_PRIM_Name (primOpOcc op)
 
 primOpOcc :: PrimOp -> OccName
 primOpOcc op = case (primOpInfo op) of
@@ -427,49 +425,6 @@ primOpSig op
          Compare   occ ty -> ([],     [ty,ty], boolTy)
          GenPrimOp occ tyvars arg_tys res_ty
                            -> (tyvars, arg_tys, res_ty)
-
--- primOpUsg is like primOpSig but the types it yields are the
--- appropriate sigma (i.e., usage-annotated) types,
--- as required by the UsageSP inference.
-
-primOpUsg :: PrimOp -> ([TyVar],[Type],Type)
-#include "primop-usage.hs-incl"
-
--- Things with no Haskell pointers inside: in actuality, usages are
--- irrelevant here (hence it doesn't matter that some of these
--- apparently permit duplication; since such arguments are never 
--- ENTERed anyway, the usage annotation they get is entirely irrelevant
--- except insofar as it propagates to infect other values that *are*
--- pointed.
-
-
--- Helper bits & pieces for usage info.
-                                    
-mkZ          = mkUTy usOnce  -- pointed argument used zero
-mkO          = mkUTy usOnce  -- pointed argument used once
-mkM          = mkUTy usMany  -- pointed argument used multiply
-mkP          = mkUTy usOnce  -- unpointed argument
-mkR          = mkUTy usMany  -- unpointed result
-
-nomangle op
-   = case primOpSig op of
-        (tyvars, arg_tys, res_ty, _, _)
-           -> (tyvars, map mkP arg_tys, mkR res_ty)
-
-mangle op fs g  
-   = case primOpSig op of
-        (tyvars, arg_tys, res_ty, _, _)
-           -> (tyvars, zipWithEqual "primOpUsg" ($) fs arg_tys, g res_ty)
-
-inFun op f g ty 
-   = case splitFunTy_maybe ty of
-        Just (a,b) -> mkFunTy (f a) (g b)
-        Nothing    -> pprPanic "primOpUsg:inFun" (ppr op <+> ppr ty)
-
-inUB op fs ty
-   = case splitTyConApp ty of
-        (tc,tys) -> ASSERT( tc == tupleTyCon Unboxed (length fs) )
-                    mkTupleTy Unboxed (length fs) (zipWithEqual "primOpUsg" ($) fs tys)
 \end{code}
 
 \begin{code}
@@ -514,14 +469,15 @@ compare_fun_ty ty = mkFunTys [ty, ty] boolTy
 Output stuff:
 \begin{code}
 pprPrimOp  :: PrimOp -> SDoc
-pprPrimOp other_op
-  = getPprStyle $ \ sty ->
-    if ifaceStyle sty then     -- For interfaces Print it qualified with PrelGHC.
-       ptext SLIT("PrelGHC.") <> pprOccName occ
-    else
-       pprOccName occ
-  where
-    occ = primOpOcc other_op
+pprPrimOp other_op = pprOccName (primOpOcc other_op)
 \end{code}
 
+Names for some primops (for ndpFlatten/FlattenMonad.lhs)
 
+\begin{code}
+eqCharName       = mkPrimOpIdName CharEqOp
+eqIntName        = mkPrimOpIdName IntEqOp
+eqFloatName      = mkPrimOpIdName FloatEqOp
+eqDoubleName     = mkPrimOpIdName DoubleEqOp
+neqIntName       = mkPrimOpIdName IntNeOp
+\end{code}