git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Better error messages for duplicate labels in rows, fix #680
commitb6c82cbf334c98ae28dbdaae9edb8dd6a8e2ece7 authorPhil Freeman <paf31@cantab.net> dateWed 5 Nov 2014, 14:38 (12 years ago) parentff6430a
1 file changed+28−36
src/Language/PureScript/TypeChecker/Types.hs+28−36
src/Language/PureScript/TypeChecker/Types.hs+28−36
@@ -192,10 +192,10 @@ typesOf mainModuleName moduleName vals = do
192192 skolemEscapeCheck val'
193193 -- Check rows do not contain duplicate labels
194194 checkDuplicateLabels val'
195− -- Remove type synonyms placeholders, remove duplicate row fields, and replace
195+ -- Remove type synonyms placeholders, and replace
196196 -- top-level unification variables with named type variables.
197− let val'' = overTypes (desaturateAllTypeSynonyms . setifyAll) val'
198− ty' = varIfUnknown . desaturateAllTypeSynonyms . setifyAll $ ty
197+ let val'' = overTypes desaturateAllTypeSynonyms val'
198+ ty' = varIfUnknown . desaturateAllTypeSynonyms $ ty
199199 return (ident, (val'', ty'))
200200 where
201201 -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values
@@ -527,41 +527,33 @@ checkDuplicateLabels =
527527 def = return
528528
529529 go :: Expr -> Check Expr
530− go e@(TypedValue _ _ ty) = checkDups ty >> return e
531− go other = return other
530+ go e@(TypedValue _ val ty) = do
531+ checkDups ty
532+ return e
533+
534+ where
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
541+ checkDups t
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 ()
532548
533− checkDups :: Type -> Check ()
534− checkDups (TypeApp t1 t2) = checkDups t1 >> checkDups t2
535− checkDups (SaturatedTypeSynonym _ ts) = mapM_ checkDups ts
536− checkDups (ForAll _ t _) = checkDups t
537− checkDups (ConstrainedType args t) = do
538− mapM_ (checkDups) $ concatMap snd args
539− checkDups t
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 ()
545− checkDups _ = return ()
549+ firstDup :: (Eq a) => [a] -> Maybe a
550+ firstDup (x : xs@(x' : _))
551+ | x == x' = Just x
552+ | otherwise = firstDup xs
553+ firstDup _ = Nothing
554+
555+ go other = return other
546556
547− firstDup :: (Eq a) => [a] -> Maybe a
548− firstDup (x : xs@(x' : _))
549− | x == x' = Just x
550− | otherwise = firstDup xs
551− firstDup _ = Nothing
552−
553−-- |
554−-- Ensure a row contains no duplicate labels
555−--
556−setify :: Type -> Type
557−setify = rowFromList . first (M.toList . M.fromList) . rowToList
558−
559−-- |
560−-- \"Setify\" all rows occuring inside a value
561−--
562−setifyAll :: Type -> Type
563−setifyAll = everywhereOnTypes setify
564−
565557-- |
566558-- Replace outermost unsolved unification variables with named type variables
567559--