others - Haskell - 如何使用遞歸scheme而不是顯式遞歸來遍歷類型?

83 5

考慮以下代碼:


import Data.Maybe (fromMaybe)



data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)



makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure


makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)


 where


 descend :: MyStructure -> MyStructure


 descend (Foo x) = Foo x


 descend (Bar x y) = Bar x (makeReplacements replacements y)


 descend (Baz x y) = Baz (makeReplacements replacements x) (makeReplacements replacements y)


 descend (Qux x y z w) = Qux x y (makeReplacements replacements z) (makeReplacements replacements w)



它定義了遞歸數據類型,以及執行搜索,並且通過遍歷來替換的函數,但是我使用了顯式遞歸,我希望能改用遞歸scheme。


{-# LANGUAGE DeriveTraversable, TypeFamilies #-}



import Data.Maybe (fromMaybe)


import Data.Functor.Foldable (Base, Recursive(..), Corecursive(..))



data MyStructure = Foo Int | Bar String MyStructure | Baz MyStructure MyStructure | Qux Bool Bool MyStructure MyStructure deriving(Eq,Show)



makeReplacements :: [(MyStructure, MyStructure)] -> MyStructure -> MyStructure


makeReplacements replacements structure = fromMaybe (descend structure) (lookup structure replacements)


 where


 descend :: MyStructure -> MyStructure


 descend = embed . fmap (makeReplacements replacements) . project



-- begin code that would normally be auto-generated


data MyStructureF r = FooF Int | BarF String r | BazF r r | QuxF Bool Bool r r deriving(Foldable,Traversable)



instance Functor MyStructureF where


 fmap _ (FooF x) = FooF x


 fmap f (BarF x y) = BarF x (f y)


 fmap f (BazF x y) = BazF (f x) (f y)


 fmap f (QuxF x y z w) = QuxF x y (f z) (f w)



type instance Base MyStructure = MyStructureF



instance Recursive MyStructure where


 project (Foo x) = FooF x


 project (Bar x y) = BarF x y


 project (Baz x y) = BazF x y


 project (Qux x y z w) = QuxF x y z w



instance Corecursive MyStructure where


 embed (FooF x) = Foo x


 embed (BarF x y) = Bar x y


 embed (BazF x y) = Baz x y


 embed (QuxF x y z w) = Qux x y z w


-- end code that would normally be auto-generated



descend (Baz x y) = Baz x (makeReplacements replacements y)(忘記在x內替換),然而,這個仍然是顯式遞歸,因為我仍然在它自己的定義中使用makeReplacements。

时间: 原作者:

61 5

我找到了一個相當滿意的解決方案:


makeReplacements replacements = apo coalg


 where


 coalg :: MyStructure -> MyStructureF (Either MyStructure MyStructure)


 coalg structure = case lookup structure replacements of


 Just replacement -> Left <$> project replacement


 Nothing -> Right <$> project structure




makeReplacements replacements = para alg


 where


 alg :: MyStructureF (MyStructure, MyStructure) -> MyStructure


 alg structure = case lookup (embed $ fst <$> structure) replacements of


 Just replacement -> replacement


 Nothing -> embed $ snd <$> structure



原作者:
...