From: simonpj <unknown>
Date: Tue, 21 Aug 2001 09:59:33 +0000 (+0000)
Subject: [project @ 2001-08-21 09:59:33 by simonpj]
X-Git-Tag: Approximately_9120_patches~1159
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6c0d7900ae25ddb14d50ac3d6e895c8a960997b2;p=ghc-hetmet.git

[project @ 2001-08-21 09:59:33 by simonpj]
Fix tycon assert failure
---

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 04efcb3..afec1a2 100644
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -29,7 +29,7 @@ import Var		( TyVar )
 import Name		( Name, mkWiredInName )
 import RdrName		( RdrName, mkRdrOrig )
 import OccName		( OccName, pprOccName, mkVarOcc )
-import TyCon		( TyCon )
+import TyCon		( TyCon, isPrimTyCon, tyConPrimRep )
 import Type		( Type, mkForAllTys, mkFunTy, mkFunTys, typePrimRep,
 			  splitFunTy_maybe, tyConAppTyCon, splitTyConApp,
                           mkUTy, usOnce, usMany
@@ -517,12 +517,14 @@ data PrimOpResultInfo
 getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
 getPrimOpResultInfo op
   = case (primOpInfo op) of
-      Dyadic  _ ty		 -> ReturnsPrim (typePrimRep ty)
-      Monadic _ ty		 -> ReturnsPrim (typePrimRep ty)
-      Compare _ ty		 -> ReturnsAlg boolTyCon
-      GenPrimOp _ _ _ ty	 -> case typePrimRep ty of
-					   PtrRep -> ReturnsAlg (tyConAppTyCon ty)
-					   rep    -> ReturnsPrim rep
+      Dyadic  _ ty		 	  -> ReturnsPrim (typePrimRep ty)
+      Monadic _ ty		 	  -> ReturnsPrim (typePrimRep ty)
+      Compare _ ty		 	  -> ReturnsAlg boolTyCon
+      GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep tc)
+			 | otherwise      -> ReturnsAlg tc
+			 where
+			   tc = tyConAppTyCon ty
+			-- All primops return a tycon-app result
 \end{code}
 
 The commutable ops are those for which we will try to move constants