8ab522f · rowtype-yoga/purescript-native

examples/failing/OverlappingInstances.purs → examples/passing/OverlappingInstances.pursrenamed+2−3

compare with golang

unifiedsplit

@@ -1,5 +1,4 @@

1−-- @shouldFailWith OverlappingInstances

2−module OverlappingInstances where

1+module Main where

3

2

4import Prelude

3import Prelude

5

4

@@ -11,4 +10,4 @@ instance showA1 :: Show A where

11instance showA2 :: Show A where

10instance showA2 :: Show A where

12 show A = "Instance 2"

11 show A = "Instance 2"

13

12

14−main = Control.Monad.Eff.Console.log $ show A

13+main = Test.Assert.assert $ show A == "Instance 1"

examples/failing/OverlappingInstances2.purs → examples/passing/OverlappingInstances2.pursrenamed+2−3

@@ -1,5 +1,4 @@

1−-- @shouldFailWith OverlappingInstances

2−module OverlappingInstances where

1+module Main where

3

2

4import Prelude

3import Prelude

5

4

@@ -21,4 +20,4 @@ instance ordA :: Ord A where

21test :: forall a. (Ord a) => a -> a -> String

20test :: forall a. (Ord a) => a -> a -> String

22test x y = show $ x == y

21test x y = show $ x == y

23

22

24−main = Control.Monad.Eff.Console.log $ test A B

23+main = Test.Assert.assert $ test A B == "false"

examples/failing/Superclasses4.purs → examples/passing/OverlappingInstances3.pursrenamed+3−2

@@ -1,5 +1,4 @@

1−-- @shouldFailWith OverlappingInstances

2−module OverlappingInstances where

1+module Main where

3

2

4import Prelude

3import Prelude

5

4

@@ -13,3 +12,5 @@ test :: forall a. (Foo a) => a -> a

13test a = a

12test a = a

14

13

15test1 = test 0.0

14test1 = test 0.0

15+

16+main = Test.Assert.assert (test1 == 0.0)

src/Language/PureScript/Errors.hs+3−2

@@ -558,10 +558,11 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

558 , line "with type"

559 , indent $ line $ prettyPrintType t2

560 ]

561− goSimple (OverlappingInstances nm ts ds) =

561+ goSimple (OverlappingInstances nm ts (d : ds)) =

562 paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"

563− , line $ intercalate ", " (map show ds)

563+ , indent $ paras (line (show d ++ " (chosen)") : map (line . show) ds)

564 ]

565+ goSimple OverlappingInstances{} = error "OverlappingInstances: empty instance list"

565 goSimple (NoInstanceFound nm ts) =

566 goSimple (NoInstanceFound nm ts) =

566 line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)

567 line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)

567 goSimple (PossiblyInfiniteInstance nm ts) =

568 goSimple (PossiblyInfiniteInstance nm ts) =

src/Language/PureScript/TypeChecker/Entailment.hs+6−1

@@ -34,6 +34,7 @@ import Control.Applicative

34import Control.Arrow (Arrow(..))

35import Control.Monad.State

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

37+import Control.Monad.Writer.Class (tell)

37

38

38import Language.PureScript.AST

39import Language.PureScript.AST

39import Language.PureScript.Errors

40import Language.PureScript.Errors

@@ -83,7 +84,9 @@ entails env moduleName context = solve

83 unique :: [(a, TypeClassDictionaryInScope)] -> Check (a, TypeClassDictionaryInScope)

84 unique :: [(a, TypeClassDictionaryInScope)] -> Check (a, TypeClassDictionaryInScope)

84 unique [] = throwError . errorMessage $ NoInstanceFound className' tys'

85 unique [] = throwError . errorMessage $ NoInstanceFound className' tys'

85 unique [a] = return a

86 unique [a] = return a

87+ unique tcds | pairwise overlapping (map snd tcds) = do

86− unique tcds | pairwise overlapping (map snd tcds) = throwError . errorMessage $ OverlappingInstances className' tys' (map (tcdName . snd) tcds)

88+ tell . errorMessage $ OverlappingInstances className' tys' (map (tcdName . snd) tcds)

89+ return (head tcds)

87 | otherwise = return (minimumBy (compare `on` length . tcdPath . snd) tcds)

90 | otherwise = return (minimumBy (compare `on` length . tcdPath . snd) tcds)

88

91

89 -- |

92 -- |

@@ -94,6 +97,8 @@ entails env moduleName context = solve

94 overlapping :: TypeClassDictionaryInScope -> TypeClassDictionaryInScope -> Bool

97 overlapping :: TypeClassDictionaryInScope -> TypeClassDictionaryInScope -> Bool

95 overlapping TypeClassDictionaryInScope{ tcdPath = _ : _ } _ = False

98 overlapping TypeClassDictionaryInScope{ tcdPath = _ : _ } _ = False

96 overlapping _ TypeClassDictionaryInScope{ tcdPath = _ : _ } = False

99 overlapping _ TypeClassDictionaryInScope{ tcdPath = _ : _ } = False

100+ overlapping TypeClassDictionaryInScope{ tcdDependencies = Nothing } _ = False

101+ overlapping _ TypeClassDictionaryInScope{ tcdDependencies = Nothing } = False

97 overlapping tcd1 tcd2 = tcdName tcd1 /= tcdName tcd2

102 overlapping tcd1 tcd2 = tcdName tcd1 /= tcdName tcd2

98

103

99 -- Create dictionaries for subgoals which still need to be solved by calling go recursively

104 -- Create dictionaries for subgoals which still need to be solved by calling go recursively