WarnCheck.hs 26.7 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
{- |
    Module      :  $Header$
    Description :  Checks for irregular code
    Copyright   :  (c) 2006, Martin Engelke (men@informatik.uni-kiel.de)
                       2011, Björn Peemöller (bjp@informatik.uni-kiel.de)
    License     :  OtherLicense

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module searches for potentially irregular code and generates
    warning messages.
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
14
-}
Björn Peemöller 's avatar
Björn Peemöller committed
15
module Checks.WarnCheck (warnCheck) where
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
16

17
import Control.Monad.State (State, execState, filterM, gets, modify, unless, when, foldM_)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
18
19
20
21
22
23
24
25
import qualified Data.Map as Map (empty, insert, lookup)
import Data.List (intersect, intersectBy, unionBy)

import Curry.Base.Ident
import Curry.Base.Position
import Curry.Base.MessageMonad
import Curry.Syntax

Björn Peemöller 's avatar
Björn Peemöller committed
26
27
import qualified Base.ScopeEnv as ScopeEnv

Björn Peemöller 's avatar
Björn Peemöller committed
28
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
29
30


Björn Peemöller 's avatar
Björn Peemöller committed
31
-- Current state of generating warnings
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
32
data CState = CState
33
  { messages  :: [Message]
Björn Peemöller 's avatar
Björn Peemöller committed
34
  , scope     :: ScopeEnv.ScopeEnv QualIdent IdInfo
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
35
36
37
38
  , values    :: ValueEnv
  , moduleId  :: ModuleIdent
  }

Björn Peemöller 's avatar
Björn Peemöller committed
39
40
41
42
43
-- The monadic representation of the state allows the usage of monadic
-- syntax (do expression) for dealing easier and safer with its
-- contents.
type CheckM = State CState

44
45
initCState :: ModuleIdent -> ValueEnv -> CState
initCState mid valueEnv = CState [] ScopeEnv.new valueEnv mid
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
46

Björn Peemöller 's avatar
Björn Peemöller committed
47
48
49
50
checked :: CheckM ()
checked = return ()

-- |Run a 'CheckM' action and return the list of messages
51
52
runOn :: CState -> CheckM a -> [Message]
runOn s f = reverse $ messages $ execState f s
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
53
54
55
56
57
58
59
60

-- Find potentially incorrect code in a Curry program and generate
-- the following warnings for:
--    - unreferenced variables
--    - shadowing variables
--    - idle case alternatives
--    - overlapping case alternatives
--    - function rules which are not together
61
warnCheck :: ModuleIdent -> ValueEnv -> [ImportDecl] -> [Decl] -> [Message]
62
63
64
65
warnCheck mid vals imports decls = runOn (initCState mid vals) $ do
  checkForMultipleImports imports
  mapM_ insertDecl decls
  mapM_ (checkDecl mid) decls
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
66
67
  checkDeclOccurrences decls

68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
-- ---------------------------------------------------------------------------
-- checkForMultipleImports
-- ---------------------------------------------------------------------------

-- check import declarations for multiply imported modules
--
-- The function uses a map of the already imported or hidden entities to
-- collect the entities throughout multiple import statements.
checkForMultipleImports :: [ImportDecl] -> CheckM ()
checkForMultipleImports imps = foldM_ checkImport Map.empty imps
  where
  checkImport env (ImportDecl pos mid _ _ spec) = case Map.lookup mid env of
    Nothing   -> setImportSpec env mid $ fromImpSpec spec
    Just ishs -> checkImportSpec env pos mid ishs spec

  checkImportSpec env _ mid (_, _) Nothing = do
    genWarning' $ multiplyImportedModule mid
    return env

  checkImportSpec env _ mid (is, hs) (Just (Importing _ is'))
    | null is && any (`notElem` hs) is' = do
        genWarning' $ multiplyImportedModule mid
        setImportSpec env mid (is', hs)
    | null iis  = setImportSpec env mid (is' ++ is, hs)
    | otherwise = do
        mapM_ (genWarning' . (multiplyImportedSymbol mid) . impName) iis
        setImportSpec env mid (unionBy cmpImport is' is, hs)
    where iis = intersectBy cmpImport is' is

  checkImportSpec env _ mid (is, hs) (Just (Hiding _ hs'))
    | null ihs  = setImportSpec env mid (is, hs' ++ hs)
    | otherwise = do
      mapM_ (genWarning' . (multiplyHiddenSymbol mid) . impName) ihs
      setImportSpec env mid (is, unionBy cmpImport hs' hs)
    where ihs = intersectBy cmpImport hs' hs

  fromImpSpec Nothing                 = ([], [])
  fromImpSpec (Just (Importing _ is)) = (is, [])
  fromImpSpec (Just (Hiding    _ hs)) = ([], hs)

  setImportSpec env mid ishs = return $ Map.insert mid ishs env

  cmpImport (ImportTypeWith id1 cs1) (ImportTypeWith id2 cs2)
    = id1 == id2 && null (intersect cs1 cs2)
  cmpImport i1 i2 = (impName i1) == (impName i2)

  impName (Import           ident) = ident
  impName (ImportTypeAll    ident) = ident
  impName (ImportTypeWith ident _) = ident

-- ---------------------------------------------------------------------------
-- checkDeclOccurrences
-- ---------------------------------------------------------------------------

-- Find function rules which are not together
checkDeclOccurrences :: [Decl] -> CheckM ()
checkDeclOccurrences decls = foldM_ checkDO (mkIdent "", Map.empty) decls
  where
  checkDO (prevId, env) (FunctionDecl pos ident _) = do
    c <- isConsId ident
    if c || prevId == ident
      then return (ident, env)
      else case Map.lookup ident env of
        Nothing   -> return (ident, Map.insert ident pos env)
        Just pos' -> do
          genWarning' $ rulesNotTogether ident pos'
          return (ident, env)
  checkDO (_, env) _ = return (mkIdent "", env)

-- ---------------------------------------------------------------------------
-- do something else
-- ---------------------------------------------------------------------------
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
140
141

--
Björn Peemöller 's avatar
Björn Peemöller committed
142
143
checkDecl :: ModuleIdent -> Decl -> CheckM ()
checkDecl mid (DataDecl _ _ params cdecls) = withScope $ do
144
145
  mapM_ insertTypeVar params
  mapM_ (checkConstrDecl mid) cdecls
Björn Peemöller 's avatar
Björn Peemöller committed
146
  params' <- filterM isUnrefTypeVar params
147
  when (not $ null params') $ mapM_ genWarning' $ map unrefTypeVar params'
Björn Peemöller 's avatar
Björn Peemöller committed
148
checkDecl mid (TypeDecl _ _ params texpr) = withScope $ do
149
  mapM_ insertTypeVar params
Björn Peemöller 's avatar
Björn Peemöller committed
150
151
  checkTypeExpr mid texpr
  params' <- filterM isUnrefTypeVar params
152
  when (not $ null params') $ mapM_ genWarning' $ map unrefTypeVar params'
Björn Peemöller 's avatar
Björn Peemöller committed
153
checkDecl mid (FunctionDecl _ ident equs) = withScope $ do
154
  mapM_ (checkEquation mid) equs
Björn Peemöller 's avatar
Björn Peemöller committed
155
156
  c <- isConsId ident
  idents' <- returnUnrefVars
157
  when (not $ c || null idents') $ mapM_ genWarning' $ map unrefVar idents'
Björn Peemöller 's avatar
Björn Peemöller committed
158
159
160
161
checkDecl mid (PatternDecl _ cterm rhs) = do
  checkConstrTerm mid cterm
  checkRhs mid rhs
checkDecl _ _ = checked
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
162
163
164

-- Checks locally declared identifiers (i.e. functions and logic variables)
-- for shadowing
Björn Peemöller 's avatar
Björn Peemöller committed
165
166
167
168
169
170
checkLocalDecl :: Decl -> CheckM ()
checkLocalDecl (FunctionDecl _ ident _) = do
  s <- isShadowingVar ident
  when s $ genWarning' $ shadowingVar ident
checkLocalDecl (ExtraVariables _ idents) = do
  idents' <- filterM isShadowingVar idents
171
  when (not $ null idents') $ mapM_ genWarning' $ map shadowingVar idents'
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
172
checkLocalDecl (PatternDecl _ constrTerm _)
Björn Peemöller 's avatar
Björn Peemöller committed
173
174
175
176
177
178
179
  = checkConstrTerm (mkMIdent []) constrTerm
checkLocalDecl _ = checked

--
checkConstrDecl :: ModuleIdent -> ConstrDecl -> CheckM ()
checkConstrDecl mid (ConstrDecl _ _ ident texprs) = do
  visitId ident
180
  mapM_ (checkTypeExpr mid) texprs
Björn Peemöller 's avatar
Björn Peemöller committed
181
182
183
184
185
186
187
188
189
checkConstrDecl mid (ConOpDecl _ _ texpr1 ident texpr2) = do
  visitId ident
  checkTypeExpr mid texpr1
  checkTypeExpr mid texpr2


checkTypeExpr :: ModuleIdent -> TypeExpr -> CheckM ()
checkTypeExpr mid (ConstructorType qid texprs) = do
  maybe checked visitTypeId (localIdent mid qid)
190
  mapM_ (checkTypeExpr mid) texprs
Björn Peemöller 's avatar
Björn Peemöller committed
191
192
193
checkTypeExpr _   (VariableType ident)
  = visitTypeId ident
checkTypeExpr mid (TupleType texprs)
194
  = mapM_ (checkTypeExpr mid) texprs
Björn Peemöller 's avatar
Björn Peemöller committed
195
196
197
198
199
200
checkTypeExpr mid (ListType texpr)
  = checkTypeExpr mid texpr
checkTypeExpr mid (ArrowType texpr1 texpr2) = do
  checkTypeExpr mid texpr1
  checkTypeExpr mid texpr2
checkTypeExpr mid (RecordType fields restr) = do
201
  mapM_ (checkTypeExpr mid ) (map snd fields)
Björn Peemöller 's avatar
Björn Peemöller committed
202
203
204
205
206
207
208
209
210
211
212
213
  maybe checked (checkTypeExpr mid) restr

--
checkEquation :: ModuleIdent -> Equation -> CheckM ()
checkEquation mid (Equation _ lhs rhs) = do
  checkLhs mid lhs
  checkRhs mid rhs

--
checkLhs :: ModuleIdent -> Lhs -> CheckM ()
checkLhs mid (FunLhs ident cterms) = do
  visitId ident
214
215
  mapM_ (checkConstrTerm mid) cterms
  mapM_ (insertConstrTerm False) cterms
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
216
checkLhs mid (OpLhs cterm1 ident cterm2)
Björn Peemöller 's avatar
Björn Peemöller committed
217
218
219
  = checkLhs mid (FunLhs ident [cterm1, cterm2])
checkLhs mid (ApLhs lhs cterms) = do
  checkLhs mid lhs
220
221
  mapM_ (checkConstrTerm mid ) cterms
  mapM_ (insertConstrTerm False) cterms
Björn Peemöller 's avatar
Björn Peemöller committed
222
223
224
225

--
checkRhs :: ModuleIdent -> Rhs -> CheckM ()
checkRhs mid (SimpleRhs _ expr decls) = withScope $ do -- function arguments can be overwritten by local decls
226
227
228
  mapM_ checkLocalDecl decls
  mapM_ insertDecl decls
  mapM_ (checkDecl mid) decls
Björn Peemöller 's avatar
Björn Peemöller committed
229
230
231
  checkDeclOccurrences decls
  checkExpression mid expr
  idents' <- returnUnrefVars
232
  when (not $ null idents') $ mapM_ genWarning' $ map unrefVar idents'
Björn Peemöller 's avatar
Björn Peemöller committed
233
checkRhs mid (GuardedRhs cexprs decls) = withScope $ do
234
235
236
  mapM_ checkLocalDecl decls
  mapM_ insertDecl decls
  mapM_ (checkDecl mid) decls
Björn Peemöller 's avatar
Björn Peemöller committed
237
  checkDeclOccurrences decls
238
  mapM_ (checkCondExpr mid) cexprs
Björn Peemöller 's avatar
Björn Peemöller committed
239
  idents' <- returnUnrefVars
240
  when (not $ null idents') $  mapM_ genWarning' $ map unrefVar idents'
Björn Peemöller 's avatar
Björn Peemöller committed
241
242
243
244
245
246
247
248
249
250
251
252

--
checkCondExpr :: ModuleIdent -> CondExpr -> CheckM ()
checkCondExpr mid (CondExpr _ cond expr) = do
  checkExpression mid cond
  checkExpression mid expr

--
checkConstrTerm :: ModuleIdent -> ConstrTerm -> CheckM ()
checkConstrTerm _ (VariablePattern ident) = do
  s <- isShadowingVar ident
  when s $ genWarning' $ shadowingVar ident
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
253
checkConstrTerm mid (ConstructorPattern _ cterms)
254
  = mapM_ (checkConstrTerm mid ) cterms
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
255
checkConstrTerm mid (InfixPattern cterm1 qident cterm2)
Björn Peemöller 's avatar
Björn Peemöller committed
256
  = checkConstrTerm mid (ConstructorPattern qident [cterm1, cterm2])
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
257
checkConstrTerm mid (ParenPattern cterm)
Björn Peemöller 's avatar
Björn Peemöller committed
258
  = checkConstrTerm mid cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
259
checkConstrTerm mid (TuplePattern _ cterms)
260
  = mapM_ (checkConstrTerm mid ) cterms
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
261
checkConstrTerm mid (ListPattern _ cterms)
262
  = mapM_ (checkConstrTerm mid ) cterms
Björn Peemöller 's avatar
Björn Peemöller committed
263
264
265
266
checkConstrTerm mid (AsPattern ident cterm) = do
  s <- isShadowingVar ident
  when s $ genWarning' $ shadowingVar ident
  checkConstrTerm mid cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
267
checkConstrTerm mid (LazyPattern _ cterm)
Björn Peemöller 's avatar
Björn Peemöller committed
268
  = checkConstrTerm mid cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
269
checkConstrTerm mid (FunctionPattern _ cterms)
270
  = mapM_ (checkConstrTerm mid ) cterms
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
271
checkConstrTerm mid  (InfixFuncPattern cterm1 qident cterm2)
Björn Peemöller 's avatar
Björn Peemöller committed
272
273
  = checkConstrTerm mid  (FunctionPattern qident [cterm1, cterm2])
checkConstrTerm mid  (RecordPattern fields restr) = do
274
  mapM_ (checkFieldPattern mid) fields
Björn Peemöller 's avatar
Björn Peemöller committed
275
  maybe checked (checkConstrTerm mid) restr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
276
277
278
checkConstrTerm _ _ = return ()

--
Björn Peemöller 's avatar
Björn Peemöller committed
279
checkExpression :: ModuleIdent -> Expression -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
280
checkExpression mid (Variable qident)
Björn Peemöller 's avatar
Björn Peemöller committed
281
  = maybe (return ()) visitId (localIdent mid qident)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
282
checkExpression mid (Paren expr)
Björn Peemöller 's avatar
Björn Peemöller committed
283
  = checkExpression mid expr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
284
checkExpression mid (Typed expr _)
Björn Peemöller 's avatar
Björn Peemöller committed
285
  = checkExpression mid expr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
286
checkExpression mid (Tuple _ exprs)
287
  = mapM_ (checkExpression mid ) exprs
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
288
checkExpression mid (List _ exprs)
289
  = mapM_ (checkExpression mid ) exprs
Björn Peemöller 's avatar
Björn Peemöller committed
290
checkExpression mid (ListCompr _ expr stmts) = withScope $ do
291
  mapM_ (checkStatement mid) stmts
Björn Peemöller 's avatar
Björn Peemöller committed
292
293
  checkExpression mid expr
  idents' <- returnUnrefVars
294
  when (not $ null idents') $ mapM_ genWarning' $ map unrefVar idents'
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
295
checkExpression mid  (EnumFrom expr)
Björn Peemöller 's avatar
Björn Peemöller committed
296
  = checkExpression mid  expr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
297
checkExpression mid  (EnumFromThen expr1 expr2)
298
  = mapM_ (checkExpression mid ) [expr1, expr2]
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
299
checkExpression mid  (EnumFromTo expr1 expr2)
300
  = mapM_ (checkExpression mid ) [expr1, expr2]
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
301
checkExpression mid  (EnumFromThenTo expr1 expr2 expr3)
302
  = mapM_ (checkExpression mid ) [expr1, expr2, expr3]
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
303
checkExpression mid  (UnaryMinus _ expr)
Björn Peemöller 's avatar
Björn Peemöller committed
304
  = checkExpression mid  expr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
305
checkExpression mid  (Apply expr1 expr2)
306
  = mapM_ (checkExpression mid ) [expr1, expr2]
Björn Peemöller 's avatar
Björn Peemöller committed
307
308
checkExpression mid  (InfixApply expr1 op expr2) = do
  maybe checked (visitId) (localIdent mid (opName op))
309
  mapM_ (checkExpression mid ) [expr1, expr2]
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
310
checkExpression mid  (LeftSection expr _)
Björn Peemöller 's avatar
Björn Peemöller committed
311
  = checkExpression mid  expr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
312
checkExpression mid  (RightSection _ expr)
Björn Peemöller 's avatar
Björn Peemöller committed
313
314
  = checkExpression mid  expr
checkExpression mid  (Lambda _ cterms expr) = withScope $ do
315
316
  mapM_ (checkConstrTerm mid ) cterms
  mapM_ (insertConstrTerm False) cterms
Björn Peemöller 's avatar
Björn Peemöller committed
317
318
  checkExpression mid expr
  idents' <- returnUnrefVars
319
  when (not $ null idents') $ mapM_ genWarning' $ map unrefVar idents'
Björn Peemöller 's avatar
Björn Peemöller committed
320
checkExpression mid  (Let decls expr) = withScope $ do
321
322
323
  mapM_ checkLocalDecl decls
  mapM_ insertDecl decls
  mapM_ (checkDecl mid) decls
Björn Peemöller 's avatar
Björn Peemöller committed
324
325
326
  checkDeclOccurrences decls
  checkExpression mid  expr
  idents' <- returnUnrefVars
327
  when (not $ null idents') $ mapM_ genWarning' $ map unrefVar idents'
Björn Peemöller 's avatar
Björn Peemöller committed
328
checkExpression mid  (Do stmts expr) = withScope $ do
329
  mapM_ (checkStatement mid ) stmts
Björn Peemöller 's avatar
Björn Peemöller committed
330
331
  checkExpression mid  expr
  idents' <- returnUnrefVars
332
  when (not $ null idents') $ mapM_ genWarning' $ map unrefVar idents'
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
333
checkExpression mid  (IfThenElse _ expr1 expr2 expr3)
334
  = mapM_ (checkExpression mid ) [expr1, expr2, expr3]
Björn Peemöller 's avatar
Björn Peemöller committed
335
336
checkExpression mid  (Case _ expr alts) = do
  checkExpression mid  expr
337
  mapM_ (checkAlt mid) alts
Björn Peemöller 's avatar
Björn Peemöller committed
338
  checkCaseAlternatives mid alts
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
339
checkExpression mid (RecordConstr fields)
340
  = mapM_ (checkFieldExpression mid) fields
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
341
checkExpression mid (RecordSelection expr _)
Björn Peemöller 's avatar
Björn Peemöller committed
342
343
  = checkExpression mid expr -- Hier auch "visitId ident" ?
checkExpression mid (RecordUpdate fields expr) = do
344
  mapM_ (checkFieldExpression mid) fields
Björn Peemöller 's avatar
Björn Peemöller committed
345
346
  checkExpression mid expr
checkExpression _ _  = checked
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
347
348

--
Björn Peemöller 's avatar
Björn Peemöller committed
349
350
checkStatement :: ModuleIdent -> Statement -> CheckM ()
checkStatement mid (StmtExpr _ expr)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
351
   = checkExpression mid expr
Björn Peemöller 's avatar
Björn Peemöller committed
352
checkStatement mid (StmtDecl decls) = do
353
354
355
  mapM_ checkLocalDecl decls
  mapM_ insertDecl decls
  mapM_ (checkDecl mid) decls
Björn Peemöller 's avatar
Björn Peemöller committed
356
  checkDeclOccurrences decls
Björn Peemöller 's avatar
Björn Peemöller committed
357
checkStatement mid (StmtBind _ cterm expr) = do
Björn Peemöller 's avatar
Björn Peemöller committed
358
359
360
361
362
363
364
365
366
367
368
  checkConstrTerm mid cterm
  insertConstrTerm False cterm
  checkExpression mid expr

--
checkAlt :: ModuleIdent -> Alt -> CheckM ()
checkAlt mid (Alt _ cterm rhs) = withScope $ do
  checkConstrTerm mid  cterm
  insertConstrTerm False cterm
  checkRhs mid rhs
  idents' <-  returnUnrefVars
369
  when (not $ null idents') $ mapM_ genWarning' $ map unrefVar idents'
Björn Peemöller 's avatar
Björn Peemöller committed
370
371
372
373
374
375
376
377

--
checkFieldExpression :: ModuleIdent -> Field Expression -> CheckM ()
checkFieldExpression mid (Field _ _ expr) = checkExpression mid expr -- Hier auch "visitId ident" ?

--
checkFieldPattern :: ModuleIdent -> Field ConstrTerm -> CheckM ()
checkFieldPattern mid (Field _ _ cterm) = checkConstrTerm mid  cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
378
379

-- Check for idle and overlapping case alternatives
Björn Peemöller 's avatar
Björn Peemöller committed
380
381
382
383
checkCaseAlternatives :: ModuleIdent -> [Alt] -> CheckM ()
checkCaseAlternatives mid alts = do
  checkIdleAlts mid alts
  checkOverlappingAlts mid alts
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
384
385

--
386
-- TODO FIXME this is buggy: is alts' required to be non-null or not? (hsi, bjp)
Björn Peemöller 's avatar
Björn Peemöller committed
387
388
389
390
391
392
checkIdleAlts :: ModuleIdent -> [Alt] -> CheckM ()
checkIdleAlts _ alts = do
  alts' <- dropUnless' isVarAlt alts
  let idles         = tail_ [] alts'
      (Alt pos _ _) = head idles
  unless (null idles) $ genWarning pos idleCaseAlts
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
393
 where
Björn Peemöller 's avatar
Björn Peemöller committed
394
395
396
397
  isVarAlt (Alt _ (VariablePattern ident) _)                = isVarId ident
  isVarAlt (Alt _ (ParenPattern (VariablePattern ident)) _) = isVarId ident
  isVarAlt (Alt _ (AsPattern _ (VariablePattern ident)) _)  = isVarId ident
  isVarAlt _ = return False
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
398

399
400
401
402
403
  -- safer versions of 'tail' and 'head'
  tail_ :: [a] -> [a] -> [a]
  tail_ alt []     = alt
  tail_ _   (_:xs) = xs

Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
404
--
Björn Peemöller 's avatar
Björn Peemöller committed
405
checkOverlappingAlts :: ModuleIdent -> [Alt] -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
406
checkOverlappingAlts _ [] = return ()
Björn Peemöller 's avatar
Björn Peemöller committed
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
checkOverlappingAlts mid (alt : alts) = do
  (altsr, alts') <- partition' (equalAlts alt) alts
  mapM_ (\ (Alt pos _ _) -> genWarning pos overlappingCaseAlt) altsr
  checkOverlappingAlts mid alts'
  where
  equalAlts (Alt _ cterm1 _) (Alt _ cterm2 _) = equalConstrTerms cterm1 cterm2

  equalConstrTerms (LiteralPattern l1) (LiteralPattern l2)
    = return $ l1 == l2
  equalConstrTerms (NegativePattern id1 l1) (NegativePattern id2 l2)
    = return $ id1 == id2 && l1 == l2
  equalConstrTerms (VariablePattern id1) (VariablePattern id2) = do
    p <- isConsId id1
    return $ p && id1 == id2
  equalConstrTerms (ConstructorPattern qid1 cs1)
                   (ConstructorPattern qid2 cs2)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
423
    = if qid1 == qid2
Björn Peemöller 's avatar
Björn Peemöller committed
424
425
426
427
        then all' (\ (c1,c2) -> equalConstrTerms c1 c2) (zip cs1 cs2)
        else return False
  equalConstrTerms (InfixPattern lcs1 qid1 rcs1)
                   (InfixPattern lcs2 qid2 rcs2)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
428
429
    = equalConstrTerms (ConstructorPattern qid1 [lcs1, rcs1])
                       (ConstructorPattern qid2 [lcs2, rcs2])
Björn Peemöller 's avatar
Björn Peemöller committed
430
  equalConstrTerms (ParenPattern cterm1) (ParenPattern cterm2)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
431
    = equalConstrTerms cterm1 cterm2
Björn Peemöller 's avatar
Björn Peemöller committed
432
  equalConstrTerms (TuplePattern _ cs1) (TuplePattern _ cs2)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
433
434
    = equalConstrTerms (ConstructorPattern (qTupleId 2) cs1)
                       (ConstructorPattern (qTupleId 2) cs2)
Björn Peemöller 's avatar
Björn Peemöller committed
435
  equalConstrTerms (ListPattern _ cs1) (ListPattern _ cs2)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
436
    = cmpListM equalConstrTerms cs1 cs2
Björn Peemöller 's avatar
Björn Peemöller committed
437
  equalConstrTerms (AsPattern _ cterm1) (AsPattern _ cterm2)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
438
    = equalConstrTerms cterm1 cterm2
Björn Peemöller 's avatar
Björn Peemöller committed
439
  equalConstrTerms (LazyPattern _ cterm1) (LazyPattern _ cterm2)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
440
    = equalConstrTerms cterm1 cterm2
Björn Peemöller 's avatar
Björn Peemöller committed
441
  equalConstrTerms _ _ = return False
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
442

443
444
445
446
447
448
449
  cmpListM :: Monad m => (a -> a -> m Bool) -> [a] -> [a] -> m Bool
  cmpListM _ []     []     = return True
  cmpListM cmpM (x:xs) (y:ys) = do
    c <- cmpM x y
    if c then cmpListM cmpM xs ys
         else return False
  cmpListM _ _      _      = return False
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
450
451
452
453
454
455
456

-------------------------------------------------------------------------------
-- For detecting unreferenced variables, the following functions updates the
-- current check state by adding identifiers occuring in declaration left hand
-- sides.

--
Björn Peemöller 's avatar
Björn Peemöller committed
457
458
459
insertDecl :: Decl -> CheckM ()
insertDecl (DataDecl _ ident _ cdecls) = do
  insertTypeConsId ident
460
  mapM_ insertConstrDecl cdecls
Björn Peemöller 's avatar
Björn Peemöller committed
461
462
463
464
465
466
insertDecl (TypeDecl _ ident _ texpr) = do
  insertTypeConsId ident
  insertTypeExpr texpr
insertDecl (FunctionDecl _ ident _) = do
  c <- isConsId ident
  unless c $ insertVar ident
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
467
insertDecl (ExternalDecl _ _ _ ident _)
Björn Peemöller 's avatar
Björn Peemöller committed
468
  = insertVar ident
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
469
insertDecl (FlatExternalDecl _ idents)
470
  = mapM_ insertVar idents
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
471
insertDecl (PatternDecl _ cterm _)
Björn Peemöller 's avatar
Björn Peemöller committed
472
  = insertConstrTerm False cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
473
insertDecl (ExtraVariables _ idents)
474
  = mapM_ insertVar idents
Björn Peemöller 's avatar
Björn Peemöller committed
475
insertDecl _ = checked
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
476
477

--
Björn Peemöller 's avatar
Björn Peemöller committed
478
479
insertTypeExpr :: TypeExpr -> CheckM ()
insertTypeExpr (VariableType _) = checked
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
480
insertTypeExpr (ConstructorType _ texprs)
481
  = mapM_ insertTypeExpr texprs
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
482
insertTypeExpr (TupleType texprs)
483
  = mapM_ insertTypeExpr texprs
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
484
insertTypeExpr (ListType texpr)
Björn Peemöller 's avatar
Björn Peemöller committed
485
  = insertTypeExpr texpr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
486
insertTypeExpr (ArrowType texpr1 texpr2)
487
  = mapM_ insertTypeExpr [texpr1,texpr2]
Björn Peemöller 's avatar
Björn Peemöller committed
488
insertTypeExpr (RecordType _ restr) = do
489
  --mapM_ insertVar (concatMap fst fields)
Björn Peemöller 's avatar
Björn Peemöller committed
490
  maybe (return ()) insertTypeExpr restr
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
491
492

--
Björn Peemöller 's avatar
Björn Peemöller committed
493
494
495
insertConstrDecl :: ConstrDecl -> CheckM ()
insertConstrDecl (ConstrDecl _ _   ident _) = insertConsId ident
insertConstrDecl (ConOpDecl  _ _ _ ident _) = insertConsId ident
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
496
497
498
499
500
501
502

-- Notes:
--    - 'fp' indicates whether 'checkConstrTerm' deals with the arguments
--      of a function pattern or not.
--    - Since function patterns are not recognized before syntax check, it is
--      necessary to determine, whether a constructor pattern represents a
--      constructor or a function.
Björn Peemöller 's avatar
Björn Peemöller committed
503
insertConstrTerm :: Bool -> ConstrTerm -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
504
insertConstrTerm fp (VariablePattern ident)
Björn Peemöller 's avatar
Björn Peemöller committed
505
506
507
508
509
510
511
512
513
  | fp        = do
    c <- isConsId ident
    v <- isVarId ident
    unless c $ if name ident /= "_" && v then visitId ident else insertVar ident
  | otherwise = do
    c <- isConsId ident
    unless c $ insertVar ident
insertConstrTerm fp (ConstructorPattern qident cterms) = do
  c <- isQualConsId qident
514
515
  if c then mapM_ (insertConstrTerm fp) cterms
       else mapM_ (insertConstrTerm True) cterms
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
516
insertConstrTerm fp (InfixPattern cterm1 qident cterm2)
Björn Peemöller 's avatar
Björn Peemöller committed
517
  = insertConstrTerm fp (ConstructorPattern qident [cterm1, cterm2])
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
518
insertConstrTerm fp (ParenPattern cterm)
Björn Peemöller 's avatar
Björn Peemöller committed
519
  = insertConstrTerm fp cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
520
insertConstrTerm fp (TuplePattern _ cterms)
521
  = mapM_ (insertConstrTerm fp) cterms
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
522
insertConstrTerm fp (ListPattern _ cterms)
523
  = mapM_ (insertConstrTerm fp) cterms
Björn Peemöller 's avatar
Björn Peemöller committed
524
525
526
insertConstrTerm fp (AsPattern ident cterm) = do
  insertVar ident
  insertConstrTerm fp cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
527
insertConstrTerm fp (LazyPattern _ cterm)
Björn Peemöller 's avatar
Björn Peemöller committed
528
  = insertConstrTerm fp cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
529
insertConstrTerm _ (FunctionPattern _ cterms)
530
  = mapM_ (insertConstrTerm True) cterms
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
531
insertConstrTerm _ (InfixFuncPattern cterm1 qident cterm2)
Björn Peemöller 's avatar
Björn Peemöller committed
532
533
  = insertConstrTerm True (FunctionPattern qident [cterm1, cterm2])
insertConstrTerm fp (RecordPattern fields restr) = do
534
  mapM_ (insertFieldPattern fp) fields
Björn Peemöller 's avatar
Björn Peemöller committed
535
536
  maybe (return ()) (insertConstrTerm fp) restr
insertConstrTerm _ _ = checked
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
537
538

--
Björn Peemöller 's avatar
Björn Peemöller committed
539
540
insertFieldPattern :: Bool -> Field ConstrTerm -> CheckM ()
insertFieldPattern fp (Field _ _ cterm) = insertConstrTerm fp cterm
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568

-------------------------------------------------------------------------------
-------------------------------------------------------------------------------

-- Data type for distinguishing identifiers as either (type) constructors or
-- (type) variables (including functions).
-- The Boolean flag in 'VarInfo' is used to mark variables when they are used
-- within expressions.
data IdInfo = ConsInfo | VarInfo Bool deriving Show

--
isVariable :: IdInfo -> Bool
isVariable (VarInfo _) = True
isVariable _           = False

--
isConstructor :: IdInfo -> Bool
isConstructor ConsInfo = True
isConstructor _        = False

--
variableVisited :: IdInfo -> Bool
variableVisited (VarInfo v) = v
variableVisited _           = True

--
visitVariable :: IdInfo -> IdInfo
visitVariable info = case info of
Björn Peemöller 's avatar
Björn Peemöller committed
569
570
  VarInfo _ -> VarInfo True
  _         -> info
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
571
572

--
Björn Peemöller 's avatar
Björn Peemöller committed
573
modifyScope :: (ScopeEnv.ScopeEnv QualIdent IdInfo -> ScopeEnv.ScopeEnv QualIdent IdInfo)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
574
	       -> CState -> CState
Björn Peemöller 's avatar
Björn Peemöller committed
575
modifyScope f state = state { scope = f $ scope state }
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
576
577

--
Björn Peemöller 's avatar
Björn Peemöller committed
578
genWarning :: Position -> String -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
579
genWarning pos msg
Björn Peemöller 's avatar
Björn Peemöller committed
580
  = modify (\state -> state{ messages = warnMsg:(messages state) })
581
 where warnMsg = Message (Just pos) msg
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
582

Björn Peemöller 's avatar
Björn Peemöller committed
583
genWarning' :: (Position, String) -> CheckM ()
Björn Peemöller 's avatar
Björn Peemöller committed
584
genWarning' = uncurry genWarning
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
585
586

--
Björn Peemöller 's avatar
Björn Peemöller committed
587
insertVar :: Ident -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
588
insertVar ident
Björn Peemöller 's avatar
Björn Peemöller committed
589
590
591
592
  | isAnnonId ident
  = return ()
  | otherwise
  = modify (modifyScope (ScopeEnv.insert (commonId ident) (VarInfo False)))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
593
594

--
Björn Peemöller 's avatar
Björn Peemöller committed
595
insertTypeVar :: Ident -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
596
insertTypeVar ident
Björn Peemöller 's avatar
Björn Peemöller committed
597
598
599
600
  | isAnnonId ident
  = return ()
  | otherwise
  = modify (modifyScope (ScopeEnv.insert (typeId ident) (VarInfo False)))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
601
602

--
Björn Peemöller 's avatar
Björn Peemöller committed
603
insertConsId :: Ident -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
604
605
606
607
608
insertConsId ident
   = modify
       (\state -> modifyScope (ScopeEnv.insert (commonId ident) ConsInfo) state)

--
Björn Peemöller 's avatar
Björn Peemöller committed
609
insertTypeConsId :: Ident -> CheckM ()
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
610
611
612
613
614
insertTypeConsId ident
   = modify
       (\state -> modifyScope (ScopeEnv.insert (typeId ident) ConsInfo) state)

--
Björn Peemöller 's avatar
Björn Peemöller committed
615
616
isVarId :: Ident -> CheckM Bool
isVarId ident = gets (\state -> isVar state (commonId ident))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
617
618

--
Björn Peemöller 's avatar
Björn Peemöller committed
619
620
isConsId :: Ident -> CheckM Bool
isConsId ident = gets (\state -> isCons state (qualify ident))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
621
622

--
Björn Peemöller 's avatar
Björn Peemöller committed
623
624
isQualConsId :: QualIdent -> CheckM Bool
isQualConsId qid = gets (\state -> isCons state qid)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
625
626

--
Björn Peemöller 's avatar
Björn Peemöller committed
627
628
isShadowingVar :: Ident -> CheckM Bool
isShadowingVar ident = gets (\state -> isShadowing state (commonId ident))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
629
630

--
Björn Peemöller 's avatar
Björn Peemöller committed
631
632
633
visitId :: Ident -> CheckM ()
visitId ident = modify
  (modifyScope (ScopeEnv.modify visitVariable (commonId ident)))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
634
635

--
Björn Peemöller 's avatar
Björn Peemöller committed
636
637
638
visitTypeId :: Ident -> CheckM ()
visitTypeId ident = modify
  (modifyScope (ScopeEnv.modify visitVariable (typeId ident)))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
639
640

--
Björn Peemöller 's avatar
Björn Peemöller committed
641
642
isUnrefTypeVar :: Ident -> CheckM Bool
isUnrefTypeVar ident = gets (\state -> isUnref state (typeId ident))
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
643
644

--
Björn Peemöller 's avatar
Björn Peemöller committed
645
646
returnUnrefVars :: CheckM [Ident]
returnUnrefVars = gets (\state ->
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
647
648
649
650
651
	   	    let ids    = map fst (ScopeEnv.toLevelList (scope state))
                        unrefs = filter (isUnref state) ids
	            in  map unqualify unrefs )

--
Björn Peemöller 's avatar
Björn Peemöller committed
652
653
withScope :: CheckM a -> CheckM ()
withScope m = beginScope >> m >> endScope
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
654
655

--
Björn Peemöller 's avatar
Björn Peemöller committed
656
657
beginScope :: CheckM ()
beginScope = modify (modifyScope ScopeEnv.beginScope)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
658
659

--
Björn Peemöller 's avatar
Björn Peemöller committed
660
661
endScope :: CheckM ()
endScope = modify (modifyScope ScopeEnv.endScopeUp)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
662
663

--
Björn Peemöller 's avatar
Björn Peemöller committed
664
dropUnless' :: (a -> CheckM Bool) -> [a] -> CheckM [a]
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
665
666
667
668
669
670
dropUnless' _ [] = return []
dropUnless' mpred (x:xs)
   = do p <- mpred x
	if p then return (x:xs) else dropUnless' mpred xs

--
Björn Peemöller 's avatar
Björn Peemöller committed
671
partition' :: (a -> CheckM Bool) -> [a] -> CheckM ([a],[a])
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
672
673
674
675
676
677
678
679
680
partition' mpred xs' = part mpred [] [] xs'
 where
 part _ ts fs [] = return (reverse ts, reverse fs)
 part mpred' ts fs (x:xs)
   = do p <- mpred' x
	if p then part mpred' (x:ts) fs xs
	     else part mpred' ts (x:fs) xs

--
Björn Peemöller 's avatar
Björn Peemöller committed
681
all' :: (a -> CheckM Bool) -> [a] -> CheckM Bool
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
all' _ [] = return True
all' mpred (x:xs)
   = do p <- mpred x
	if p then all' mpred xs else return False



-------------------------------------------------------------------------------

--
isShadowing :: CState -> QualIdent -> Bool
isShadowing state qid
   = let sc = scope state
     in  maybe False isVariable (ScopeEnv.lookup qid sc)
	 && ScopeEnv.level qid sc < ScopeEnv.currentLevel sc

--
isUnref :: CState -> QualIdent -> Bool
isUnref state qid
   = let sc = scope state
     in  maybe False (not . variableVisited) (ScopeEnv.lookup qid sc)
         && ScopeEnv.level qid sc == ScopeEnv.currentLevel sc

--
isVar :: CState -> QualIdent -> Bool
isVar state qid = maybe (isAnnonId (unqualify qid))
	           isVariable
		   (ScopeEnv.lookup qid (scope state))

--
isCons :: CState -> QualIdent -> Bool
isCons state qid = maybe (isImportedCons state qid)
		         isConstructor
			 (ScopeEnv.lookup qid (scope state))
 where
 isImportedCons state' qid'
    = case (qualLookupValue qid' (values state')) of
        (DataConstructor _ _):_    -> True
        (NewtypeConstructor _ _):_ -> True
        _                          -> False

--
isAnnonId :: Ident -> Bool
725
isAnnonId = (== anonId)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740

-- Since type identifiers and normal identifiers (e.g. functions, variables
-- or constructors) don't share the same namespace, it is necessary
-- to distinguish them in the scope environment of the check state.
-- For this reason type identifiers are annotated with 1 and normal
-- identifiers are annotated with 0.
--
commonId :: Ident -> QualIdent
commonId ident = qualify (unRenameIdent ident)

--
typeId :: Ident -> QualIdent
typeId ident = qualify (renameIdent ident 1)


741
742
743
-- ---------------------------------------------------------------------------
-- Warnings messages
-- ---------------------------------------------------------------------------
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789

unrefTypeVar :: Ident -> (Position, String)
unrefTypeVar ident =
  (positionOfIdent ident,
   "unreferenced type variable \"" ++ show ident ++ "\"")

unrefVar :: Ident -> (Position, String)
unrefVar ident =
  (positionOfIdent ident,
   "unused declaration of variable \"" ++ show ident ++ "\"")

shadowingVar :: Ident -> (Position, String)
shadowingVar ident =
  (positionOfIdent ident,
   "shadowing symbol \"" ++ show ident ++ "\"")

idleCaseAlts :: String
idleCaseAlts = "idle case alternative(s)"

overlappingCaseAlt :: String
overlappingCaseAlt = "redundant overlapping case alternative"

rulesNotTogether :: Ident -> Position -> (Position, String)
rulesNotTogether ident pos
  = (positionOfIdent ident,
     "rules for function \"" ++ show ident ++ "\" "
     ++ "are not together "
     ++ "(first occurrence at "
     ++ show (line pos) ++ "." ++ show (column pos) ++ ")")

multiplyImportedModule :: ModuleIdent -> (Position, String)
multiplyImportedModule mid
  = (positionOfModuleIdent mid,
     "module \"" ++ show mid ++ "\" was imported more than once")

multiplyImportedSymbol :: ModuleIdent -> Ident -> (Position, String)
multiplyImportedSymbol mid ident
  = (positionOfIdent ident,
     "symbol \"" ++ show ident ++ "\" was imported from module \""
     ++ show mid ++ "\" more than once")

multiplyHiddenSymbol :: ModuleIdent -> Ident -> (Position, String)
multiplyHiddenSymbol mid ident
  = (positionOfIdent ident,
     "symbol \"" ++ show ident ++ "\" from module \"" ++ show mid
     ++ "\" was hidden more than once")