{-# LANGUAGE PatternGuards, ScopedTypeVariables, BangPatterns, Rank2Types #-}
module Text.EditDistance.Bits (
levenshteinDistance, levenshteinDistanceWithLengths, restrictedDamerauLevenshteinDistance, restrictedDamerauLevenshteinDistanceWithLengths
) where
import Data.Bits
import Data.Char
import Data.Word
import Data.List
import qualified Data.IntMap as IM
{-# INLINE foldl'3k #-}
foldl'3k :: (forall res. (a, b, c) -> x -> ((a, b, c) -> res) -> res)
-> (a, b, c) -> [x] -> (a, b, c)
foldl'3k :: (forall res. (a, b, c) -> x -> ((a, b, c) -> res) -> res)
-> (a, b, c) -> [x] -> (a, b, c)
foldl'3k forall res. (a, b, c) -> x -> ((a, b, c) -> res) -> res
f = (a, b, c) -> [x] -> (a, b, c)
go
where go :: (a, b, c) -> [x] -> (a, b, c)
go (!a
_, !b
_, !c
_) [x]
_ | Bool
False = (a, b, c)
forall a. HasCallStack => a
undefined
go ( a
a, b
b, c
c) [] = (a
a, b
b, c
c)
go ( a
a, b
b, c
c) (x
x:[x]
xs) = (a, b, c) -> x -> ((a, b, c) -> (a, b, c)) -> (a, b, c)
forall res. (a, b, c) -> x -> ((a, b, c) -> res) -> res
f (a
a, b
b, c
c) x
x (((a, b, c) -> (a, b, c)) -> (a, b, c))
-> ((a, b, c) -> (a, b, c)) -> (a, b, c)
forall a b. (a -> b) -> a -> b
$ \(a, b, c)
abc -> (a, b, c) -> [x] -> (a, b, c)
go (a, b, c)
abc [x]
xs
{-# INLINE foldl'5k #-}
foldl'5k :: (forall res. (a, b, c, d, e) -> x -> ((a, b, c, d, e) -> res) -> res)
-> (a, b, c, d, e) -> [x] -> (a, b, c, d, e)
foldl'5k :: (forall res.
(a, b, c, d, e) -> x -> ((a, b, c, d, e) -> res) -> res)
-> (a, b, c, d, e) -> [x] -> (a, b, c, d, e)
foldl'5k forall res. (a, b, c, d, e) -> x -> ((a, b, c, d, e) -> res) -> res
f = (a, b, c, d, e) -> [x] -> (a, b, c, d, e)
go
where go :: (a, b, c, d, e) -> [x] -> (a, b, c, d, e)
go (!a
_, !b
_, !c
_, !d
_, !e
_) [x]
_ | Bool
False = (a, b, c, d, e)
forall a. HasCallStack => a
undefined
go ( a
a, b
b, c
c, d
d, e
e) [] = (a
a, b
b, c
c, d
d, e
e)
go ( a
a, b
b, c
c, d
d, e
e) (x
x:[x]
xs) = (a, b, c, d, e)
-> x -> ((a, b, c, d, e) -> (a, b, c, d, e)) -> (a, b, c, d, e)
forall res. (a, b, c, d, e) -> x -> ((a, b, c, d, e) -> res) -> res
f (a
a, b
b, c
c, d
d, e
e) x
x (((a, b, c, d, e) -> (a, b, c, d, e)) -> (a, b, c, d, e))
-> ((a, b, c, d, e) -> (a, b, c, d, e)) -> (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ \(a, b, c, d, e)
abcde -> (a, b, c, d, e) -> [x] -> (a, b, c, d, e)
go (a, b, c, d, e)
abcde [x]
xs
levenshteinDistance :: String -> String -> Int
levenshteinDistance :: String -> String -> Int
levenshteinDistance String
str1 String
str2 = Int -> Int -> String -> String -> Int
levenshteinDistanceWithLengths Int
m Int
n String
str1 String
str2
where
m :: Int
m = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str1
n :: Int
n = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str2
levenshteinDistanceWithLengths :: Int -> Int -> String -> String -> Int
levenshteinDistanceWithLengths :: Int -> Int -> String -> String -> Int
levenshteinDistanceWithLengths !Int
m !Int
n String
str1 String
str2
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
then Word64 -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
levenshteinDistance' (Word64
forall a. HasCallStack => a
undefined :: Word64) Int
m Int
n String
str1 String
str2
else Integer -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
levenshteinDistance' (Integer
forall a. HasCallStack => a
undefined :: Integer) Int
m Int
n String
str1 String
str2
| Bool
otherwise = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
then Word64 -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
levenshteinDistance' (Word64
forall a. HasCallStack => a
undefined :: Word64) Int
n Int
m String
str2 String
str1
else Integer -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
levenshteinDistance' (Integer
forall a. HasCallStack => a
undefined :: Integer) Int
n Int
m String
str2 String
str1
{-# SPECIALIZE levenshteinDistance' :: Word64 -> Int -> Int -> String -> String -> Int #-}
{-# SPECIALIZE levenshteinDistance' :: Integer -> Int -> Int -> String -> String -> Int #-}
levenshteinDistance' :: (Num bv, Bits bv) => bv -> Int -> Int -> String -> String -> Int
levenshteinDistance' :: bv -> Int -> Int -> String -> String -> Int
levenshteinDistance' (bv
_bv_dummy :: bv) !Int
m !Int
n String
str1 String
str2
| [] <- String
str1 = Int
n
| Bool
otherwise = (bv, bv, Int) -> Int
forall a b c. (a, b, c) -> c
extractAnswer ((bv, bv, Int) -> Int) -> (bv, bv, Int) -> Int
forall a b. (a -> b) -> a -> b
$ (forall res.
(bv, bv, Int) -> Char -> ((bv, bv, Int) -> res) -> res)
-> (bv, bv, Int) -> String -> (bv, bv, Int)
forall a b c x.
(forall res. (a, b, c) -> x -> ((a, b, c) -> res) -> res)
-> (a, b, c) -> [x] -> (a, b, c)
foldl'3k (IntMap bv
-> bv
-> bv
-> (bv, bv, Int)
-> Char
-> ((bv, bv, Int) -> res)
-> res
forall bv res.
(Num bv, Bits bv) =>
IntMap bv
-> bv
-> bv
-> (bv, bv, Int)
-> Char
-> ((bv, bv, Int) -> res)
-> res
levenshteinDistanceWorker (String -> IntMap bv
forall bv. (Num bv, Bits bv) => String -> IntMap bv
matchVectors String
str1) bv
top_bit_mask bv
vector_mask) (bv
m_ones, bv
0, Int
m) String
str2
where m_ones :: bv
m_ones@bv
vector_mask = (bv
2 bv -> Int -> bv
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
m) bv -> bv -> bv
forall a. Num a => a -> a -> a
- bv
1
top_bit_mask :: bv
top_bit_mask = bv
1 bv -> Int -> bv
forall a. Bits a => a -> Int -> a
`shiftL` (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) :: bv
extractAnswer :: (a, b, c) -> c
extractAnswer (a
_, b
_, c
distance) = c
distance
{-# SPECIALIZE INLINE levenshteinDistanceWorker :: IM.IntMap Word64 -> Word64 -> Word64 -> (Word64, Word64, Int) -> Char -> ((Word64, Word64, Int) -> res) -> res #-}
{-# SPECIALIZE INLINE levenshteinDistanceWorker :: IM.IntMap Integer -> Integer -> Integer -> (Integer, Integer, Int) -> Char -> ((Integer, Integer, Int) -> res) -> res #-}
levenshteinDistanceWorker :: (Num bv, Bits bv)
=> IM.IntMap bv -> bv -> bv -> (bv, bv, Int) -> Char
-> ((bv, bv, Int) -> res) -> res
levenshteinDistanceWorker :: IntMap bv
-> bv
-> bv
-> (bv, bv, Int)
-> Char
-> ((bv, bv, Int) -> res)
-> res
levenshteinDistanceWorker !IntMap bv
str1_mvs !bv
top_bit_mask !bv
vector_mask (!bv
vp, !bv
vn, !Int
distance) !Char
char2 (bv, bv, Int) -> res
k
= bv
vp' bv -> res -> res
`seq` bv
vn' bv -> res -> res
`seq` Int
distance'' Int -> res -> res
`seq` (bv, bv, Int) -> res
k (bv
vp', bv
vn', Int
distance'')
where
pm' :: bv
pm' = bv -> Int -> IntMap bv -> bv
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault bv
0 (Char -> Int
ord Char
char2) IntMap bv
str1_mvs
d0' :: bv
d0' = ((((bv
pm' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vp) bv -> bv -> bv
forall a. Num a => a -> a -> a
+ bv
vp) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vector_mask) bv -> bv -> bv
forall a. Bits a => a -> a -> a
`xor` bv
vp) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
pm' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
vn
hp' :: bv
hp' = bv
vn bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv -> bv -> bv
forall bv. (Num bv, Bits bv) => bv -> bv -> bv
sizedComplement bv
vector_mask (bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
vp)
hn' :: bv
hn' = bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vp
hp'_shift :: bv
hp'_shift = ((bv
hp' bv -> Int -> bv
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
1) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vector_mask
hn'_shift :: bv
hn'_shift = (bv
hn' bv -> Int -> bv
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vector_mask
vp' :: bv
vp' = bv
hn'_shift bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv -> bv -> bv
forall bv. (Num bv, Bits bv) => bv -> bv -> bv
sizedComplement bv
vector_mask (bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
hp'_shift)
vn' :: bv
vn' = bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
hp'_shift
distance' :: Int
distance' = if bv
hp' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
top_bit_mask bv -> bv -> Bool
forall a. Eq a => a -> a -> Bool
/= bv
0 then Int
distance Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
distance
distance'' :: Int
distance'' = if bv
hn' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
top_bit_mask bv -> bv -> Bool
forall a. Eq a => a -> a -> Bool
/= bv
0 then Int
distance' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
distance'
restrictedDamerauLevenshteinDistance :: String -> String -> Int
restrictedDamerauLevenshteinDistance :: String -> String -> Int
restrictedDamerauLevenshteinDistance String
str1 String
str2 = Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistanceWithLengths Int
m Int
n String
str1 String
str2
where
m :: Int
m = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str1
n :: Int
n = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str2
restrictedDamerauLevenshteinDistanceWithLengths :: Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistanceWithLengths :: Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistanceWithLengths !Int
m !Int
n String
str1 String
str2
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
then Word64 -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistance' (Word64
forall a. HasCallStack => a
undefined :: Word64) Int
m Int
n String
str1 String
str2
else Integer -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistance' (Integer
forall a. HasCallStack => a
undefined :: Integer) Int
m Int
n String
str1 String
str2
| Bool
otherwise = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
then Word64 -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistance' (Word64
forall a. HasCallStack => a
undefined :: Word64) Int
n Int
m String
str2 String
str1
else Integer -> Int -> Int -> String -> String -> Int
forall bv.
(Num bv, Bits bv) =>
bv -> Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistance' (Integer
forall a. HasCallStack => a
undefined :: Integer) Int
n Int
m String
str2 String
str1
{-# SPECIALIZE restrictedDamerauLevenshteinDistance' :: Word64 -> Int -> Int -> String -> String -> Int #-}
{-# SPECIALIZE restrictedDamerauLevenshteinDistance' :: Integer -> Int -> Int -> String -> String -> Int #-}
restrictedDamerauLevenshteinDistance' :: (Num bv, Bits bv) => bv -> Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistance' :: bv -> Int -> Int -> String -> String -> Int
restrictedDamerauLevenshteinDistance' (bv
_bv_dummy :: bv) !Int
m !Int
n String
str1 String
str2
| [] <- String
str1 = Int
n
| Bool
otherwise = (bv, bv, bv, bv, Int) -> Int
forall a b c d e. (a, b, c, d, e) -> e
extractAnswer ((bv, bv, bv, bv, Int) -> Int) -> (bv, bv, bv, bv, Int) -> Int
forall a b. (a -> b) -> a -> b
$ (forall res.
(bv, bv, bv, bv, Int)
-> Char -> ((bv, bv, bv, bv, Int) -> res) -> res)
-> (bv, bv, bv, bv, Int) -> String -> (bv, bv, bv, bv, Int)
forall a b c d e x.
(forall res.
(a, b, c, d, e) -> x -> ((a, b, c, d, e) -> res) -> res)
-> (a, b, c, d, e) -> [x] -> (a, b, c, d, e)
foldl'5k (IntMap bv
-> bv
-> bv
-> (bv, bv, bv, bv, Int)
-> Char
-> ((bv, bv, bv, bv, Int) -> res)
-> res
forall bv res.
(Num bv, Bits bv) =>
IntMap bv
-> bv
-> bv
-> (bv, bv, bv, bv, Int)
-> Char
-> ((bv, bv, bv, bv, Int) -> res)
-> res
restrictedDamerauLevenshteinDistanceWorker (String -> IntMap bv
forall bv. (Num bv, Bits bv) => String -> IntMap bv
matchVectors String
str1) bv
top_bit_mask bv
vector_mask) (bv
0, bv
0, bv
m_ones, bv
0, Int
m) String
str2
where m_ones :: bv
m_ones@bv
vector_mask = (bv
2 bv -> Int -> bv
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
m) bv -> bv -> bv
forall a. Num a => a -> a -> a
- bv
1
top_bit_mask :: bv
top_bit_mask = bv
1 bv -> Int -> bv
forall a. Bits a => a -> Int -> a
`shiftL` (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) :: bv
extractAnswer :: (a, b, c, d, e) -> e
extractAnswer (a
_, b
_, c
_, d
_, e
distance) = e
distance
{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistanceWorker :: IM.IntMap Word64 -> Word64 -> Word64 -> (Word64, Word64, Word64, Word64, Int) -> Char -> ((Word64, Word64, Word64, Word64, Int) -> res) -> res #-}
{-# SPECIALIZE INLINE restrictedDamerauLevenshteinDistanceWorker :: IM.IntMap Integer -> Integer -> Integer -> (Integer, Integer, Integer, Integer, Int) -> Char -> ((Integer, Integer, Integer, Integer, Int) -> res) -> res #-}
restrictedDamerauLevenshteinDistanceWorker :: (Num bv, Bits bv) => IM.IntMap bv -> bv -> bv -> (bv, bv, bv, bv, Int) -> Char -> ((bv, bv, bv, bv, Int) -> res) -> res
restrictedDamerauLevenshteinDistanceWorker :: IntMap bv
-> bv
-> bv
-> (bv, bv, bv, bv, Int)
-> Char
-> ((bv, bv, bv, bv, Int) -> res)
-> res
restrictedDamerauLevenshteinDistanceWorker !IntMap bv
str1_mvs !bv
top_bit_mask !bv
vector_mask (!bv
pm, !bv
d0, !bv
vp, !bv
vn, !Int
distance) !Char
char2 (bv, bv, bv, bv, Int) -> res
k
= bv
pm' bv -> res -> res
`seq` bv
d0' bv -> res -> res
`seq` bv
vp' bv -> res -> res
`seq` bv
vn' bv -> res -> res
`seq` Int
distance'' Int -> res -> res
`seq` (bv, bv, bv, bv, Int) -> res
k (bv
pm', bv
d0', bv
vp', bv
vn', Int
distance'')
where
pm' :: bv
pm' = bv -> Int -> IntMap bv -> bv
forall a. a -> Int -> IntMap a -> a
IM.findWithDefault bv
0 (Char -> Int
ord Char
char2) IntMap bv
str1_mvs
d0' :: bv
d0' = ((((bv -> bv -> bv
forall bv. (Num bv, Bits bv) => bv -> bv -> bv
sizedComplement bv
vector_mask bv
d0) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
pm') bv -> Int -> bv
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
pm)
bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. ((((bv
pm' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vp) bv -> bv -> bv
forall a. Num a => a -> a -> a
+ bv
vp) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vector_mask) bv -> bv -> bv
forall a. Bits a => a -> a -> a
`xor` bv
vp) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
pm' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
vn
hp' :: bv
hp' = bv
vn bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv -> bv -> bv
forall bv. (Num bv, Bits bv) => bv -> bv -> bv
sizedComplement bv
vector_mask (bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
vp)
hn' :: bv
hn' = bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vp
hp'_shift :: bv
hp'_shift = ((bv
hp' bv -> Int -> bv
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
1) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vector_mask
hn'_shift :: bv
hn'_shift = (bv
hn' bv -> Int -> bv
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
vector_mask
vp' :: bv
vp' = bv
hn'_shift bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv -> bv -> bv
forall bv. (Num bv, Bits bv) => bv -> bv -> bv
sizedComplement bv
vector_mask (bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.|. bv
hp'_shift)
vn' :: bv
vn' = bv
d0' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
hp'_shift
distance' :: Int
distance' = if bv
hp' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
top_bit_mask bv -> bv -> Bool
forall a. Eq a => a -> a -> Bool
/= bv
0 then Int
distance Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
distance
distance'' :: Int
distance'' = if bv
hn' bv -> bv -> bv
forall a. Bits a => a -> a -> a
.&. bv
top_bit_mask bv -> bv -> Bool
forall a. Eq a => a -> a -> Bool
/= bv
0 then Int
distance' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
distance'
{-# SPECIALIZE INLINE sizedComplement :: Word64 -> Word64 -> Word64 #-}
{-# SPECIALIZE INLINE sizedComplement :: Integer -> Integer -> Integer #-}
sizedComplement :: (Num bv, Bits bv) => bv -> bv -> bv
sizedComplement :: bv -> bv -> bv
sizedComplement bv
vector_mask bv
vect = bv
vector_mask bv -> bv -> bv
forall a. Bits a => a -> a -> a
`xor` bv
vect
{-# SPECIALIZE matchVectors :: String -> IM.IntMap Word64 #-}
{-# SPECIALIZE matchVectors :: String -> IM.IntMap Integer #-}
matchVectors :: (Num bv, Bits bv) => String -> IM.IntMap bv
matchVectors :: String -> IntMap bv
matchVectors = (Int, IntMap bv) -> IntMap bv
forall a b. (a, b) -> b
snd ((Int, IntMap bv) -> IntMap bv)
-> (String -> (Int, IntMap bv)) -> String -> IntMap bv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, IntMap bv) -> Char -> (Int, IntMap bv))
-> (Int, IntMap bv) -> String -> (Int, IntMap bv)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, IntMap bv) -> Char -> (Int, IntMap bv)
forall a a.
(Bits a, Integral a, Num a) =>
(a, IntMap a) -> Char -> (a, IntMap a)
go (Int
0 :: Int, IntMap bv
forall a. IntMap a
IM.empty)
where
go :: (a, IntMap a) -> Char -> (a, IntMap a)
go (!a
ix, !IntMap a
im) Char
char = let ix' :: a
ix' = a
ix a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
im' :: IntMap a
im' = (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith a -> a -> a
forall a. Bits a => a -> a -> a
(.|.) (Char -> Int
ord Char
char) (a
2 a -> a -> a
forall a b. (Num a, Integral b) => a -> b -> a
^ a
ix) IntMap a
im
in (a
ix', IntMap a
im')