有懂Haskell的吗 [委屈]

{-# LANGUAGE BangPatterns #-}

import qualified Data.Vector.Unboxed as V
import Data.Vector.Unboxed ((!), (//))

type UnionFind = V.Vector Int
type UnionFindM = State UnionFind

ask :: UnionFind -> Int -> (UnionFind, Int)
ask !vec !i = if vec ! i == i then (vec, i) else 
    let (!vec', !result) = ask vec $ vec ! i in
        (vec' // [(i, result)], result)

cat :: UnionFind -> Int -> Int -> UnionFind
cat !vec !x !y = let (!vec', !x') = ask vec x in
    let (!vec'', !y') = ask vec' y in
        vec // [(x', y')]

resolve :: Int -> UnionFind -> IO ()
resolve 0 _ = return ()
resolve !n !uf = do
    [!z, !x, !y] <- map read . words <$> getLine :: IO [Int]

    !uf' <- if z == 1 then return $ cat uf x y else 
        let (!vec, !x') = ask uf x
            (!vec', !y') = ask vec y in 
            putStrLn (if x' == y' then "Y" else "N") >>= const (return vec')

    resolve (n - 1) uf'

main :: IO ()
main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]

    resolve m $ V.generate (n + 1) id

    return ()

即便是路径压缩还是 T 了三个点。。。
可能是 Haskell 本身的性能问题
但还有没有办法继续优化呢？