[project @ 1997-05-26 02:15:54 by sof]

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

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 7ba7dd3..82dfabf 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -38,15 +38,15 @@ import TysWiredIn
 import CStrings                ( identToC )
 import Constants       ( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
 import HeapOffs                ( addOff, intOff, totHdrSize, HeapOffset )
-import PprStyle                ( codeStyle, ifaceStyle )
+import Outputable      ( PprStyle, Outputable(..), codeStyle, ifaceStyle )
 import PprType         ( pprParendGenType, GenTyVar{-instance Outputable-} )
 import Pretty
 import SMRep           ( SMRep(..), SMSpecRepKind(..), SMUpdateKind(..) )
 import TyCon           ( TyCon{-instances-} )
-import Type            ( getAppDataTyConExpandingDicts, maybeAppDataTyConExpandingDicts,
-                         mkForAllTys, mkFunTy, mkFunTys, applyTyCon, typePrimRep
+import Type            ( mkForAllTys, mkFunTy, mkFunTys, applyTyCon, typePrimRep,
+                         getAppDataTyConExpandingDicts, SYN_IE(Type)
                        )
-import TyVar           ( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
+import TyVar           --( alphaTyVar, betaTyVar, gammaTyVar, GenTyVar{-instance Eq-} )
 import Unique          ( Unique{-instance Eq-} )
 import Util            ( panic#, assoc, panic{-ToDo:rm-} )
 \end{code}
@@ -766,6 +766,7 @@ primOpInfo IntQuotOp = Dyadic SLIT("quotInt#")       intPrimTy
 primOpInfo IntRemOp  = Dyadic SLIT("remInt#")   intPrimTy
 
 primOpInfo IntNegOp  = Monadic SLIT("negateInt#") intPrimTy
+primOpInfo IntAbsOp  = Monadic SLIT("absInt#") intPrimTy
 \end{code}
 
 %************************************************************************
@@ -1377,8 +1378,7 @@ primOpInfo ErrorIOPrimOp -- errorIO# :: PrimIO () -> State# RealWorld#
 primOpInfo (CCallOp _ _ _ arg_tys result_ty)
   = AlgResult SLIT("ccall#") [] arg_tys result_tycon tys_applied
   where
-    (result_tycon, tys_applied, _) = --trace "PrimOp.getAppDataTyConExpandingDicts" $
-                                    getAppDataTyConExpandingDicts result_ty
+    (result_tycon, tys_applied, _) = getAppDataTyConExpandingDicts result_ty
 
 #ifdef DEBUG
 primOpInfo op = panic ("primOpInfo:"++ show (I# (tagOf_PrimOp op)))
@@ -1771,11 +1771,10 @@ compare_fun_ty ty = mkFunTys [ty, ty] boolTy
 
 Output stuff:
 \begin{code}
-pprPrimOp  :: PprStyle -> PrimOp -> Pretty
+pprPrimOp  :: PprStyle -> PrimOp -> Doc
 showPrimOp :: PprStyle -> PrimOp -> String
 
-showPrimOp sty op
-  = ppShow 1000{-random-} (pprPrimOp sty op)
+showPrimOp sty op = render (pprPrimOp sty op)
 
 pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
   = let
@@ -1786,22 +1785,22 @@ pprPrimOp sty (CCallOp fun is_casm may_gc arg_tys res_ty)
               if may_gc then "_ccall_GC_ " else "_ccall_ "
 
        after
-         = if is_casm then ppStr "''" else ppNil
+         = if is_casm then text "''" else empty
 
        pp_tys
-         = ppCat (map (pprParendGenType sty) (res_ty:arg_tys))
+         = hsep (map (pprParendGenType sty) (res_ty:arg_tys))
     in
-    ppBesides [ppStr before, ppPStr fun, after, ppSP, ppLbrack, pp_tys, ppRbrack]
+    hcat [text before, ptext fun, after, space, brackets pp_tys]
 
 pprPrimOp sty other_op
   | codeStyle sty      -- For C just print the primop itself
   = identToC str
 
   | ifaceStyle sty     -- For interfaces Print it qualified with GHC.
-  = ppPStr SLIT("GHC.") `ppBeside` ppPStr str
+  = ptext SLIT("GHC.") <> ptext str
 
   | otherwise          -- Unqualified is good enough
-  = ppPStr str
+  = ptext str
   where
     str = primOp_str other_op