2fa21f9 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Sort rows in unification errors

commit2fa21f96acb326fcc2efdc076559b786b4cbf3d3 authorPhil Freeman <paf31@cantab.net> dateSat 21 Nov 2015, 13:13 (11 years ago) parent2627e5a

3 files changed+30−10

compare with golang

unifiedsplit

src/Language/PureScript/Errors.hs+28−8 src/Language/PureScript/Pretty/Types.hs+1−1 src/Language/PureScript/TypeChecker/Unify.hs+1−1

src/Language/PureScript/Errors.hs+28−8

@@ -21,8 +21,9 @@ module Language.PureScript.Errors where

2121import Prelude ()

2222import Prelude.Compat

2323

24+import Data.Ord (comparing)

2425import Data.Either (lefts, rights)

25−import Data.List (intercalate, transpose, nub, nubBy)

26+import Data.List (intercalate, transpose, nub, nubBy, sortBy)

2627import Data.Function (on)

2728import Data.Foldable (fold)

2829

@@ -32,7 +33,7 @@ import Control.Monad

3233import Control.Monad.Writer

3334import Control.Monad.Error.Class (MonadError(..))

3435import Control.Monad.Trans.State.Lazy

35−import Control.Arrow (first)

36+import Control.Arrow (first, (&&&))

3637

3738import Language.PureScript.Crash

3839import Language.PureScript.AST

@@ -522,12 +523,31 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

522523 <> foldMap (\expr -> [ line "Relevant expression: "

523524 , indent $ prettyPrintValue valueDepth expr

524525 ]) binding

525− renderSimpleErrorMessage (TypesDoNotUnify t1 t2)

526− = paras [ line "Could not match type"

527− , indent $ typeAsBox t1

528− , line "with type"

529− , indent $ typeAsBox t2

530− ]

526+ renderSimpleErrorMessage (TypesDoNotUnify u1 u2)

527+ = let (sorted1, sorted2) = sortRows u1 u2

528+

529+ sortRows :: Type -> Type -> (Type, Type)

530+ sortRows r1@RCons{} r2@RCons{} = sortRows' (rowToList r1) (rowToList r2)

531+ sortRows t1 t2 = (t1, t2)

532+

533+ -- Put the common labels last

534+ sortRows' :: ([(String, Type)], Type) -> ([(String, Type)], Type) -> (Type, Type)

535+ sortRows' (s1, r1) (s2, r2) =

536+ let common :: [(String, (Type, Type))]

537+ common = sortBy (comparing fst) $ [ (name, (t1, t2)) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

538+

539+ sd1, sd2 :: [(String, Type)]

540+ sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

541+ sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

542+ in ( rowFromList (sortBy (comparing fst) sd1 ++ map (fst &&& fst . snd) common, r1)

543+ , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)

544+ )

545+ in paras [ line "Could not match type"

546+ , indent $ typeAsBox sorted1

547+ , line "with type"

548+ , indent $ typeAsBox sorted2

549+ ]

550+

531551 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =

532552 paras [ line "Could not match kind"

533553 , indent $ line $ prettyPrintKind k1

src/Language/PureScript/Pretty/Types.hs+1−1

@@ -79,7 +79,7 @@ prettyPrintRowWith open close = uncurry listToBox . toList []

7979

8080 toList :: [(String, Type)] -> Type -> ([(String, Type)], Type)

8181 toList tys (RCons name ty row) = toList ((name, ty):tys) row

82− toList tys r = (tys, r)

82+ toList tys r = (reverse tys, r)

8383

8484prettyPrintRow :: Type -> String

8585prettyPrintRow = render . prettyPrintRowWith '(' ')'

src/Language/PureScript/TypeChecker/Unify.hs+1−1

@@ -163,7 +163,7 @@ unifyRows r1 r2 =

163163 unifyRows' [] REmpty [] REmpty = return ()

164164 unifyRows' [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = return ()

165165 unifyRows' [] (Skolem _ s1 _) [] (Skolem _ s2 _) | s1 == s2 = return ()

166− unifyRows' sd3 r3 sd4 r4 = throwError . errorMessage $ TypesDoNotUnify (rowFromList (sd3, r3)) (rowFromList (sd4, r4))

166+ unifyRows' _ _ _ _ = throwError . errorMessage $ TypesDoNotUnify r1 r2

167167

168168-- |

169169-- Check that two types unify