-- Определяем типы (алгебру) узлов дерева (int, add, …)
class Algebra rep where
lam :: (rep a -> rep b) -> rep (a -> b)
app :: rep (a -> b) -> rep a -> rep b
-- «Визитор»-вычислитель выражения: объявление
newtype Eval a = E {unE :: a}
-- «Визитор»-вычислитель выражения: определение
instance Algebra Eval where
int = E
add x y = E (unE x + unE y)
lam f = E (unE . f . E)
app f x = E ( (unE f) (unE x) )
-- «Визитор»-измеритель глубины выражения: объявление
newtype Depth a
= D
{unD
:: Int}
-- «Визитор»-измеритель глубины выражения: определение
instance Algebra Depth where
int _ = D 1
add x y
= D
(1 + max (unD x
) (unD y
)) lam f = D (1 + unD (f (D 0)))
app f x
= D
(1 + max (unD f
) (unD x
))
-- Пример дерева: (\x -> x + 2) 1
test2
:: Algebra rep
=> rep
Inttest2 = app (lam (\x -> add x (int 2))) (int 1)
-- Основная программа: печатает результат вычисления test2 и его высоту
main
= print $ (unE test2
, unD test2
) -- (3, 4)
LS0g0J7Qv9GA0LXQtNC10LvRj9C10Lwg0YLQuNC/0YsgKNCw0LvQs9C10LHRgNGDKSDRg9C30LvQvtCyINC00LXRgNC10LLQsCAoaW50LCBhZGQsIOKApikKY2xhc3MgQWxnZWJyYSByZXAgd2hlcmUKCWludCA6OiBJbnQgICAgIC0+IHJlcCBJbnQKCWFkZCA6OiByZXAgSW50IC0+IHJlcCBJbnQgLT4gcmVwIEludAoJCglsYW0gOjogKHJlcCBhIC0+IHJlcCBiKSAtPiByZXAgKGEgLT4gYikKCWFwcCA6OiByZXAgKGEgLT4gYikgICAgIC0+IHJlcCBhICAgICAgICAtPiByZXAgYgoKLS0gwqvQktC40LfQuNGC0L7RgMK7LdCy0YvRh9C40YHQu9C40YLQtdC70Ywg0LLRi9GA0LDQttC10L3QuNGPOiDQvtCx0YrRj9Cy0LvQtdC90LjQtQpuZXd0eXBlIEV2YWwgYSA9IEUge3VuRSA6OiBhfQoKLS0gwqvQktC40LfQuNGC0L7RgMK7LdCy0YvRh9C40YHQu9C40YLQtdC70Ywg0LLRi9GA0LDQttC10L3QuNGPOiDQvtC/0YDQtdC00LXQu9C10L3QuNC1Cmluc3RhbmNlIEFsZ2VicmEgRXZhbCB3aGVyZQoJaW50IAk9IEUKCWFkZAl4IHkgPSBFICh1bkUgeCArIHVuRSB5KQoJbGFtIGYgCT0gRSAodW5FIC4gZiAuIEUpCglhcHAgZiB4ID0gRSAoICh1bkUgZikgKHVuRSB4KSApCgotLSDCq9CS0LjQt9C40YLQvtGAwrst0LjQt9C80LXRgNC40YLQtdC70Ywg0LPQu9GD0LHQuNC90Ysg0LLRi9GA0LDQttC10L3QuNGPOiDQvtCx0YrRj9Cy0LvQtdC90LjQtQpuZXd0eXBlIERlcHRoIGEgPSBEIHt1bkQgOjogSW50fQoKLS0gwqvQktC40LfQuNGC0L7RgMK7LdC40LfQvNC10YDQuNGC0LXQu9GMINCz0LvRg9Cx0LjQvdGLINCy0YvRgNCw0LbQtdC90LjRjzog0L7Qv9GA0LXQtNC10LvQtdC90LjQtQppbnN0YW5jZSBBbGdlYnJhIERlcHRoIHdoZXJlCglpbnQgXwk9IEQgMQoJYWRkCXggeSA9IEQgKDEgKyBtYXggKHVuRCB4KSAodW5EIHkpKQoJbGFtIGYgCT0gRCAoMSArIHVuRCAoZiAoRCAwKSkpCglhcHAgZiB4ID0gRCAoMSArIG1heCAodW5EIGYpICh1bkQgeCkpCgotLSDQn9GA0LjQvNC10YAg0LTQtdGA0LXQstCwOiAoXHggLT4geCArIDIpIDEKdGVzdDIgOjogQWxnZWJyYSByZXAgPT4gcmVwIEludAp0ZXN0MiAgPSBhcHAgKGxhbSAoXHggLT4gYWRkIHggKGludCAyKSkpIChpbnQgMSkKCi0tINCe0YHQvdC+0LLQvdCw0Y8g0L/RgNC+0LPRgNCw0LzQvNCwOiDQv9C10YfQsNGC0LDQtdGCINGA0LXQt9GD0LvRjNGC0LDRgiDQstGL0YfQuNGB0LvQtdC90LjRjyB0ZXN0MiDQuCDQtdCz0L4g0LLRi9GB0L7RgtGDCm1haW4gPSBwcmludCAkICh1bkUgdGVzdDIsIHVuRCB0ZXN0MikgLS0gKDMsIDQpCg==