Haskell: маркировка AST с информацией о типах с использованием алгоритма W

Question

У нас есть определение AST:

data Term a 
  = Lam String a
  | App a a
  | Var String
  deriving(Read,Show,Eq,Functor,Foldable,Traversable)

И F-алгебра для вывода типа:

type Wrapped m a = Enviroment -> m a
type Result m = Wrapped (Type,Substitution)
w ::
  (MonadState Int, MonadError TypeError) 
  => Term (Result m)
  -> Result m
w term env = ...

Мы можем получить результат выполнения вывода, используя cata:

infer :: 
  (MonadState Int, MonadError TypeError) 
  => Fix Term 
  -> Result m
infer ast = cata hm ast

Но теперь я хочу, чтобы результатом был исходный AST, аннотированный информацией о типе для каждого выражения, так что теперь infer' :: Fix Term -> Wrapped (Labeled Term Type),

1. Какую структуру данных я должен использовать для аннотирования дерева (Cofree,Product,Fix с обычаем Label)?
2. Как я могу реализовать это, используя схемы рекурсии, не изменяя оригинал w функционировать?

Answer 1

Этот ответ изменяет функцию w, но он по-прежнему нацелен на то, чтобы функции "рабочей лошадки" были отделены от механизма схем рекурсии.

Давайте сохраним Term введите как есть, и предположим, что у нас есть тип E для среды, которая рассчитывается вниз, и тип R для окончательной аннотации, которая рассчитывается вверх от листьев.

Давайте также предположим, что у нас есть эти две функции:

calcEnv :: E -> Term x -> E -- calculates the environment which will be passed downwards

calcResult :: E -> Term R -> IO R -- effectfully calculates the result flowing upwards

я использую IO как монада для простоты.

(Обратите внимание, что я предполагаю, что "вычисление среды" не может иметь последствий. Если это не так, то это решение не подойдет.)

Мы работаем в два этапа. Сначала мы строим дерево, в котором узлы были аннотированы с их средой. Мы используем анаморфизм вместо "уловки" возврата функции из катаморфизма.

import qualified Control.Comonad.Trans.Cofree as COFREEF

annotate :: E -> Fix Term -> Cofree Term E
annotate = curry (ana coalg)
    where
    coalg :: (E, Fix Term) -> COFREEF.CofreeF Term E (E, Fix Term)
    coalg (environment, Fix term) =
        let environment' = calcEnv environment term
        in  environment COFREEF.:< fmap ((,) environment') term

(Имейте в виду, что type instance Base (Cofree f a) = CofreeF f a, Вот где COFREEF.:< приходит от. В основном это пара чистых значений и другое значение, заключенное в функтор.)

И на следующем этапе мы эффективно используем аннотированное дерево из листьев, чтобы получить конечный результат - дерево с R аннотации:

calculate :: Cofree Term E -> IO (Cofree Term R)
calculate = cata alg
    where
    alg :: COFREEF.CofreeF Term E (IO (Cofree Term R)) -> IO (Cofree Term R)
    alg (environment COFREEF.:< termio) = do
        term :: Term (Cofree Term R) <- sequenceA termio
        result :: R <- calcResult environment (fmap extract term)
        return $ result :< term

Я сделал это в два этапа, потому что у меня были проблемы с комбинированием трюка "возвращение функции" с возвратом аннотированного дерева.

---

Анаморфизм, сопровождаемый катаморфизмом, известен как гиломорфизм. Мы могли бы определить составную функцию, используя hylo, как это:

together :: E -> Fix Term -> IO (Cofree Term R)
together = curry (hylo alg coalg)
    where
    coalg (environment, Fix term) = ...
    alg (environment COFREEF.:< termio) = ...

---

Вы можете собрать calcEnv а также calcResult в форме исходной алгебры:

w :: Term (E -> IO R) -> E -> IO R
w term environment = do
    let downwards = calcEnv environment term
    tr :: Term R <- sequenceA $ fmap ($ downwards) term
    calcResult environment tr