@@ -86,34 +86,32 @@ rigidify content =
8686 content
8787
8888
89−-- adjust the ranks of variables such that ranks never increase as you
90−-- move deeper into a variable.
89+
90+-- ADJUST RANK
91+
92+--
93+-- Adjust variable ranks such that ranks never increase as you move deeper.
94+-- This way the outermost rank is representative of the entire structure.
95+--
9196adjustRank :: Int -> Int -> Int -> Variable -> IO Int
9297adjustRank youngMark visitedMark groupRank var =
9398 {-# SCC elm_compiler_type_adjust #-}
94− do descriptor <- 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
101−
102− do -- Set the variable as marked first because it may be cyclic.
103− UF.modifyDescriptor var $ \desc -> desc { _mark = visitedMark }
104− maxRank <- adjustRankContent youngMark visitedMark groupRank content
105− UF.modifyDescriptor var $ \desc -> desc { _rank = maxRank }
106− return maxRank
99+ do (Descriptor content rank mark copy) <- UF.descriptor var
100+ if mark == youngMark then
101+ do -- Set the variable as marked first because it may be cyclic.
102+ UF.setDescriptor var $ Descriptor content rank visitedMark copy
103+ maxRank <- adjustRankContent youngMark visitedMark groupRank content
104+ UF.setDescriptor var $ Descriptor content maxRank visitedMark copy
105+ return maxRank
107106
108− else if mark /= visitedMark then
107+ else if mark == visitedMark then
108+ return rank
109109
110− do let minRank = min groupRank rank
111− UF.setDescriptor var (descriptor { _mark = visitedMark, _rank = minRank })
112− return minRank
113−
114− else
115−
116− return rank
110+ else
111+ do let minRank = min groupRank rank
112+ -- TODO how can minRank ever be groupRank?
113+ UF.setDescriptor var $ Descriptor content minRank visitedMark copy
114+ return minRank
117115
118116
119117adjustRankContent :: Int -> Int -> Int -> Content -> IO Int
@@ -128,27 +126,25 @@ adjustRankContent youngMark visitedMark groupRank content =
128126 Var _ _ _ ->
129127 return groupRank
130128
131− Alias _ args realVar ->
132− -- TODO do you have to crawl the args?
133− do realRank <- go realVar
134− foldM (\rank (_, argVar) -> max rank <$> go argVar) realRank args
135−
136− Structure (App1 _ []) ->
137− return groupRank
129+ Alias _ args _ ->
130+ -- THEORY: anything in the realVar would be outermostRank
131+ foldM (\rank (_, argVar) -> max rank <$> go argVar) outermostRank args
138132
139− Structure (App1 _ (first:rest)) ->
140− do firstRank <- go first
141− foldM (\rank arg -> max rank <$> go arg) firstRank rest
133+ Structure flatType ->
134+ case flatType of
135+ App1 _ args ->
136+ foldM (\rank arg -> max rank <$> go arg) outermostRank args
142137
143− Structure (Fun1 arg result) ->
144− max <$> go arg <*> go result
138+ Fun1 arg result ->
139+ max <$> go arg <*> go result
145140
146− Structure EmptyRecord1 ->
147− return outermostRank
141+ EmptyRecord1 ->
142+ -- THEORY: an empty record never needs to get generalized
143+ return outermostRank
148144
149− Structure (Record1 fields extension) ->
150− do extRank <- go extension
151− foldM (\rank field -> max rank <$> go field) extRank fields
145+ Record1 fields extension ->
146+ do extRank <- go extension
147+ foldM (\rank field -> max rank <$> go field) extRank fields
152148
153149
154150