[project @ 1998-03-12 17:27:22 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / ConFold.lhs

diff --git a/ghc/compiler/simplCore/ConFold.lhs b/ghc/compiler/simplCore/ConFold.lhs
index 1b4c5ff..7c09ad1 100644 (file)
--- a/ghc/compiler/simplCore/ConFold.lhs
+++ b/ghc/compiler/simplCore/ConFold.lhs
@@ -8,26 +8,21 @@ ToDo:
    (i1 + i2) only if it results        in a valid Float.
 
 \begin{code}
-#include "HsVersions.h"
-
 module ConFold ( completePrim ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
 import CoreSyn
-import CoreUnfold      ( whnfDetails, UnfoldingDetails(..), FormSummary(..) )
+import CoreUnfold      ( Unfolding )
 import Id              ( idType )
 import Literal         ( mkMachInt, mkMachWord, Literal(..) )
-import MagicUFs                ( MagicUnfoldingFun )
 import PrimOp          ( PrimOp(..) )
 import SimplEnv
 import SimplMonad
+import SimplUtils      ( newId )
 import TysWiredIn      ( trueDataCon, falseDataCon )
 
-#ifdef REALLY_HASKELL_1_3
-ord = fromEnum :: Char -> Int
-chr = toEnum   :: Int -> Char
-#endif
+import Char            ( ord, chr )
 \end{code}
 
 \begin{code}
@@ -95,10 +90,8 @@ completePrim env SeqOp [TyArg ty, LitArg lit]
   = returnSmpl (Lit (mkMachInt 1))
 
 completePrim env op@SeqOp args@[TyArg ty, VarArg var]
-  | whnfDetails (lookupUnfolding env var)
-  = returnSmpl (Lit (mkMachInt 1))
-  | otherwise
-  = returnSmpl (Prim op args)
+  | isEvaluated (lookupUnfolding env var) = returnSmpl (Lit (mkMachInt 1))  -- var is eval'd
+  | otherwise                          = returnSmpl (Prim op args)       -- var not eval'd
 \end{code}
 
 \begin{code}
@@ -199,22 +192,7 @@ completePrim env op args
 
        ---------   Floats --------------
     oneFloatLit FloatNegOp  f  = return_float (-f)
-#if __GLASGOW_HASKELL__ <= 22
-    oneFloatLit FloatExpOp  f  = return_float (exp f)
-    oneFloatLit FloatLogOp  f  = return_float (log f)
-    oneFloatLit FloatSqrtOp f  = return_float (sqrt f)
-    oneFloatLit FloatSinOp  f  = return_float (sin f)
-    oneFloatLit FloatCosOp  f  = return_float (cos f)
-    oneFloatLit FloatTanOp  f  = return_float (tan f)
-    oneFloatLit FloatAsinOp f  = return_float (asin f)
-    oneFloatLit FloatAcosOp f  = return_float (acos f)
-    oneFloatLit FloatAtanOp f  = return_float (atan f)
-    oneFloatLit FloatSinhOp f  = return_float (sinh f)
-    oneFloatLit FloatCoshOp f  = return_float (cosh f)
-    oneFloatLit FloatTanhOp f  = return_float (tanh f)
-#else
-    -- hard to do all that in Rationals ?? (WDP 94/10) ToDo
-#endif
+    -- hard to do float ops in Rationals ?? (WDP 94/10) ToDo
     oneFloatLit _          _   = give_up
 
     twoFloatLits FloatGtOp    f1 f2          = return_bool (f1 >  f2)