git.iko.soy/elk
on master help sign in
Switch adjustRank to use IO directly, improving performance
c4c5702Evan Czaplicki
src/Type/Solve.hs+9−10
compare with master
unifiedsplit
@@ -37,7 +37,7 @@ generalize youngPool =
37 -- start at low ranks so that we only have to pass
37 -- start at low ranks so that we only have to pass
38 -- over the information once.
38 -- over the information once.
39 visitedMark <- TS.uniqueMark
39 visitedMark <- TS.uniqueMark
40− forM_ (Map.toList rankDict) $ \(poolRank, vars) ->
40+ liftIO $ forM_ (Map.toList rankDict) $ \(poolRank, vars) ->
41 forM_ vars (adjustRank youngMark visitedMark poolRank)
41 forM_ vars (adjustRank youngMark visitedMark poolRank)
42
42
43 -- For variables that have rank lowerer than youngRank, register them in
43 -- For variables that have rank lowerer than youngRank, register them in
@@ -82,32 +82,30 @@ rigidify content =
82
82
83-- adjust the ranks of variables such that ranks never increase as you
83-- adjust the ranks of variables such that ranks never increase as you
84-- move deeper into a variable.
84-- move deeper into a variable.
85−adjustRank :: Int -> Int -> Int -> Variable -> TS.Solver Int
85+adjustRank :: Int -> Int -> Int -> Variable -> IO Int
86adjustRank youngMark visitedMark groupRank var =
86adjustRank youngMark visitedMark groupRank var =
87− do descriptor <- liftIO $ UF.descriptor var
87+ do descriptor <- UF.descriptor var
88 adjustRankHelp youngMark visitedMark groupRank var descriptor
88 adjustRankHelp youngMark visitedMark groupRank var descriptor
89
89
90
90
91−adjustRankHelp :: Int -> Int -> Int -> Variable -> Descriptor -> TS.Solver Int
91+adjustRankHelp :: Int -> Int -> Int -> Variable -> Descriptor -> IO Int
92adjustRankHelp youngMark visitedMark groupRank var descriptor@(Descriptor content rank mark _) =
92adjustRankHelp youngMark visitedMark groupRank var descriptor@(Descriptor content rank mark _) =
93 if mark == youngMark then
93 if mark == youngMark then
94
94
95 do -- Set the variable as marked first because it may be cyclic.
95 do -- Set the variable as marked first because it may be cyclic.
96− liftIO $ UF.modifyDescriptor var $ \desc ->
96+ UF.modifyDescriptor var $ \desc -> desc { _mark = visitedMark }
97− desc { _mark = visitedMark }
98
97
99 maxRank <-
98 maxRank <-
100 adjustRankContent youngMark visitedMark groupRank content
99 adjustRankContent youngMark visitedMark groupRank content
101
100
102− liftIO $ UF.modifyDescriptor var $ \desc ->
101+ UF.modifyDescriptor var $ \desc -> desc { _rank = maxRank }
103− desc { _rank = maxRank }
104
102
105 return maxRank
103 return maxRank
106
104
107 else if mark /= visitedMark then
105 else if mark /= visitedMark then
108
106
109 do let minRank = min groupRank rank
107 do let minRank = min groupRank rank
110− liftIO $ UF.setDescriptor var (descriptor { _mark = visitedMark, _rank = minRank })
108+ UF.setDescriptor var (descriptor { _mark = visitedMark, _rank = minRank })
111 return minRank
109 return minRank
112
110
113 else
111 else
@@ -115,7 +113,7 @@ adjustRankHelp youngMark visitedMark groupRank var descriptor@(Descriptor conten
115 return rank
113 return rank
116
114
117
115
118−adjustRankContent :: Int -> Int -> Int -> Content -> TS.Solver Int
116+adjustRankContent :: Int -> Int -> Int -> Content -> IO Int
119adjustRankContent youngMark visitedMark groupRank content =
117adjustRankContent youngMark visitedMark groupRank content =
120 let
118 let
121 go = adjustRank youngMark visitedMark groupRank
119 go = adjustRank youngMark visitedMark groupRank
@@ -131,6 +129,7 @@ adjustRankContent youngMark visitedMark groupRank content =
131 return groupRank
129 return groupRank
132
130
133 Alias _ args realVar ->
131 Alias _ args realVar ->
132+ -- TODO do you have to crawl the args?
134 do realRank <- go realVar
133 do realRank <- go realVar
135 foldM (\rank (_, argVar) -> max rank <$> go argVar) realRank args
134 foldM (\rank (_, argVar) -> max rank <$> go argVar) realRank args
136
135