From 0887a4e2d8ae21b28365f0a1fe6c09ef7da79c4f Mon Sep 17 00:00:00 2001 From: Liam Goodacre Date: Fri, 7 Jul 2017 00:30:39 +0100 Subject: [PATCH] Replace synonyms in instance constraints --- examples/passing/2972.purs | 13 +++++++++++++ src/Language/PureScript/TypeChecker.hs | 3 ++- 2 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 examples/passing/2972.purs diff --git a/examples/passing/2972.purs b/examples/passing/2972.purs new file mode 100644 index 0000000000..fbf961e5d6 --- /dev/null +++ b/examples/passing/2972.purs @@ -0,0 +1,13 @@ +module Main where + +import Control.Monad.Eff.Console (log) +import Prelude (class Show, show) + +type I t = t + +newtype Id t = Id t + +instance foo :: Show (I t) => Show (Id t) where + show (Id t) = "Done" + +main = log (show (Id "other")) diff --git a/src/Language/PureScript/TypeChecker.hs b/src/Language/PureScript/TypeChecker.hs index cdac4bebea..819328f99a 100644 --- a/src/Language/PureScript/TypeChecker.hs +++ b/src/Language/PureScript/TypeChecker.hs @@ -323,7 +323,8 @@ typeCheckAll moduleName _ = traverse go sequence_ (zipWith (checkTypeClassInstance typeClass) [0..] tys) checkOrphanInstance dictName className typeClass tys _ <- traverseTypeInstanceBody checkInstanceMembers body - let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps) + deps' <- (traverse . overConstraintArgs . traverse) replaceAllTypeSynonyms deps + let dict = TypeClassDictionaryInScope (Qualified (Just moduleName) dictName) [] className tys (Just deps') addTypeClassDictionaries (Just moduleName) . M.singleton className $ M.singleton (tcdValue dict) dict return d