projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
a94cd72
)
Fixed warnings in vectorise/VectMonad
author
Twan van Laarhoven
<twanvl@gmail.com>
Sun, 3 Feb 2008 22:39:32 +0000
(22:39 +0000)
committer
Twan van Laarhoven
<twanvl@gmail.com>
Sun, 3 Feb 2008 22:39:32 +0000
(22:39 +0000)
compiler/vectorise/VectMonad.hs
patch
|
blob
|
history
diff --git
a/compiler/vectorise/VectMonad.hs
b/compiler/vectorise/VectMonad.hs
index
57f87d3
..
836a020
100644
(file)
--- a/
compiler/vectorise/VectMonad.hs
+++ b/
compiler/vectorise/VectMonad.hs
@@
-1,10
+1,3
@@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module VectMonad (
Scope(..),
VM,
module VectMonad (
Scope(..),
VM,
@@
-48,30
+41,23
@@
import CoreSyn
import TyCon
import DataCon
import Type
import TyCon
import DataCon
import Type
-import Class
import Var
import VarEnv
import Id
import Var
import VarEnv
import Id
-import OccName
import Name
import NameEnv
import Name
import NameEnv
-import TysPrim ( intPrimTy )
-import Module
-import IfaceEnv
import IOEnv ( liftIO )
import DsMonad
import IOEnv ( liftIO )
import DsMonad
-import PrelNames
import InstEnv
import FamInstEnv
import InstEnv
import FamInstEnv
-import Panic
import Outputable
import FastString
import SrcLoc ( noSrcSpan )
import Outputable
import FastString
import SrcLoc ( noSrcSpan )
-import Control.Monad ( liftM, zipWithM )
+import Control.Monad
data Scope a b = Global a | Local b
data Scope a b = Global a | Local b
@@
-183,6
+169,7
@@
setBoxedTyConsEnv :: [(Name, TyCon)] -> GlobalEnv -> GlobalEnv
setBoxedTyConsEnv ps genv
= genv { global_boxed_tycons = mkNameEnv ps }
setBoxedTyConsEnv ps genv
= genv { global_boxed_tycons = mkNameEnv ps }
+emptyLocalEnv :: LocalEnv
emptyLocalEnv = LocalEnv {
local_vars = emptyVarEnv
, local_tyvars = []
emptyLocalEnv = LocalEnv {
local_vars = emptyVarEnv
, local_tyvars = []
@@
-210,7
+197,7
@@
data VResult a = Yes GlobalEnv LocalEnv a | No
newtype VM a = VM { runVM :: Builtins -> GlobalEnv -> LocalEnv -> DsM (VResult a) }
instance Monad VM where
newtype VM a = VM { runVM :: Builtins -> GlobalEnv -> LocalEnv -> DsM (VResult a) }
instance Monad VM where
- return x = VM $ \bi genv lenv -> return (Yes genv lenv x)
+ return x = VM $ \_ genv lenv -> return (Yes genv lenv x)
VM p >>= f = VM $ \bi genv lenv -> do
r <- p bi genv lenv
case r of
VM p >>= f = VM $ \bi genv lenv -> do
r <- p bi genv lenv
case r of
@@
-241,9
+228,10
@@
orElseV :: VM a -> VM a -> VM a
orElseV p q = maybe q return =<< tryV p
fixV :: (a -> VM a) -> VM a
orElseV p q = maybe q return =<< tryV p
fixV :: (a -> VM a) -> VM a
-fixV f = VM (\bi genv lenv -> fixDs $ \r -> runVM (f (unYes r)) bi genv lenv )
- where
- unYes (Yes _ _ x) = x
+fixV f = VM $ \bi genv lenv -> fixDs $
+ \r -> case r of
+ Yes _ _ x -> runVM (f x) bi genv lenv
+ No -> return No
localV :: VM a -> VM a
localV p = do
localV :: VM a -> VM a
localV p = do
@@
-261,7
+249,7
@@
closedV p = do
return x
liftDs :: DsM a -> VM a
return x
liftDs :: DsM a -> VM a
-liftDs p = VM $ \bi genv lenv -> do { x <- p; return (Yes genv lenv x) }
+liftDs p = VM $ \_ genv lenv -> do { x <- p; return (Yes genv lenv x) }
builtin :: (Builtins -> a) -> VM a
builtin f = VM $ \bi genv lenv -> return (Yes genv lenv (f bi))
builtin :: (Builtins -> a) -> VM a
builtin f = VM $ \bi genv lenv -> return (Yes genv lenv (f bi))
@@
-270,7
+258,7
@@
builtins :: (a -> Builtins -> b) -> VM (a -> b)
builtins f = VM $ \bi genv lenv -> return (Yes genv lenv (`f` bi))
readGEnv :: (GlobalEnv -> a) -> VM a
builtins f = VM $ \bi genv lenv -> return (Yes genv lenv (`f` bi))
readGEnv :: (GlobalEnv -> a) -> VM a
-readGEnv f = VM $ \bi genv lenv -> return (Yes genv lenv (f genv))
+readGEnv f = VM $ \_ genv lenv -> return (Yes genv lenv (f genv))
setGEnv :: GlobalEnv -> VM ()
setGEnv genv = VM $ \_ _ lenv -> return (Yes genv lenv ())
setGEnv :: GlobalEnv -> VM ()
setGEnv genv = VM $ \_ _ lenv -> return (Yes genv lenv ())
@@
-279,7
+267,7
@@
updGEnv :: (GlobalEnv -> GlobalEnv) -> VM ()
updGEnv f = VM $ \_ genv lenv -> return (Yes (f genv) lenv ())
readLEnv :: (LocalEnv -> a) -> VM a
updGEnv f = VM $ \_ genv lenv -> return (Yes (f genv) lenv ())
readLEnv :: (LocalEnv -> a) -> VM a
-readLEnv f = VM $ \bi genv lenv -> return (Yes genv lenv (f lenv))
+readLEnv f = VM $ \_ genv lenv -> return (Yes genv lenv (f lenv))
setLEnv :: LocalEnv -> VM ()
setLEnv lenv = VM $ \_ genv _ -> return (Yes genv lenv ())
setLEnv :: LocalEnv -> VM ()
setLEnv lenv = VM $ \_ genv _ -> return (Yes genv lenv ())
@@
-287,8
+275,10
@@
setLEnv lenv = VM $ \_ genv _ -> return (Yes genv lenv ())
updLEnv :: (LocalEnv -> LocalEnv) -> VM ()
updLEnv f = VM $ \_ genv lenv -> return (Yes genv (f lenv) ())
updLEnv :: (LocalEnv -> LocalEnv) -> VM ()
updLEnv f = VM $ \_ genv lenv -> return (Yes genv (f lenv) ())
+{-
getInstEnv :: VM (InstEnv, InstEnv)
getInstEnv = readGEnv global_inst_env
getInstEnv :: VM (InstEnv, InstEnv)
getInstEnv = readGEnv global_inst_env
+-}
getFamInstEnv :: VM FamInstEnvs
getFamInstEnv = readGEnv global_fam_inst_env
getFamInstEnv :: VM FamInstEnvs
getFamInstEnv = readGEnv global_fam_inst_env