fork(1) download
  1. -- Определяем типы (алгебру) узлов дерева (int, add, …)
  2. class Algebra rep where
  3. int :: Int -> rep Int
  4. add :: rep Int -> rep Int -> rep Int
  5.  
  6. lam :: (rep a -> rep b) -> rep (a -> b)
  7. app :: rep (a -> b) -> rep a -> rep b
  8.  
  9. -- «Визитор»-вычислитель выражения: объявление
  10. newtype Eval a = E {unE :: a}
  11.  
  12. -- «Визитор»-вычислитель выражения: определение
  13. instance Algebra Eval where
  14. int = E
  15. add x y = E (unE x + unE y)
  16. lam f = E (unE . f . E)
  17. app f x = E ( (unE f) (unE x) )
  18.  
  19. -- «Визитор»-измеритель глубины выражения: объявление
  20. newtype Depth a = D {unD :: Int}
  21.  
  22. -- «Визитор»-измеритель глубины выражения: определение
  23. instance Algebra Depth where
  24. int _ = D 1
  25. add x y = D (1 + max (unD x) (unD y))
  26. lam f = D (1 + unD (f (D 0)))
  27. app f x = D (1 + max (unD f) (unD x))
  28.  
  29. -- Пример дерева: (\x -> x + 2) 1
  30. test2 :: Algebra rep => rep Int
  31. test2 = app (lam (\x -> add x (int 2))) (int 1)
  32.  
  33. -- Основная программа: печатает результат вычисления test2 и его высоту
  34. main = print $ (unE test2, unD test2) -- (3, 4)
  35.  
Success #stdin #stdout 0s 4692KB
stdin
Standard input is empty
stdout
(3,4)