Commit 0097441d authored by Kai-Oliver Prott's avatar Kai-Oliver Prott

Fix some hlint warnings

parent ac4c0598
......@@ -88,12 +88,12 @@ predefTopEnv k v (TopEnv env) = case Map.lookup k env of
-- |Insert an 'Entity' as unqualified into a 'TopEnv'
importTopEnv :: Entity a => ModuleIdent -> Ident -> a -> TopEnv a
-> TopEnv a
importTopEnv m x y env = addImport m (qualify x) y env
importTopEnv m x = addImport m (qualify x)
-- |Insert an 'Entity' as qualified into a 'TopEnv'
qualImportTopEnv :: Entity a => ModuleIdent -> Ident -> a -> TopEnv a
-> TopEnv a
qualImportTopEnv m x y env = addImport m (qualifyWith m x) y env
qualImportTopEnv m x = addImport m (qualifyWith m x)
-- local helper
addImport :: Entity a => ModuleIdent -> QualIdent -> a -> TopEnv a
......@@ -109,7 +109,7 @@ addImport m k v (TopEnv env) = TopEnv $
Nothing -> imp : mergeImport y xs
bindTopEnv :: Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv x y env = qualBindTopEnv (qualify x) y env
bindTopEnv x = qualBindTopEnv (qualify x)
qualBindTopEnv :: QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv x y (TopEnv env)
......
......@@ -208,8 +208,8 @@ checkTypeAll tc = do
checkModule :: ModuleIdent -> ECM ()
checkModule em = do
isLocal <- (em ==) <$> getModuleIdent
isForeign <- (Set.member em) <$> getImportedModules
isLocal <- (==) em <$> getModuleIdent
isForeign <- Set.member em <$> getImportedModules
unless (isLocal || isForeign) $ report $ errModuleNotImported em
-- Check whether two entities of the same kind (type or constructor/function)
......@@ -242,7 +242,7 @@ checkNonUniqueness es = map errMultipleType (findMultiples types )
expand :: ModuleIdent -> AliasEnv -> TCEnv -> ValueEnv -> Maybe ExportSpec
-> [Export]
expand m aEnv tcEnv tyEnv spec
= fst $ runECM ((joinExports . canonExports tcEnv) <$> expandSpec spec)
= fst $ runECM (joinExports . canonExports tcEnv <$> expandSpec spec)
m aEnv tcEnv tyEnv
-- While checking all export specifications, the compiler expands
......@@ -314,8 +314,8 @@ expandTypeAll tc = do
expandModule :: ModuleIdent -> ECM [Export]
expandModule em = do
isLocal <- (em ==) <$> getModuleIdent
isForeign <- (Set.member em) <$> getImportedModules
isLocal <- (==) em <$> getModuleIdent
isForeign <- Set.member em <$> getImportedModules
locals <- if isLocal then expandLocalModule else return []
foreigns <- if isForeign then expandImportedModule em else return []
return $ locals ++ foreigns
......@@ -381,7 +381,7 @@ canonLabels tcEnv es = foldr bindLabels Map.empty (allEntities tcEnv)
tcs = [tc | ExportTypeWith _ tc _ <- es]
bindLabels t ls
| tc' `elem` tcs = foldr (bindLabel tc') ls (elements t)
| otherwise = ls
| otherwise = ls
where
tc' = origName t
bindLabel tc x =
......@@ -424,7 +424,7 @@ elements (TypeVar _) =
-- get visible constructor and label identifiers for given constructor
visibleElems :: [DataConstr] -> [Ident]
visibleElems cs = map constrIdent cs ++ (nub (concatMap recLabels cs))
visibleElems cs = map constrIdent cs ++ nub (concatMap recLabels cs)
-- get class method names
visibleMethods :: [ClassMethod] -> [Ident]
......@@ -469,10 +469,10 @@ errNonDataTypeOrTypeClass tc = posMessage tc $ hsep $ map text
[escQualName tc, "is not a data type or type class"]
errOutsideTypeConstructor :: QualIdent -> QualIdent -> Message
errOutsideTypeConstructor c tc = errOutsideTypeExport "Data constructor" c tc
errOutsideTypeConstructor = errOutsideTypeExport "Data constructor"
errOutsideTypeLabel :: QualIdent -> QualIdent -> Message
errOutsideTypeLabel l tc = errOutsideTypeExport "Label" l tc
errOutsideTypeLabel = errOutsideTypeExport "Label"
errOutsideTypeExport :: String -> QualIdent -> QualIdent -> Message
errOutsideTypeExport what q tc = posMessage q
......
......@@ -1097,7 +1097,7 @@ checkFieldLabel l = do
[RecordLabel _ cs] -> processLabel cs
rs -> case qualLookupVar (qualQualify m l) env of
[RecordLabel _ cs] -> processLabel cs
rs' -> if (null rs && null rs')
rs' -> if null rs && null rs'
then do report $ errUndefinedLabel l
return []
else do report $
......
......@@ -22,7 +22,6 @@
information. On import two values are considered equal if their original
names match.
-}
{-# LANGUAGE CPP #-}
module Env.Value
( ValueEnv, ValueInfo (..)
, bindGlobalInfo, bindFun, qualBindFun, rebindFun, unbindFun
......@@ -31,9 +30,8 @@ module Env.Value
, ValueType (..), bindLocalVars, bindLocalVar
) where
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif
import Control.Monad (zipWithM)
import Curry.Base.Ident
import Curry.Base.Pretty (Pretty(..))
......@@ -67,7 +65,7 @@ instance Entity ValueInfo where
merge (DataConstructor c1 ar1 ls1 ty1) (DataConstructor c2 ar2 ls2 ty2)
| c1 == c2 && ar1 == ar2 && ty1 == ty2 = do
ls' <- sequence (zipWith mergeLabel ls1 ls2)
ls' <- zipWithM mergeLabel ls1 ls2
Just (DataConstructor c1 ar1 ls' ty1)
merge (NewtypeConstructor c1 l1 ty1) (NewtypeConstructor c2 l2 ty2)
| c1 == c2 && ty1 == ty2 = do
......
......@@ -148,7 +148,7 @@ getNextId = do
-- Create a fresh variable ident for a given prefix with a monomorphic type
freshVar :: Typeable t => String -> t -> DsM (Type, Ident)
freshVar prefix t = do
v <- (mkIdent . (prefix ++) . show) <$> getNextId
v <- mkIdent . (prefix ++) . show <$> getNextId
return (typeOf t, v)
-- ---------------------------------------------------------------------------
......@@ -308,7 +308,7 @@ dsRhs f rhs = expandRhs (prelFailed (typeOf rhs)) f rhs
expandRhs :: Expression Type -> (Expression Type -> Expression Type)
-> Rhs Type -> DsM (Expression Type)
expandRhs _ f (SimpleRhs _ e ds) = return $ Let NoSpanInfo ds (f e)
expandRhs e0 f (GuardedRhs _ es ds) = (Let NoSpanInfo ds . f)
expandRhs e0 f (GuardedRhs _ es ds) = Let NoSpanInfo ds . f
<$> expandGuards e0 es
expandGuards :: Expression Type -> [CondExpr Type]
......@@ -497,7 +497,7 @@ genFPExpr p vs bs
in (t' =:<= mkVar pty v) : es
cs = concatMap mkLB bs
free = nub $ filter (not . isAnonId . fst3) $
concatMap patternVars (map fst bs) \\ vs
concatMap (patternVars . fst) bs \\ vs
fp2Expr :: Pattern Type -> (Expression Type, [Expression Type])
fp2Expr (LiteralPattern _ pty l) = (Literal NoSpanInfo pty l, [])
......@@ -506,7 +506,7 @@ fp2Expr (NegativePattern _ pty l) =
fp2Expr (VariablePattern _ pty v) = (mkVar pty v, [])
fp2Expr (ConstructorPattern _ pty c ts) =
let (ts', ess) = unzip $ map fp2Expr ts
pty' = foldr TypeArrow (unpredType pty) $ map typeOf ts
pty' = foldr (TypeArrow . typeOf) (unpredType pty) ts
in (apply (Constructor NoSpanInfo pty' c) ts', concat ess)
fp2Expr (InfixPattern _ pty t1 op t2) =
let (t1', es1) = fp2Expr t1
......@@ -522,12 +522,12 @@ fp2Expr (ListPattern _ pty ts) =
in (List NoSpanInfo pty ts', concat ess)
fp2Expr (FunctionPattern _ pty f ts) =
let (ts', ess) = unzip $ map fp2Expr ts
pty' = foldr TypeArrow (unpredType pty) $ map typeOf ts
pty' = foldr (TypeArrow . typeOf) (unpredType pty) ts
in (apply (Variable NoSpanInfo pty' f) ts', concat ess)
fp2Expr (InfixFuncPattern _ pty t1 op t2) =
let (t1', es1) = fp2Expr t1
(t2', es2) = fp2Expr t2
pty' = foldr TypeArrow (unpredType pty) $ map typeOf [t1, t2]
pty' = foldr (TypeArrow . typeOf) (unpredType pty) [t1, t2]
in (InfixApply NoSpanInfo t1' (InfixOp pty' op) t2', es1 ++ es2)
fp2Expr (AsPattern _ v t) =
let (t', es) = fp2Expr t
......@@ -668,7 +668,7 @@ dsExpr p (Record _ pty c fs) = do
let (ls, tys) = argumentTypes (unpredType pty) c vEnv
esMap = map field2Tuple fs
unknownEs = map prelUnknown tys
maybeEs = map (flip lookup esMap) ls
maybeEs = map (`lookup` esMap) ls
es = zipWith fromMaybe unknownEs maybeEs
dsExpr p (applyConstr pty c tys es)
dsExpr p (RecordUpdate _ e fs) = do
......@@ -677,7 +677,7 @@ dsExpr p (RecordUpdate _ e fs) = do
where ty = typeOf e
tc = rootOfType (arrowBase ty)
updateAlt (RecordConstr c ls _)
| all (`elem` qls2) (map fieldLabel fs)= do
| all (`elem` qls2) (map fieldLabel fs) = do
let qc = qualifyLike tc c
vEnv <- getValueEnv
let (qls, tys) = argumentTypes ty qc vEnv
......@@ -685,7 +685,7 @@ dsExpr p (RecordUpdate _ e fs) = do
let pat = constrPattern ty qc vs
esMap = map field2Tuple fs
originalEs = map (uncurry mkVar) vs
maybeEs = map (flip lookup esMap) qls
maybeEs = map (`lookup` esMap) qls
es = zipWith fromMaybe originalEs maybeEs
return [(pat, applyConstr ty qc tys es)]
where qls2 = map (qualifyLike tc) ls
......@@ -697,7 +697,7 @@ dsExpr p (Tuple _ es) =
tys = map typeOf es
dsExpr p (List _ pty es) = dsList cons nil <$> mapM (dsExpr p) es
where nil = Constructor NoSpanInfo pty qNilId
cons = (Apply NoSpanInfo) . (Apply NoSpanInfo)
cons = Apply NoSpanInfo . Apply NoSpanInfo
(Constructor NoSpanInfo
(consType $ elemType $ unpredType pty) qConsId)
dsExpr p (ListCompr _ e qs) = dsListComp p e qs
......@@ -946,7 +946,7 @@ dsQual p (StmtBind _ t l) e
append e1 l1 =
apply (prelAppend (elemType $ typeOf e1)) [e1, l1]
prelCons ty =
Constructor NoSpanInfo (consType ty) $ qConsId
Constructor NoSpanInfo (consType ty) qConsId
-- -----------------------------------------------------------------------------
-- Desugaring of Lists, labels, fields, and literals
......
......@@ -22,13 +22,13 @@
{-# LANGUAGE CPP #-}
module TestFrontend (tests) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Prelude hiding (fail)
import qualified Control.Exception as E (SomeException, catch)
import Data.List (isInfixOf, sort)
import Distribution.TestSuite
import Distribution.TestSuite ( Test (..), TestInstance (..)
, Progress (..), Result (..)
, OptionDescr)
import System.FilePath (FilePath, (</>), (<.>))
import Curry.Base.Message (Message, message, ppMessages, ppError)
......@@ -36,7 +36,7 @@ import Curry.Base.Monad (CYIO, runCYIO)
import Curry.Base.Pretty (text)
import qualified CompilerOpts as CO ( Options (..), WarnOpts (..)
, WarnFlag (..), Verbosity (VerbQuiet)
, defaultOptions, defaultWarnOpts)
, defaultOptions)
import CurryBuilder (buildCurry)
tests :: IO [Test]
......@@ -135,7 +135,7 @@ type SetOption = String -> String -> Either String TestInstance
-- generate a simple passing test
mkPassTest :: String -> TestInfo
mkPassTest name = (name, [], [], Nothing, [])
mkPassTest = flip mkFailTest []
-- To add a passing test to the test suite simply add the module name of the
-- test code to the following list
......@@ -198,7 +198,7 @@ passInfos = map mkPassTest
-- generate a simple failing test
mkFailTest :: String -> [String] -> TestInfo
mkFailTest name errorMsgs = (name, [], [], Nothing, errorMsgs)
mkFailTest n errorMsgs = (n, [], [], Nothing, errorMsgs)
-- To add a failing test to the test suite simply add the module name of the
-- test code and the expected error message(s) to the following list
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment