diff --git a/compiler/stgSyn/StgLint.hs b/compiler/stgSyn/StgLint.hs
index 58f14a1..37b67a2 100644
--- a/compiler/stgSyn/StgLint.hs
+++ b/compiler/stgSyn/StgLint.hs
@@ -5,6 +5,8 @@ A lint pass to check basic STG invariants:
 
 - Variables should be defined before used.
 
+- Variables should be defined only once.
+
 - Let bindings should not have unboxed types (unboxed bindings should only
   appear in case), except when they're join points (see Note [CoreSyn let/app
   invariant] and #14117).
@@ -41,10 +43,11 @@ import StgSyn
 import DynFlags
 import Bag              ( Bag, emptyBag, isEmptyBag, snocBag, bagToList )
 import Id               ( Id, idType, isLocalId, isJoinId )
+import OccName          ( emptyOccSet, elemOccSet, extendOccSet )
 import VarSet
 import DataCon
 import CoreSyn          ( AltCon(..) )
-import Name             ( getSrcLoc )
+import Name             ( getSrcLoc, getOccName )
 import ErrUtils         ( MsgDoc, Severity(..), mkLocMessage )
 import Type
 import RepType
@@ -62,7 +65,7 @@ lintStgTopBindings :: DynFlags
 
 lintStgTopBindings dflags unarised whodunnit binds
   = {-# SCC "StgLint" #-}
-    case initL unarised (lint_binds binds) of
+    case initL unarised (checkOccDuplicates topIds >> lint_binds binds) of
       Nothing  ->
         return ()
       Just msg -> do
@@ -84,9 +87,20 @@ lintStgTopBindings dflags unarised whodunnit binds
         addInScopeVars binders $
             lint_binds binds
 
+    lint_bind :: StgTopBinding -> LintM [Id]
+
     lint_bind (StgTopLifted bind) = lintStgBinds bind
     lint_bind (StgTopStringLit v _) = return [v]
 
+    topIds :: [Id]
+    topIds = concatMap getBindIds binds
+
+    getBindIds :: StgTopBinding -> [Id]
+    getBindIds bind = case bind of
+      StgTopLifted (StgNonRec b _)  -> [b]
+      StgTopLifted (StgRec bs)      -> map fst bs
+      StgTopStringLit b _           -> [b]
+
 lintStgArg :: StgArg -> LintM ()
 lintStgArg (StgLitArg _) = return ()
 lintStgArg (StgVarArg v) = lintStgVar v
@@ -116,11 +130,14 @@ lint_binds_help (binder, rhs)
 
 lintStgRhs :: StgRhs -> LintM ()
 
-lintStgRhs (StgRhsClosure _ _ _ _ [] expr)
-  = lintStgExpr expr
+lintStgRhs (StgRhsClosure _ _ vars _ [] expr) = do
+  checkDuplicates vars
+  lintStgExpr expr
 
-lintStgRhs (StgRhsClosure _ _ _ _ binders expr)
-  = addLoc (LambdaBodyOf binders) $
+lintStgRhs (StgRhsClosure _ _ vars _ binders expr)
+  = addLoc (LambdaBodyOf binders) $ do
+      checkDuplicates vars
+      checkDuplicates binders
       addInScopeVars binders $
         lintStgExpr expr
 
@@ -322,13 +339,37 @@ addLoc extra_loc m = LintM $ \lf loc scope errs
 
 addInScopeVars :: [Id] -> LintM a -> LintM a
 addInScopeVars ids m = LintM $ \lf loc scope errs
- -> let
-        new_set = mkVarSet ids
-    in unLintM m lf loc (scope `unionVarSet` new_set) errs
+ -> let new_set   = mkVarSet ids
+        newScope  = scope `unionVarSet` new_set
+    in if disjointVarSet scope new_set
+      then unLintM m lf loc newScope errs
+      else unLintM m lf loc newScope $
+            addErr errs (sep [ hsep [ppr id, dcolon, ppr (idType id), text "is redefined"]
+                             | id <- ids
+                             , elemVarSet id scope
+                             ]
+                        ) loc
 
 getLintFlags :: LintM LintFlags
 getLintFlags = LintM $ \lf _loc _scope errs -> (lf, errs)
 
+checkDuplicates :: [Id] -> LintM ()
+checkDuplicates ids = foldM_ check emptyVarSet ids where
+  check set id
+    | not (elemVarSet id set) = return (extendVarSet set id)
+    | otherwise = do
+                    addErrL $ hsep [ppr id, dcolon, ppr (idType id), text "is duplicated (Uniq)"]
+                    return set
+
+checkOccDuplicates :: [Id] -> LintM ()
+checkOccDuplicates ids = foldM_ check emptyOccSet ids where
+  check set id
+    | occ <- getOccName id
+    , not (elemOccSet occ set) = return (extendOccSet set occ)
+    | otherwise = do
+                    addErrL $ hsep [ppr id, dcolon, ppr (idType id), text "is duplicated (Occ)"]
+                    return set
+
 checkInScope :: Id -> LintM ()
 checkInScope id = LintM $ \_lf loc scope errs
  -> if isLocalId id && not (id `elemVarSet` scope) then