@@ -65,25 +65,15 @@ generalize youngPool = do
6565-- move deeper into a variable.
6666adjustRank :: Int -> Int -> Int -> Variable -> StateT TS.SolverState IO Int
6767adjustRank youngMark visitedMark groupRank variable =
68− let adjust = adjustRank youngMark visitedMark groupRank in
6968 do desc <- liftIO $ UF.descriptor variable
7069 case () of
7170 () | mark desc == youngMark ->
7271 do -- Set the variable as marked first because it may be cyclic.
73− liftIO $ UF.modifyDescriptor variable $ \desc -> desc { mark = visitedMark }
74− rank' <- case structure desc of
75− Nothing -> return groupRank
76− Just term ->
77− case term of
78− App1 a b -> max `liftM` adjust a `ap` adjust b
79− Fun1 a b -> max `liftM` adjust a `ap` adjust b
80− Var1 x -> adjust x
81− EmptyRecord1 -> return outermostRank
82− Record1 fields extension ->
83− do ranks <- mapM adjust (concat (Map.elems fields))
84− rnk <- adjust extension
85− return . maximum $ rnk : ranks
86− liftIO $ UF.modifyDescriptor variable $ \desc -> desc { rank = rank' }
72+ liftIO $ UF.modifyDescriptor variable $ \desc ->
73+ desc { mark = visitedMark }
74+ rank' <- maybe (return groupRank) adjustTerm (structure desc)
75+ liftIO $ UF.modifyDescriptor variable $ \desc ->
76+ desc { rank = rank' }
8777 return rank'
8878
8979 | mark desc /= visitedMark ->
@@ -93,6 +83,19 @@ adjustRank youngMark visitedMark groupRank variable =
9383
9484 | otherwise -> return (rank desc)
9585
86+ where
87+ adjust = adjustRank youngMark visitedMark groupRank
88+
89+ adjustTerm term =
90+ case term of
91+ App1 a b -> max `liftM` adjust a `ap` adjust b
92+ Fun1 a b -> max `liftM` adjust a `ap` adjust b
93+ Var1 x -> adjust x
94+ EmptyRecord1 -> return outermostRank
95+ Record1 fields extension ->
96+ do ranks <- mapM adjust (concat (Map.elems fields))
97+ rnk <- adjust extension
98+ return . maximum $ rnk : ranks
9699
97100
98101solve :: TypeConstraint -> StateT TS.SolverState IO ()