@@ -41,28 +41,22 @@ import Language.PureScript.Types
4141-- |
4242-- Build a type substitution for a type synonym
4343--
44−buildTypeSubstitution :: Qualified ProperName -> Int -> Type -> Either ErrorMessage (Maybe Type)
45−buildTypeSubstitution name n = go n []
44+buildTypeSubstitution :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage (Maybe Type)
45+buildTypeSubstitution m = go 0 []
4646 where
4747 go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)
48− go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)
49− go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ SimpleErrorWrapper $ PartiallyAppliedSynonym name
50− go m args (TypeApp f arg) = go (m - 1) (arg:args) f
48+ go c args (TypeConstructor ctor) | M.lookup ctor m == Just c = return (Just $ SaturatedTypeSynonym ctor args)
49+ go c _ (TypeConstructor ctor) | M.lookup ctor m > Just c = throwError $ SimpleErrorWrapper $ PartiallyAppliedSynonym ctor
50+ go c args (TypeApp f arg) = go (c + 1) (arg:args) f
5151 go _ _ _ = return Nothing
5252
53−-- |
54−-- Replace all instances of a specific type synonym with the @SaturatedTypeSynonym@ data constructor
55−--
56−saturateTypeSynonym :: Qualified ProperName -> Int -> Type -> Either ErrorMessage Type
57−saturateTypeSynonym name n = everywhereOnTypesTopDownM replace
58− where
59− replace t = fromMaybe t <$> buildTypeSubstitution name n t
60−
6153-- |
6254-- Replace all type synonyms with the @SaturatedTypeSynonym@ data constructor
6355--
64−saturateAllTypeSynonyms :: [(Qualified ProperName, Int)] -> Type -> Either ErrorMessage Type
65−saturateAllTypeSynonyms syns d = foldM (\result (name, n) -> saturateTypeSynonym name n result) d syns
56+saturateAllTypeSynonyms :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage Type
57+saturateAllTypeSynonyms syns = everywhereOnTypesTopDownM replace
58+ where
59+ replace t = fromMaybe t <$> buildTypeSubstitution syns t
6660
6761-- |
6862-- \"Desaturate\" @SaturatedTypeSynonym@s
@@ -80,7 +74,7 @@ desaturateAllTypeSynonyms = everywhereOnTypes replaceSaturatedTypeSynonym
8074replaceAllTypeSynonyms' :: Environment -> Type -> Either ErrorMessage Type
8175replaceAllTypeSynonyms' env d =
8276 let
83− syns = map (\(name, (args, _)) -> (name, length args)) . M.toList $ typeSynonyms env
77+ syns = length . fst <$> typeSynonyms env
8478 in
8579 saturateAllTypeSynonyms syns d
8680