@@ -188,6 +188,8 @@ typesOf mainModuleName moduleName vals = do
188188 val' <- replaceTypeClassDictionaries moduleName val
189189 -- Check skolem variables did not escape their scope
190190 skolemEscapeCheck val'
191+ -- Check rows do not contain duplicate labels
192+ checkDuplicateLabels val'
191193 -- Remove type synonyms placeholders, remove duplicate row fields, and replace
192194 -- top-level unification variables with named type variables.
193195 let val'' = overTypes (desaturateAllTypeSynonyms . setifyAll) val'
@@ -511,6 +513,41 @@ skolemEscapeCheck root@TypedValue{} =
511513 go' _ = mempty
512514skolemEscapeCheck val = throwError $ mkErrorStack "Untyped value passed to skolemEscapeCheck" (Just (ExprError val))
513515
516+-- |
517+-- Ensure rows do not contain duplicate labels
518+--
519+checkDuplicateLabels :: Expr -> Check ()
520+checkDuplicateLabels =
521+ let (_, f, _) = everywhereOnValuesM def go def
522+ in void . f
523+ where
524+ def :: a -> Check a
525+ def = return
526+
527+ go :: Expr -> Check Expr
528+ go e@(TypedValue _ _ ty) = checkDups ty >> return e
529+ go other = return other
530+
531+ checkDups :: Type -> Check ()
532+ checkDups (TypeApp t1 t2) = checkDups t1 >> checkDups t2
533+ checkDups (SaturatedTypeSynonym _ ts) = mapM_ checkDups ts
534+ checkDups (ForAll _ t _) = checkDups t
535+ checkDups (ConstrainedType args t) = do
536+ mapM_ (checkDups) $ concatMap snd args
537+ checkDups t
538+ checkDups r@(RCons _ _ _) =
539+ let (ls, _) = rowToList r in
540+ case firstDup . sort . map fst $ ls of
541+ Just l -> throwError . strMsg $ "Duplicate label " ++ show l ++ " in row"
542+ Nothing -> return ()
543+ checkDups _ = return ()
544+
545+ firstDup :: (Eq a) => [a] -> Maybe a
546+ firstDup (x : xs@(x' : _))
547+ | x == x' = Just x
548+ | otherwise = firstDup xs
549+ firstDup _ = Nothing
550+
514551-- |
515552-- Ensure a row contains no duplicate labels
516553--