X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FPrimOp.lhs;h=7c30d9eb6419c4fffe8234ccdddd9d75b47cf6be;hp=dae8bee840ae8766d3221f4f15e188da2dd3d1dd;hb=9448411acfcaae8109c31be5828e75619f2cad9b;hpb=c938c386fe84f9203c992bb35508c7a5b35bb22c

diff --git a/compiler/prelude/PrimOp.lhs b/compiler/prelude/PrimOp.lhs
index dae8bee..7c30d9e 100644
--- a/compiler/prelude/PrimOp.lhs
+++ b/compiler/prelude/PrimOp.lhs
@@ -4,6 +4,13 @@
 \section[PrimOp]{Primitive operations (machine-level)}
 
 \begin{code}
+{-# 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/Commentary/CodingStyle#Warnings
+-- for details
+
 module PrimOp (
 	PrimOp(..), allThePrimOps,
 	primOpType, primOpSig,
@@ -32,6 +39,7 @@ import BasicTypes	( Arity, Boxity(..) )
 import Unique		( Unique, mkPrimOpIdUnique )
 import Outputable
 import FastTypes
+import FastString
 \end{code}
 
 %************************************************************************
@@ -123,9 +131,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}
 
@@ -391,20 +402,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)
@@ -417,11 +428,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}
@@ -438,7 +448,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
@@ -458,6 +468,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