[project @ 2000-10-31 17:30:16 by simonpj]

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

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 9e946d8..e334fa1 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -30,11 +30,11 @@ import TysPrim
 import TysWiredIn
 
 import Demand          ( wwLazy, wwPrim, wwStrict, StrictnessInfo(..) )
-import Var             ( TyVar, Id )
+import Var             ( TyVar )
 import CallConv                ( CallConv, pprCallConv )
-import Name            ( Name, mkWiredInIdName )
-import RdrName         ( RdrName, mkRdrQual )
-import OccName         ( OccName, pprOccName, mkSrcVarOcc )
+import Name            ( Name, mkWiredInName )
+import RdrName         ( RdrName, mkRdrOrig )
+import OccName         ( OccName, pprOccName, mkVarOcc )
 import TyCon           ( TyCon, tyConArity )
 import Type            ( Type, mkForAllTys, mkFunTy, mkFunTys, mkTyVarTys,
                          mkTyConApp, typePrimRep,
@@ -47,7 +47,7 @@ import CStrings               ( CLabelString, pprCLabelString )
 import PrelNames       ( pREL_GHC, pREL_GHC_Name )
 import Outputable
 import Util            ( zipWithEqual )
-import GlaExts         ( Int(..), Int#, (==#) )
+import FastTypes
 \end{code}
 
 %************************************************************************
@@ -70,22 +70,22 @@ Used for the Ord instance
 
 \begin{code}
 primOpTag :: PrimOp -> Int
-primOpTag op = IBOX( tagOf_PrimOp op )
+primOpTag op = iBox (tagOf_PrimOp op)
 
 -- supplies   
--- tagOf_PrimOp :: PrimOp -> FAST_INT
+-- tagOf_PrimOp :: PrimOp -> FastInt
 #include "primop-tag.hs-incl"
 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
 
 
 instance Eq PrimOp where
-    op1 == op2 = tagOf_PrimOp op1 _EQ_ tagOf_PrimOp op2
+    op1 == op2 = tagOf_PrimOp op1 ==# tagOf_PrimOp op2
 
 instance Ord PrimOp where
-    op1 <  op2 =  tagOf_PrimOp op1 _LT_ tagOf_PrimOp op2
-    op1 <= op2 =  tagOf_PrimOp op1 _LE_ tagOf_PrimOp op2
-    op1 >= op2 =  tagOf_PrimOp op1 _GE_ tagOf_PrimOp op2
-    op1 >  op2 =  tagOf_PrimOp op1 _GT_ tagOf_PrimOp op2
+    op1 <  op2 =  tagOf_PrimOp op1 <# tagOf_PrimOp op2
+    op1 <= op2 =  tagOf_PrimOp op1 <=# tagOf_PrimOp op2
+    op1 >= op2 =  tagOf_PrimOp op1 >=# tagOf_PrimOp op2
+    op1 >  op2 =  tagOf_PrimOp op1 ># tagOf_PrimOp op2
     op1 `compare` op2 | op1 < op2  = LT
                      | op1 == op2 = EQ
                      | otherwise  = GT
@@ -134,10 +134,10 @@ data PrimOpInfo
                [Type] 
                Type 
 
-mkDyadic str  ty = Dyadic  (mkSrcVarOcc str) ty
-mkMonadic str ty = Monadic (mkSrcVarOcc str) ty
-mkCompare str ty = Compare (mkSrcVarOcc str) ty
-mkGenPrimOp str tvs tys ty = GenPrimOp (mkSrcVarOcc str) tvs tys ty
+mkDyadic str  ty = Dyadic  (mkVarOcc str) ty
+mkMonadic str ty = Monadic (mkVarOcc str) ty
+mkCompare str ty = Compare (mkVarOcc str) ty
+mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOcc str) tvs tys ty
 \end{code}
 
 %************************************************************************
@@ -437,19 +437,15 @@ primOpType op
       GenPrimOp occ tyvars arg_tys res_ty -> 
        mkForAllTys tyvars (mkFunTys arg_tys res_ty)
 
-mkPrimOpIdName :: PrimOp -> Id -> Name
+mkPrimOpIdName :: PrimOp -> Name
        -- Make the name for the PrimOp's Id
        -- We have to pass in the Id itself because it's a WiredInId
        -- and hence recursive
-mkPrimOpIdName op id
-  = mkWiredInIdName key pREL_GHC occ_name id
-  where
-    occ_name = primOpOcc op
-    key             = mkPrimOpIdUnique (primOpTag op)
-
+mkPrimOpIdName op
+  = mkWiredInName pREL_GHC (primOpOcc op) (mkPrimOpIdUnique (primOpTag op))
 
 primOpRdrName :: PrimOp -> RdrName 
-primOpRdrName op = mkRdrQual pREL_GHC_Name (primOpOcc op)
+primOpRdrName op = mkRdrOrig pREL_GHC_Name (primOpOcc op)
 
 primOpOcc :: PrimOp -> OccName
 primOpOcc op = case (primOpInfo op) of
@@ -543,7 +539,8 @@ getPrimOpResultInfo op
        let rep = typePrimRep ty in
        case rep of
           PtrRep -> case splitAlgTyConApp_maybe ty of
-                       Nothing -> panic "getPrimOpResultInfo"
+                       Nothing -> pprPanic "getPrimOpResultInfo" 
+                                            (ppr ty <+> ppr op)
                        Just (tc,_,_) -> ReturnsAlg tc
           other -> ReturnsPrim other
 \end{code}