Haskell中distinct函数归约规则及自动展开工具咨询

背景 #

我正在通过fp-course学习Haskell，已经实现了distinct函数，但对它的具体归约过程存疑，尤其是不确定State何时将集合传递给foldRight。我给相关函数添加了trace来追踪执行步骤，但手动展开代码很难和GHC的实际执行流程一致，希望找到能自动完成这种代码展开的工具。

带trace的相关代码 #

distinct ::
  Ord a =>
  List a
  -> List a
distinct as = trace "distinct" $ eval (filtering filterFunc as) S.empty
                where filterFunc a = trace "filterFunc" (State $ \set -> trace "state" (if S.member a set
                                                                                         then (False, set)
                                                                                         else (True, S.insert a set)))

eval ::
  State s a
  -> s
  -> a
eval st s = trace "eval" (fst' $ runState st s)

fst' = trace "fst" fst

doFunc f s = trace "doFunc" (f s)

runState ::
  State s a
  -> s
  -> (a, s)
runState (State f) s = trace "runState" (doFunc f s)

filtering ::
  Applicative k =>
  (a -> k Bool)
  -> List a
  -> k (List a)
filtering p = trace "filtering" (foldRight f (pure Nil))
                where f a = trace "filtering where" (lift2 (\b as -> bool as (a :. as) b) (p a))

foldRight :: (a -> b -> b) -> b -> List a -> b
foldRight _ b Nil      = b
foldRight f b (h :. t) = trace "foldRight" (f h (foldRight f b t))

执行结果 #

执行a = distinct (1 :. 2 :. 3 :. 3 :. 1 :. Nil :: List Int)，最终得到结果1 :. 2 :. 3 :. Nil，trace输出如下：

>> a
distinct
eval
fst
runState
doFunc
filtering
foldRight
filtering where
runState
doFunc
runState
doFunc
filterFunc
state
foldRight
[1runState
doFunc
foldRight
filtering where
runState
doFunc
runState
doFunc
filterFunc
state
foldRight
,2runState
doFunc
foldRight
filtering where
runState
doFunc
runState
doFunc
filterFunc
state
foldRight
,3runState
doFunc
foldRight
filtering where
runState
doFunc
runState
doFunc
filterFunc
state
runState
doFunc
foldRight
filtering where
runState
doFunc
runState
doFunc
filterFunc
state
runState
doFunc
]

手动展开尝试（部分步骤） #

distinct (1 :. 2 :. 3 :. 3 :. 1 :. Nil :: List Int)

------------------------------------------------------------------------------
| step 1: Expand distinct
| distinct as = trace "distinct" eval (filtering filterFunc as) S.empty
|  where filterFunc a = State $ \set -> if S.member a set
|                                       then (False, set)
|                                       else (True, S.insert a set)
------------------------------------------------------------------------------
eval (filtering filterFunc (1 :. 2 :. 1 :. Nil)) S.empty
  where filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)
                                       
------------------------------------------------------------------------------
| step 2: Expand eval
| eval st s = trace "eval" fst' $ runState st s
------------------------------------------------------------------------------
fst' (runState (filtering filterFunc (1 :. 2 :. 1 :. Nil)) S.empty)
  where filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)

------------------------------------------------------------------------------
| step 3: Expend fst
| (a, b) -> trace "fst" a
------------------------------------------------------------------------------
key
  where (key, value) = (runState (filtering filterFunc (1 :. 2 :. 1 :. Nil)) S.empty)
        filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)

------------------------------------------------------------------------------
| step 4: Expand runState
| runState (State f) s = trace "runState" (doFunc f s)
------------------------------------------------------------------------------
key
  where (key, value) = doFunc f s
        doFunc f s = (runState (filtering filterFunc (1 :. 2 :. 1 :. Nil)) S.empty)
        filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)

------------------------------------------------------------------------------
| step 5: Expand doFunc
| doFunc ff ss = trace "doFunc" (ff ss)
------------------------------------------------------------------------------
key
  where (key, value) = doFunc ff ss
        doFunc ff ss = ff ss
        ff ss = (runState (filtering filterFunc (1 :. 2 :. 1 :. Nil)) S.empty)
        filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)

------------------------------------------------------------------------------
| step 6: Expand filtering
| 
|  filtering p = trace "filtering" (foldRight f (pure Nil))
|                  where f a = trace "filtering where" (lift2 (\b as -> bool as (a :. as) b) (p a))
------------------------------------------------------------------------------
key
  where (key, value) = doFunc ff ss
        doFunc ff ss = ff ss

        ff ss = (runState (foldRight f (pure Nil) (1 :. 2 :. 1 :. Nil)) S.empty)
          where f a = lift2 (\b as -> bool as (a :. as) b) (p a)
        p = filterFunc

        filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)

------------------------------------------------------------------------------
| step 7: Expand foldRight
| 
| foldRight :: (a -> b -> b) -> b -> List a -> b
| foldRight _ b Nil      = b
| foldRight f b (h :. t) = trace "foldRight" (f h (foldRight f b t))
------------------------------------------------------------------------------
key
  where (key, value) = doFunc ff ss
        doFunc ff ss = ff ss

        ff ss = (runState (f 1 (foldRight f (pure Nil) (1 :. 2 :. 1 :. Nil))) S.empty)
          where f a = lift2 (\b as -> bool as (a :. as) b) (p a)
        p = filterFunc

        filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)

------------------------------------------------------------------------------
| step 8: Expand filtering where
| 
| 
| ff ss = (runState (f 1 (foldRight f (pure Nil) (1 :. 2 :. 1 :. Nil))) S.empty)
|   where f a acc = trace "filtering where" lift2 (\b as -> bool as (a :. as) b) (p a) acc
------------------------------------------------------------------------------
key
  where (key, value) = doFunc ff ss
        doFunc ff ss = ff ss

        ff ss = (runState expandFiltering S.empty)
          where expandFiltering = lift2 (\b as -> bool as (1 :. as) b) (filterFunc 1) (foldRight f (pure Nil) (1 :. 2 :. 1 :. Nil))

        filterFunc a = State $ \set -> if S.member a set
                                       then (False, set)
                                       else (True, S.insert a set)

问题 #

根据GHC的trace输出，state的执行位置和我的预期不符，手动展开代码很难对齐实际的执行流程。请问有什么工具可以自动完成这种代码展开操作？

内容的提问来源于stack exchange，提问作者zichao liu