From: simonpj <unknown>
Date: Wed, 24 Oct 2001 15:11:28 +0000 (+0000)
Subject: [project @ 2001-10-24 15:11:28 by simonpj]
X-Git-Tag: Approximately_9120_patches~714
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=fcfe16433bd582d0e00404ea652806d13d14103c;p=ghc-hetmet.git

[project @ 2001-10-24 15:11:28 by simonpj]
----------------
	Division by zero
	----------------

Teach GHC that the division primops can't fail if the divisor
is non-zero.  This can eliminate some thunks in an inner loop.
---

diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index 7df6fca..2167ba0 100644
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -13,6 +13,7 @@ module Literal
 	, hashLiteral
 
 	, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
+	, isZeroLit,
 
 	, word2IntLit, int2WordLit
 	, narrow8IntLit, narrow16IntLit, narrow32IntLit
@@ -163,6 +164,15 @@ inWordRange x = x >= 0		    && x <= tARGET_MAX_WORD
 
 inCharRange :: Int -> Bool
 inCharRange c =  c >= 0 && c <= tARGET_MAX_CHAR
+
+isZeroLit :: Literal -> Bool
+isZeroLit (MachInt    0) = True
+isZeroLit (MachInt64  0) = True
+isZeroLit (MachWord   0) = True
+isZeroLit (MachWord64 0) = True
+isZeroLit (MachFloat  0) = True
+isZeroLit (MachDouble 0) = True
+isZeroLit other		 = False
 \end{code}
 
 	Coercions
diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index 5af017d..2cd4249 100644
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -45,9 +45,9 @@ import PprCore		( pprCoreExpr )
 import Var		( Var, isId, isTyVar )
 import VarEnv
 import Name		( hashName )
-import Literal		( hashLiteral, literalType, litIsDupable )
+import Literal		( hashLiteral, literalType, litIsDupable, isZeroLit )
 import DataCon		( DataCon, dataConRepArity, dataConArgTys, isExistentialDataCon, dataConTyCon )
-import PrimOp		( primOpOkForSpeculation, primOpIsCheap )
+import PrimOp		( PrimOp(..), primOpOkForSpeculation, primOpIsCheap )
 import Id		( Id, idType, globalIdDetails, idNewStrictness, idLBVarInfo, 
 			  mkWildId, idArity, idName, idUnfolding, idInfo, isOneShotLambda,
 			  isDataConId_maybe, mkSysLocal, isDataConId, isBottomingId
@@ -474,28 +474,50 @@ side effects, and can't diverge or raise an exception.
 \begin{code}
 exprOkForSpeculation :: CoreExpr -> Bool
 exprOkForSpeculation (Lit _)    = True
+exprOkForSpeculation (Type _)   = True
 exprOkForSpeculation (Var v)    = isUnLiftedType (idType v)
 exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
 exprOkForSpeculation other_expr
-  = go other_expr 0 True
+  = case collectArgs other_expr of
+	(Var f, args) -> spec_ok (globalIdDetails f) args
+	other	      -> False
+ 
   where
-    go (Var f) n_args args_ok 
-      = case globalIdDetails f of
-	  DataConId _ -> True	-- The strictness of the constructor has already
-				-- been expressed by its "wrapper", so we don't need
-				-- to take the arguments into account
-
-	  PrimOpId op -> primOpOkForSpeculation op && args_ok
+    spec_ok (DataConId _) args
+      = True	-- The strictness of the constructor has already
+		-- been expressed by its "wrapper", so we don't need
+		-- to take the arguments into account
+
+    spec_ok (PrimOpId op) args
+      | isDivOp op,		-- Special case for dividing operations that fail
+	[arg1, Lit lit] <- args	-- only if the divisor is zero
+      = not (isZeroLit lit) && exprOkForSpeculation arg1
+		-- Often there is a literal divisor, and this 
+		-- can get rid of a thunk in an inner looop
+
+      | otherwise
+      = primOpOkForSpeculation op && 
+	all exprOkForSpeculation args
 				-- A bit conservative: we don't really need
 				-- to care about lazy arguments, but this is easy
 
-	  other -> False
-	
-    go (App f a) n_args args_ok 
-	| not (isRuntimeArg a) = go f n_args 	   args_ok
-	| otherwise            = go f (n_args + 1) (exprOkForSpeculation a && args_ok)
-
-    go other n_args args_ok = False
+    spec_ok other args = False
+
+isDivOp :: PrimOp -> Bool
+-- True of dyadic operators that can fail 
+-- only if the second arg is zero
+-- This function probably belongs in PrimOp, or even in 
+-- an automagically generated file.. but it's such a 
+-- special case I thought I'd leave it here for now.
+isDivOp IntQuotOp	 = True
+isDivOp IntRemOp	 = True
+isDivOp WordQuotOp	 = True
+isDivOp WordRemOp	 = True
+isDivOp IntegerQuotRemOp = True
+isDivOp IntegerDivModOp  = True
+isDivOp FloatDivOp       = True
+isDivOp DoubleDivOp      = True
+isDivOp other		 = False
 \end{code}