383a9ef · rowtype-yoga/purescript-native

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

More lenient overlap check

commit383a9efc789d919a8c475a43c668d6cdd8aaf23d authorPhil Freeman <paf31@cantab.net> dateMon 7 Apr 2014, 20:22 (13 years ago) parent00169a0

3 files changed+27−5

compare with golang

unifiedsplit

examples/failing/Superclasses4.purs+12 examples/passing/Superclasses3.purs+1−1 src/Language/PureScript/TypeChecker/Types.hs+14−4

examples/failing/Superclasses4.pursnew file+12

@@ -0,0 +1,12 @@

1+module OverlappingInstances where

3+class Foo a

5+instance foo1 :: Foo Number

7+instance foo2 :: Foo Number

9+test :: forall a. (Foo a) => a -> a

10+test a = a

11+

12+test1 = test 0

examples/passing/Superclasses3.purs+1−1

@@ -7,7 +7,7 @@ import Control.Monad.Eff

77class (Monad m) <= MonadWriter w m where

88 tell :: w -> m {}

10−testFunctor :: forall m. (Applicative m) => m Number -> m Number

10+testFunctor :: forall m. (Functor m) => m Number -> m Number

1111testFunctor n = (+) 1 <$> n

1212

1313test :: forall w m. (Monad m, MonadWriter w m) => w -> m {}

src/Language/PureScript/TypeChecker/Types.hs+14−4

@@ -306,10 +306,12 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

306306 filterModule _ = False

307307

308308 solve context' (className, tys) trySuperclasses =

309− case chooseSimplestDictionaries (go trySuperclasses className tys) of

310− [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)

311− [dict] -> return (dictionaryValueToValue dict)

312− _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)

309+ let

310+ dicts = go trySuperclasses className tys

311+ in case sortedNubBy dictTrace (chooseSimplestDictionaries dicts) of

312+ [] -> throwError . strMsg $ "No instance found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)

313+ [_] -> return $ dictionaryValueToValue $ head dicts

314+ _ -> throwError . strMsg $ "Overlapping instances found for " ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)

313315 where

314316 go trySuperclasses' className' tys' =

315317 -- Look for regular type instances

@@ -385,6 +387,14 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

385387 isSimpleDictionaryValue SubclassDictionaryValue{} = False

386388 isSimpleDictionaryValue (DependentDictionaryValue _ ds) = all isSimpleDictionaryValue ds

387389 isSimpleDictionaryValue _ = True

390+ -- |

391+ -- Get the "trace" of a DictionaryValue - that is, remove all SubclassDictionaryValue

392+ -- data constructors

393+ --

394+ dictTrace :: DictionaryValue -> DictionaryValue

395+ dictTrace (DependentDictionaryValue fnName dicts) = DependentDictionaryValue fnName $ map dictTrace dicts

396+ dictTrace (SubclassDictionaryValue dict _ _) = dict

397+ dictTrace other = other

388398

389399-- |

390400-- Check all values in a list pairwise match a predicate