git.iko.soy/elk
on master help sign in
Only crawl type alias variables in adjustRankContent (and other optimizations)
e6b8eb3Evan Czaplicki
src/Type/Solve.hs+36−40
compare with master
unifiedsplit
@@ -86,34 +86,32 @@ rigidify content =
86 content
86 content
87
87
88
88
89+
90+-- ADJUST RANK
91+
92+--
89−-- adjust the ranks of variables such that ranks never increase as you
93+-- Adjust variable ranks such that ranks never increase as you move deeper.
90−-- move deeper into a variable.
94+-- This way the outermost rank is representative of the entire structure.
95+--
91adjustRank :: Int -> Int -> Int -> Variable -> IO Int
96adjustRank :: Int -> Int -> Int -> Variable -> IO Int
92adjustRank youngMark visitedMark groupRank var =
97adjustRank youngMark visitedMark groupRank var =
93 {-# SCC elm_compiler_type_adjust #-}
98 {-# SCC elm_compiler_type_adjust #-}
94− do descriptor <- UF.descriptor var
99+ do (Descriptor content rank mark copy) <- UF.descriptor var
95− adjustRankHelp youngMark visitedMark groupRank var descriptor
96−
97−
98−adjustRankHelp :: Int -> Int -> Int -> Variable -> Descriptor -> IO Int
99−adjustRankHelp youngMark visitedMark groupRank var descriptor@(Descriptor content rank mark _) =
100− if mark == youngMark then
100+ if mark == youngMark then
101−
102− do -- Set the variable as marked first because it may be cyclic.
101+ do -- Set the variable as marked first because it may be cyclic.
103− UF.modifyDescriptor var $ \desc -> desc { _mark = visitedMark }
102+ UF.setDescriptor var $ Descriptor content rank visitedMark copy
104− maxRank <- adjustRankContent youngMark visitedMark groupRank content
103+ maxRank <- adjustRankContent youngMark visitedMark groupRank content
105− UF.modifyDescriptor var $ \desc -> desc { _rank = maxRank }
104+ UF.setDescriptor var $ Descriptor content maxRank visitedMark copy
106− return maxRank
105+ return maxRank
107
106
108− else if mark /= visitedMark then
107+ else if mark == visitedMark then
108+ return rank
109
109
110+ else
110− do let minRank = min groupRank rank
111+ do let minRank = min groupRank rank
112+ -- TODO how can minRank ever be groupRank?
111− UF.setDescriptor var (descriptor { _mark = visitedMark, _rank = minRank })
113+ UF.setDescriptor var $ Descriptor content minRank visitedMark copy
112− return minRank
114+ return minRank
113−
114− else
115−
116− return rank
117
115
118
116
119adjustRankContent :: Int -> Int -> Int -> Content -> IO Int
117adjustRankContent :: Int -> Int -> Int -> Content -> IO Int
@@ -128,27 +126,25 @@ adjustRankContent youngMark visitedMark groupRank content =
128 Var _ _ _ ->
126 Var _ _ _ ->
129 return groupRank
127 return groupRank
130
128
131− Alias _ args realVar ->
129+ Alias _ args _ ->
132− -- TODO do you have to crawl the args?
130+ -- THEORY: anything in the realVar would be outermostRank
133− do realRank <- go realVar
134− foldM (\rank (_, argVar) -> max rank <$> go argVar) realRank args
131+ foldM (\rank (_, argVar) -> max rank <$> go argVar) outermostRank args
135−
136− Structure (App1 _ []) ->
137− return groupRank
138
132
139− Structure (App1 _ (first:rest)) ->
133+ Structure flatType ->
140− do firstRank <- go first
134+ case flatType of
135+ App1 _ args ->
141− foldM (\rank arg -> max rank <$> go arg) firstRank rest
136+ foldM (\rank arg -> max rank <$> go arg) outermostRank args
142
137
143− Structure (Fun1 arg result) ->
138+ Fun1 arg result ->
144− max <$> go arg <*> go result
139+ max <$> go arg <*> go result
145
140
146− Structure EmptyRecord1 ->
141+ EmptyRecord1 ->
142+ -- THEORY: an empty record never needs to get generalized
147− return outermostRank
143+ return outermostRank
148
144
149− Structure (Record1 fields extension) ->
145+ Record1 fields extension ->
150− do extRank <- go extension
146+ do extRank <- go extension
151− foldM (\rank field -> max rank <$> go field) extRank fields
147+ foldM (\rank field -> max rank <$> go field) extRank fields
152
148
153
149
154
150