(i1 + i2) only if it results in a valid Float.
\begin{code}
-#include "HsVersions.h"
-
module ConFold ( completePrim ) where
-import Ubiq{-uitous-}
+#include "HsVersions.h"
import CoreSyn
-import CoreUnfold ( UnfoldingDetails(..), FormSummary(..) )
+import CoreUnfold ( Unfolding )
import Id ( idType )
import Literal ( mkMachInt, mkMachWord, Literal(..) )
-import MagicUFs ( MagicUnfoldingFun )
-import PrelInfo ( trueDataCon, falseDataCon )
import PrimOp ( PrimOp(..) )
import SimplEnv
import SimplMonad
+import SimplUtils ( newId )
+import TysWiredIn ( trueDataCon, falseDataCon )
+
+import Char ( ord, chr )
\end{code}
\begin{code}
= returnSmpl (Lit (mkMachInt 1))
completePrim env op@SeqOp args@[TyArg ty, VarArg var]
- = case (lookupUnfolding env var) of
- NoUnfoldingDetails -> give_up
- LitForm _ -> hooray
- OtherLitForm _ -> hooray
- ConForm _ _ -> hooray
- OtherConForm _ -> hooray
- GenForm _ WhnfForm _ _ -> hooray
- _ -> give_up
- where
- give_up = returnSmpl (Prim op args)
- hooray = returnSmpl (Lit (mkMachInt 1))
+ | 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}
--------- 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)