git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Optimise replaceAllTypeSynonyms
41a7f20Brian McKenna
src/Language/PureScript/TypeChecker/Synonyms.hs+10−16
compare with golang
unifiedsplit
@@ -41,28 +41,22 @@ import Language.PureScript.Types
41-- |
41-- |
42-- Build a type substitution for a type synonym
42-- Build a type substitution for a type synonym
43--
43--
44−buildTypeSubstitution :: Qualified ProperName -> Int -> Type -> Either ErrorMessage (Maybe Type)
44+buildTypeSubstitution :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage (Maybe Type)
45−buildTypeSubstitution name n = go n []
45+buildTypeSubstitution m = go 0 []
46 where
46 where
47 go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)
47 go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)
48− go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)
48+ go c args (TypeConstructor ctor) | M.lookup ctor m == Just c = return (Just $ SaturatedTypeSynonym ctor args)
49− go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ SimpleErrorWrapper $ PartiallyAppliedSynonym name
49+ go c _ (TypeConstructor ctor) | M.lookup ctor m > Just c = throwError $ SimpleErrorWrapper $ PartiallyAppliedSynonym ctor
50− go m args (TypeApp f arg) = go (m - 1) (arg:args) f
50+ go c args (TypeApp f arg) = go (c + 1) (arg:args) f
51 go _ _ _ = return Nothing
51 go _ _ _ = return Nothing
52
52
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−
61-- |
53-- |
62-- Replace all type synonyms with the @SaturatedTypeSynonym@ data constructor
54-- Replace all type synonyms with the @SaturatedTypeSynonym@ data constructor
63--
55--
64−saturateAllTypeSynonyms :: [(Qualified ProperName, Int)] -> Type -> Either ErrorMessage Type
56+saturateAllTypeSynonyms :: M.Map (Qualified ProperName) Int -> Type -> Either ErrorMessage Type
65−saturateAllTypeSynonyms syns d = foldM (\result (name, n) -> saturateTypeSynonym name n result) d syns
57+saturateAllTypeSynonyms syns = everywhereOnTypesTopDownM replace
58+ where
59+ replace t = fromMaybe t <$> buildTypeSubstitution syns t
66
60
67-- |
61-- |
68-- \"Desaturate\" @SaturatedTypeSynonym@s
62-- \"Desaturate\" @SaturatedTypeSynonym@s
@@ -80,7 +74,7 @@ desaturateAllTypeSynonyms = everywhereOnTypes replaceSaturatedTypeSynonym
80replaceAllTypeSynonyms' :: Environment -> Type -> Either ErrorMessage Type
74replaceAllTypeSynonyms' :: Environment -> Type -> Either ErrorMessage Type
81replaceAllTypeSynonyms' env d =
75replaceAllTypeSynonyms' env d =
82 let
76 let
83− syns = map (\(name, (args, _)) -> (name, length args)) . M.toList $ typeSynonyms env
77+ syns = length . fst <$> typeSynonyms env
84 in
78 in
85 saturateAllTypeSynonyms syns d
79 saturateAllTypeSynonyms syns d
86
80