Haskell刚性类型变量错误修复方案咨询

问题背景 #

我编写了一段使用Weisfeiler-Lehman同构测试判断两个图是否同构的Haskell代码。目前没有确定图同构的多项式时间算法，但这并非本次问题重点。

完整代码实现 #

导入语句 #

{-# LANGUAGE ScopedTypeVariables #-}
import Data.Hashable (Hashable)
import qualified Data.List as L
import Data.Map (Map)
import qualified Data.Map as Map
import Control.Arrow ((&&&))
import qualified Data.Hashable as H
import qualified Data.Function as F

主函数（iso） #

iso :: (Ord a, Ord b, Hashable a, Hashable b) => [a] -> [(a, a)] -> [b] -> [(b, b)] -> Bool
iso v1 e1 v2 e2 = m == n && go 0 Map.empty Map.empty [] []
  where
    ug1 = Map.unionWith (++) (Map.fromList $ map (, []) v1) (buildUG e1)
    ug2 = Map.unionWith (++) (Map.fromList $ map (, []) v2) (buildUG e2)
    m = length v1
    n = length v2

    -- 查找旧标签
    oldLabel = flip (Map.findWithDefault 1)
    -- 根据邻居和旧标签计算新标签
    label l = H.hash . L.sort . map (oldLabel l)
    canonical = L.sortBy (compare `F.on` fst) . map (head &&& length) . L.group
    
    -- 修复后的go函数类型签名：去掉局部forall，继承外层的a、b类型变量
    go :: Int -> Map a Int -> Map b Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
    go i l1 l2 c1 c2
      | i > n = False
      | otherwise = 
        let xs = map (label l1 . neighbors ug1) v1
            l1' = Map.fromList $ zip v1 xs
            ys = map (label l2 . neighbors ug2) v2
            l2' = Map.fromList $ zip v2 ys
            c1' = canonical xs
            c2' = canonical ys
        in (c1 == c1' && c2 == c2') || (c1' == c2' && go (i + 1) l1' l2' c1' c2')

辅助函数（图构建） #

type Graph a = Map a [a]

type Edge a = (a, a)

-- 构建有向图
buildG :: (Ord a) => [Edge a] -> Graph a
buildG = foldr merge Map.empty
  where
    -- insertWith 参数：键、合并函数（新值在前）、新值为单元素列表
    merge (u, v) = Map.insertWith ((:) . head) u [v]

-- 反转边
reverseE :: [Edge a] -> [Edge a]
reverseE = map (\(u, v) -> (v, u))

-- 构建无向图
-- 处理循环，确保同一顶点不重复出现
buildUG :: (Ord a) => [Edge a] -> Graph a
buildUG edges = Map.unionWith ((L.nub .) . (++)) g g'
  where
    g = buildG edges
    g' = (buildG . reverseE) edges

-- 获取顶点的邻居
neighbors :: (Ord a) => Graph a -> a -> [a]
neighbors = flip (Map.findWithDefault [])

错误现象 #

1. 省略go函数类型签名时：

• Couldn't match type ‘a’ with ‘b’
  Expected: Int
            -> Map a Int -> Map b Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
    Actual: Int
            -> Map a Int -> Map a Int -> [(Int, Int)] -> [(Int, Int)] -> Bool
  ‘a’ is a rigid type variable bound by
    the type signature for:
      iso :: forall a b.

2. 启用ScopedTypeVariables并显式指定forall a b后：

Couldn't match type ‘a0’ with ‘a1’
  Expected: Map a0 Int
    Actual: Map a1 Int

• Couldn't match type ‘a0’ with ‘b1’
  Expected: Map a0 Int
    Actual: Map b1 Int

修复原理 #

问题出在go函数的类型签名上：

• 当你在go里写forall a b时，这两个类型变量是局部新变量，和外层iso函数定义的a、b完全无关。
• 启用ScopedTypeVariables后，内层函数可以直接引用外层的类型变量，不需要重新声明forall a b。

修复步骤：

1. 在文件开头添加{-# LANGUAGE ScopedTypeVariables #-}扩展，让内层函数能访问外层的类型变量。
2. 修改go的类型签名，去掉局部的forall a b，让它直接使用外层iso的a、b类型变量。

这样，go里的Map a Int和Map b Int就会对应v1（[a]）和v2（[b]）的类型，类型匹配问题就解决了。

内容的提问来源于stack exchange，提问作者Abhijit Sarkar