git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Optimise replaceAllTypeSynonyms

Now does a single Type tree traversal and replacement using a Map, instead of a traversal per element in the Map. Criterion numbers: benchmarking unpatched time 33.37 s (31.62 s .. 37.20 s) 0.998 R² (0.997 R² .. 1.000 R²) mean 33.30 s (32.74 s .. 33.67 s) std dev 556.4 ms (0.0 s .. 642.5 ms) variance introduced by outliers: 19% (moderately inflated) benchmarking patched time 19.63 s (13.87 s .. 24.89 s) 0.990 R² (0.961 R² .. 1.000 R²) mean 19.84 s (18.75 s .. 20.65 s) std dev 1.241 s (0.0 s .. 1.408 s) variance introduced by outliers: 19% (moderately inflated)

commit41a7f20fb3727c9571d066b68765b6d692267174 authorBrian McKenna <brian@brianmckenna.org> dateFri 12 Jun 2015, 09:17 (11 years ago) parent2021aa0
1 file changed+10−16
compare with golang
unifiedsplit
src/Language/PureScript/TypeChecker/Synonyms.hs+10−16
src/Language/PureScript/TypeChecker/Synonyms.hs+10−16
@@ -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