@@ -192,10 +192,10 @@ typesOf mainModuleName moduleName vals = do
192 skolemEscapeCheck val'
192 skolemEscapeCheck val'
193 -- Check rows do not contain duplicate labels
193 -- Check rows do not contain duplicate labels
194 checkDuplicateLabels val'
194 checkDuplicateLabels val'
195− -- Remove type synonyms placeholders, remove duplicate row fields, and replace
195+ -- Remove type synonyms placeholders, and replace
196 -- top-level unification variables with named type variables.
196 -- top-level unification variables with named type variables.
197− let val'' = overTypes (desaturateAllTypeSynonyms . setifyAll) val'
197+ let val'' = overTypes desaturateAllTypeSynonyms val'
198− ty' = varIfUnknown . desaturateAllTypeSynonyms . setifyAll $ ty
198+ ty' = varIfUnknown . desaturateAllTypeSynonyms $ ty
199 return (ident, (val'', ty'))
199 return (ident, (val'', ty'))
201 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
201 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
@@ -527,41 +527,33 @@ checkDuplicateLabels =
527 def = return
527 def = return
529 go :: Expr -> Check Expr
529 go :: Expr -> Check Expr
530− go e@(TypedValue _ _ ty) = checkDups ty >> return e
530+ go e@(TypedValue _ val ty) = do
531− go other = return other
531+ checkDups ty
535+ checkDups :: Type -> Check ()
536+ checkDups (TypeApp t1 t2) = checkDups t1 >> checkDups t2
537+ checkDups (SaturatedTypeSynonym _ ts) = mapM_ checkDups ts
538+ checkDups (ForAll _ t _) = checkDups t
539+ checkDups (ConstrainedType args t) = do
540+ mapM_ (checkDups) $ concatMap snd args
542+ checkDups r@(RCons _ _ _) =
543+ let (ls, _) = rowToList r in
544+ case firstDup . sort . map fst $ ls of
545+ Just l -> throwError $ mkErrorStack ("Duplicate label " ++ show l ++ " in row") $ Just (ExprError val)
546+ Nothing -> return ()
547+ checkDups _ = return ()
533− checkDups :: Type -> Check ()
549+ firstDup :: (Eq a) => [a] -> Maybe a
534− checkDups (TypeApp t1 t2) = checkDups t1 >> checkDups t2
550+ firstDup (x : xs@(x' : _))
535− checkDups (SaturatedTypeSynonym _ ts) = mapM_ checkDups ts
551+ | x == x' = Just x
536− checkDups (ForAll _ t _) = checkDups t
552+ | otherwise = firstDup xs
537− checkDups (ConstrainedType args t) = do
538− mapM_ (checkDups) $ concatMap snd args
540− checkDups r@(RCons _ _ _) =
541− let (ls, _) = rowToList r in
542− case firstDup . sort . map fst $ ls of
543− Just l -> throwError . strMsg $ "Duplicate label " ++ show l ++ " in row"
544− Nothing -> return ()
553+ firstDup _ = Nothing
545− checkDups _ = return ()
554+
555+ go other = return other
547− firstDup :: (Eq a) => [a] -> Maybe a
548− firstDup (x : xs@(x' : _))
550− | otherwise = firstDup xs
551− firstDup _ = Nothing
554−-- Ensure a row contains no duplicate labels
556−setify :: Type -> Type
557−setify = rowFromList . first (M.toList . M.fromList) . rowToList
560−-- \"Setify\" all rows occuring inside a value
562−setifyAll :: Type -> Type
563−setifyAll = everywhereOnTypes setify
566-- Replace outermost unsolved unification variables with named type variables
558-- Replace outermost unsolved unification variables with named type variables