Make FloatIn warning-free

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

diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs
index 26d19bb..4265efb 100644 (file)
--- a/compiler/simplCore/SimplMonad.lhs
+++ b/compiler/simplCore/SimplMonad.lhs
@@ -14,8 +14,7 @@
 module SimplMonad (
        -- The monad
        SimplM,
-       initSmpl, returnSmpl, thenSmpl, thenSmpl_,
-       mapSmpl, mapAndUnzipSmpl, mapAccumLSmpl,
+       initSmpl,
        getDOptsSmpl, getRules, getFamEnvs,
 
         -- Unique supply
@@ -32,8 +31,6 @@ module SimplMonad (
        isAmongSimpl, intSwitchSet, switchIsOn
     ) where
 
-#include "HsVersions.h"
-
 import Id              ( Id, mkSysLocal )
 import Type             ( Type )
 import FamInstEnv      ( FamInstEnv )
@@ -44,14 +41,12 @@ import StaticFlags  ( opt_PprStyle_Debug, opt_HistorySize )
 import Unique          ( Unique )
 import Maybes          ( expectJust )
 import FiniteMap       ( FiniteMap, emptyFM, isEmptyFM, lookupFM, addToFM, plusFM_C, fmToList )
-import FastString      ( FastString )
+import FastString
 import Outputable
 import FastTypes
 
 import Data.Array
 import Data.Array.Base (unsafeAt)
-
-infixr 0  `thenSmpl`, `thenSmpl_`
 \end{code}
 
 %************************************************************************
@@ -112,30 +107,11 @@ thenSmpl_ m k
   = SM (\st_env us0 sc0 ->
         case (unSM m st_env us0 sc0) of 
                (_, us1, sc1) -> unSM k st_env us1 sc1)
-\end{code}
 
-
-\begin{code}
-mapSmpl                :: (a -> SimplM b) -> [a] -> SimplM [b]
-mapAndUnzipSmpl :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c])
-
-mapSmpl f [] = returnSmpl []
-mapSmpl f (x:xs)
-  = f x                    `thenSmpl` \ x'  ->
-    mapSmpl f xs    `thenSmpl` \ xs' ->
-    returnSmpl (x':xs')
-
-mapAndUnzipSmpl f [] = returnSmpl ([],[])
-mapAndUnzipSmpl f (x:xs)
-  = f x                            `thenSmpl` \ (r1,  r2)  ->
-    mapAndUnzipSmpl f xs    `thenSmpl` \ (rs1, rs2) ->
-    returnSmpl (r1:rs1, r2:rs2)
-
-mapAccumLSmpl :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c])
-mapAccumLSmpl f acc []     = returnSmpl (acc, [])
-mapAccumLSmpl f acc (x:xs) = f acc x   `thenSmpl` \ (acc', x') ->
-                            mapAccumLSmpl f acc' xs    `thenSmpl` \ (acc'', xs') ->
-                            returnSmpl (acc'', x':xs')
+-- TODO: this specializing is not allowed
+{-# -- SPECIALIZE mapM         :: (a -> SimplM b) -> [a] -> SimplM [b] #-}
+{-# -- SPECIALIZE mapAndUnzipM :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c]) #-}
+{-# -- SPECIALIZE mapAccumLM   :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c]) #-}
 \end{code}
 
 
@@ -276,15 +252,15 @@ plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 })
 plusSimplCount VerySimplZero VerySimplZero = VerySimplZero
 plusSimplCount sc1          sc2           = VerySimplNonZero
 
-pprSimplCount VerySimplZero    = ptext SLIT("Total ticks: ZERO!")
-pprSimplCount VerySimplNonZero = ptext SLIT("Total ticks: NON-ZERO!")
+pprSimplCount VerySimplZero    = ptext (sLit "Total ticks: ZERO!")
+pprSimplCount VerySimplNonZero = ptext (sLit "Total ticks: NON-ZERO!")
 pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
-  = vcat [ptext SLIT("Total ticks:    ") <+> int tks,
+  = vcat [ptext (sLit "Total ticks:    ") <+> int tks,
          text "",
          pprTickCounts (fmToList dts),
          if verboseSimplStats then
                vcat [text "",
-                     ptext SLIT("Log (most recent first)"),
+                     ptext (sLit "Log (most recent first)"),
                      nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]
          else empty
     ]