on master help sign in
Slightly more readable
bc21d05iko
src/Tix/Typechecker.hs+8−6
@@ -185,16 +185,18 @@ newtype DeBrujinContext = DeBrujinContext (Sum Int)
185instance Act DeBrujinContext DeBrujin where
185instance Act DeBrujinContext DeBrujin where
186 act (DeBrujinContext (Sum n)) (DeBrujin i j) = DeBrujin (i + n) j
186 act (DeBrujinContext (Sum n)) (DeBrujin i j) = DeBrujin (i + n) j
187
187
188+type TDeBrujinMap = ShiftedMap DeBrujinContext TypeVariable DeBrujin
189+
188close :: Range TypeVariable -> NType -> NType
190close :: Range TypeVariable -> NType -> NType
189close range =
191close range =
190 run
192 run
191− . evalState @(ShiftedMap DeBrujinContext TypeVariable DeBrujin) mempty
193+ . evalState @TDeBrujinMap mempty
192 . runReader @Int 0
194 . runReader @Int 0
193 . evalState @Int 0
195 . evalState @Int 0
194 . close'
196 . close'
195 where
197 where
196 -- State is the sequential number, Reader is the binding context number
198 -- State is the sequential number, Reader is the binding context number
197− close' :: NType -> Eff '[State Int, Reader Int, State (ShiftedMap DeBrujinContext TypeVariable DeBrujin)] NType
199+ close' :: NType -> Eff '[State Int, Reader Int, State TDeBrujinMap] NType
198 close' x@(NAtomic _) = return x
200 close' x@(NAtomic _) = return x
199 close' x@(NBrujin _) = return x
201 close' x@(NBrujin _) = return x
200 close' (NTypeVariable tv) | tv `R.member` range = NBrujin <$> newbrujin tv
202 close' (NTypeVariable tv) | tv `R.member` range = NBrujin <$> newbrujin tv
@@ -203,18 +205,18 @@ close range =
203 close' (NAttrSet x) = bndCtx $ NAttrSet <$> traverse close' x
205 close' (NAttrSet x) = bndCtx $ NAttrSet <$> traverse close' x
204
206
205 bndCtx m = do
207 bndCtx m = do
206− modify @(ShiftedMap DeBrujinContext TypeVariable DeBrujin) (SM.shift 1)
208+ modify @TDeBrujinMap (SM.shift 1)
207 x <- local @Int (+ 1) m
209 x <- local @Int (+ 1) m
208− modify @(ShiftedMap DeBrujinContext TypeVariable DeBrujin) (SM.shift (-1))
210+ modify @TDeBrujinMap (SM.shift (-1))
209 return x
211 return x
210 newbrujin t = do
212 newbrujin t = do
211− get @(ShiftedMap DeBrujinContext TypeVariable DeBrujin) <&> SM.lookup t >>= \case
213+ get @TDeBrujinMap <&> SM.lookup t >>= \case
212 Nothing -> do
214 Nothing -> do
213 i <- ask
215 i <- ask
214 j <- get
216 j <- get
215 modify @Int (+ 1)
217 modify @Int (+ 1)
216 let x = DeBrujin i j
218 let x = DeBrujin i j
217− modify @(ShiftedMap DeBrujinContext TypeVariable DeBrujin) (SM.insert t x)
219+ modify @TDeBrujinMap (SM.insert t x)
218 return x
220 return x
219 Just x -> return x
221 Just x -> return x
220
222