我有这个AST
data ExprF r = Const Int | Add r r
type Expr = Fix ExprF
我要比较
x = Fix $ Add (Fix (Const 1)) (Fix (Const 1))
y = Fix $ Add (Fix (Const 1)) (Fix (Const 2))
但是所有递归方案函数似乎只适用于单结构
显然我可以使用递归
eq (Fix (Const x)) (Fix (Const y)) = x == y
eq (Fix (Add x1 y1)) (Fix (Add x2 y2)) = (eq x1 x2) && (eq y1 y2)
eq _ _ = False
但我希望可以使用某种拉链功能。
答案 0 :(得分:4)
作用于单个参数的递归方案就足够了,因为我们可以从方案应用程序返回一个函数。在这种情况下,我们可以从Expr -> Bool
上的方案应用程序返回Expr
函数。为了进行有效的等式检查,我们只需要paramorphisms:
{-# language DeriveFunctor, LambdaCase #-}
newtype Fix f = Fix (f (Fix f))
data ExprF r = Const Int | Add r r deriving (Functor, Show)
type Expr = Fix ExprF
cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = go where go (Fix ff) = f (go <$> ff)
para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para f (Fix ff) = f ((\x -> (x, para f x)) <$> ff)
eqExpr :: Expr -> Expr -> Bool
eqExpr = cata $ \case
Const i -> cata $ \case
Const i' -> i == i'
_ -> False
Add a b -> para $ \case
Add a' b' -> a (fst a') && b (fst b')
_ -> False
当然,cata
可以简单地实现para
:
cata' :: Functor f => (f a -> a) -> Fix f -> a
cata' f = para (\ffa -> f (snd <$> ffa)
从技术上讲,几乎所有有用的函数都可以使用cata
实现,但它们不一定有效。我们可以使用para
实现cata
:
para' :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para' f = snd . cata (\ffa -> (Fix (fst <$> ffa) , f ffa))
但是,如果我们在para'
中使用eqExpr
,我们会得到二次复杂度,因为para'
在输入的大小上始终是线性的,而我们可以使用para
来在恒定时间内查看最高Expr
值。
答案 1 :(得分:4)
(此响应使用数据修复库,因为我无法使用 recursion-schemes 进行编译。)
我们可以将两棵树的差异建模为一个变形或展开基于原始仿函数的“diff functor”。
考虑以下类型
data DiffF func r = Diff (Fix func) (Fix func)
| Nodiff (func r)
deriving (Functor)
type ExprDiff = Fix (DiffF ExprF)
这个想法是ExprDiff
将遵循原始Expr
树的“共同结构”,只要它保持相等,但是在遇到差异时,我们切换到{{} 1}} leaf,它存储了我们发现不同的两个子树。
实际的比较函数是:
Diff
变形的“种子”是我们想要比较的一对表达式。
如果我们只想要一个谓词diffExpr :: Expr -> Expr -> ExprDiff
diffExpr e1 e2 = ana comparison (e1,e2)
where
comparison :: (Expr,Expr) -> DiffF ExprF (Expr,Expr)
comparison (Fix (Const i),Fix (Const i')) | i == i' =
Nodiff (Const i')
comparison (Fix (Add a1 a2),Fix (Add a1' a2')) =
Nodiff (Add (a1,a1') (a2,a2'))
comparison (something, otherthing) =
Diff something otherthing
,我们以后可以使用一个检测Expr -> Expr -> Bool
分支存在的变形。