c77af53 · elk · git.iko.soy

6import Control.Monad.Except (ExceptT, throwError)

7import qualified Data.List as List

8import qualified Data.Map as Map

9−import qualified Data.Traversable as T

9+import qualified Data.Foldable as F

10import qualified Data.UnionFind.IO as UF

11

12import qualified Reporting.Annotation as A

36 -- start at low ranks so that we only have to pass

37 -- over the information once.

38 visitedMark <- TS.uniqueMark

39− forM (Map.toList rankDict) $ \(poolRank, vars) ->

39+ forM_ (Map.toList rankDict) $ \(poolRank, vars) ->

40 mapM (adjustRank youngMark visitedMark poolRank) vars

41

42 -- For variables that have rank lowerer than youngRank, register them in

46 if isRedundant then return var else TS.register var

47

48 let rankDict' = Map.delete youngRank rankDict

49− T.traverse (mapM registerIfNotRedundant) rankDict'

49+ F.traverse_ (mapM registerIfNotRedundant) rankDict'

50

51 -- For variables with rank youngRank

52 -- If rank < youngRank: register in oldPool

218 case scheme of

219 Scheme [] [] constraint header ->

220 do actuallySolve constraint

221− T.traverse flatten header

221+ traverse flatten header

222

223 Scheme rigidQuantifiers flexibleQuantifiers constraint header ->

224 do let quantifiers = rigidQuantifiers ++ flexibleQuantifiers

228 freshPool <- TS.nextRankPool

229 TS.switchToPool freshPool

230 mapM_ TS.introduce quantifiers

231− header' <- T.traverse flatten header

231+ header' <- traverse flatten header

232 actuallySolve constraint

233

234 youngPool <- TS.getPool

265

266occurs :: (String, A.Located Variable) -> TS.Solver ()

267occurs (name, A.A region variable) =

268− do isInfinite <- liftIO $ occursHelp [] variable

268+ do hasOccurred <- liftIO $ occursHelp [] variable

269− case isInfinite of

269+ case hasOccurred of

270 False ->

271 return ()

272