on master help sign in
Switch adjustRank to use IO directly, improving performance
commitc4c570233293bcdf399e562cf241ee17c60e33b4 authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 11 May 2017, 20:04 (9 years ago) parentae0c7e2
1 file changed+9−10
src/Type/Solve.hs+9−10
src/Type/Solve.hs+9−10
@@ -37,7 +37,7 @@ generalize youngPool =
3737 -- start at low ranks so that we only have to pass
3838 -- over the information once.
3939 visitedMark <- TS.uniqueMark
40− forM_ (Map.toList rankDict) $ \(poolRank, vars) ->
40+ liftIO $ forM_ (Map.toList rankDict) $ \(poolRank, vars) ->
4141 forM_ vars (adjustRank youngMark visitedMark poolRank)
4242
4343 -- For variables that have rank lowerer than youngRank, register them in
@@ -82,32 +82,30 @@ rigidify content =
8282
8383-- adjust the ranks of variables such that ranks never increase as you
8484-- move deeper into a variable.
85−adjustRank :: Int -> Int -> Int -> Variable -> TS.Solver Int
85+adjustRank :: Int -> Int -> Int -> Variable -> IO Int
8686adjustRank youngMark visitedMark groupRank var =
87− do descriptor <- liftIO $ UF.descriptor var
87+ do descriptor <- UF.descriptor var
8888 adjustRankHelp youngMark visitedMark groupRank var descriptor
8989
9090
91−adjustRankHelp :: Int -> Int -> Int -> Variable -> Descriptor -> TS.Solver Int
91+adjustRankHelp :: Int -> Int -> Int -> Variable -> Descriptor -> IO Int
9292adjustRankHelp youngMark visitedMark groupRank var descriptor@(Descriptor content rank mark _) =
9393 if mark == youngMark then
9494
9595 do -- Set the variable as marked first because it may be cyclic.
96− liftIO $ UF.modifyDescriptor var $ \desc ->
97− desc { _mark = visitedMark }
96+ UF.modifyDescriptor var $ \desc -> desc { _mark = visitedMark }
9897
9998 maxRank <-
10099 adjustRankContent youngMark visitedMark groupRank content
101100
102− liftIO $ UF.modifyDescriptor var $ \desc ->
103− desc { _rank = maxRank }
101+ UF.modifyDescriptor var $ \desc -> desc { _rank = maxRank }
104102
105103 return maxRank
106104
107105 else if mark /= visitedMark then
108106
109107 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 })
111109 return minRank
112110
113111 else
@@ -115,7 +113,7 @@ adjustRankHelp youngMark visitedMark groupRank var descriptor@(Descriptor conten
115113 return rank
116114
117115
118−adjustRankContent :: Int -> Int -> Int -> Content -> TS.Solver Int
116+adjustRankContent :: Int -> Int -> Int -> Content -> IO Int
119117adjustRankContent youngMark visitedMark groupRank content =
120118 let
121119 go = adjustRank youngMark visitedMark groupRank
@@ -131,6 +129,7 @@ adjustRankContent youngMark visitedMark groupRank content =
131129 return groupRank
132130
133131 Alias _ args realVar ->
132+ -- TODO do you have to crawl the args?
134133 do realRank <- go realVar
135134 foldM (\rank (_, argVar) -> max rank <$> go argVar) realRank args
136135