Вычислить (бесконечное) дерево из оператора фиксированной точки, используя модальность задержки

Question

Вот головоломка функционального программирования, включающая связывание циклов и бесконечные структуры данных. Есть немного фона, так что держитесь крепче.

Настройки. Давайте определим тип данных, представляющий рекурсивные типы данных:

type Var = String
data STerm = SMu Var STerm
           | SVar Var
           | SArrow STerm STerm
           | SBottom
           | STop
   deriving (Show)

т.е. t ::= μα. t | α | t → t | ⊥ | ⊤, Обратите внимание, что ⊥ обозначает тип без обитателей, а ⊤ обозначает тип со всеми обитателями. Обратите внимание, что (μα. α) = ⊥, поскольку μ- оператор с наименьшей фиксированной точкой.

Мы можем интерпретировать рекурсивный тип данных как бесконечное дерево, возникающее в результате многократного развертывания μα. t в t[α ↦ μα. t], (Формальное описание этого процесса см. http://lucacardelli.name/Papers/SRT.pdf). В Haskell мы можем определить тип ленивых деревьев, которые не имеют μ-связывателей или переменных:

data LTerm = LArrow LTerm LTerm
           | LBottom
           | LTop
   deriving (Show)

и, в обычном Haskell, функция преобразования из одного в другое:

convL :: [(Var, LTerm)] -> STerm -> LTerm
convL _ STop    = LTop
convL _ SBottom = LBottom
convL ctx (SArrow t1 t2) = LArrow (convL ctx t1) (convL ctx t2)
convL ctx (SVar v)
    | Just l <- lookup v ctx = l
    | otherwise = error "unbound variable"
convL ctx (SMu v t) = fix (\r -> convL ((v, r) : ctx) t)

Однако есть проблема с этой функцией: она не продуктивна. Если вы бежите convL [] (SMu "x" (SVar "x")) Вы будете бесконечной петлей. Мы предпочли бы получить LBottom в этом случае. Интересным упражнением является прямое исправление этой функции, чтобы она была продуктивной; Однако в этом вопросе я хочу решить проблему по-другому.

Производительность с модальностью задержки. Когда мы строим циклические структуры данных, как указано выше, нам нужно убедиться, что мы не используем результаты наших вычислений до того, как мы их построим. Модальность задержки - это способ гарантировать, что мы пишем продуктивные (не бесконечные циклы) программы. Основная идея проста: если тип Int означает, что у меня есть целое число сегодня, я определяю конструктор типа D, чтобы D Int означает, что у меня есть значение типа Int завтраD является функтором и аппликативным (но НЕ монадой)

-- D is abstract; you are not allowed to pattern match on it
newtype D a = D a
   deriving (Show)

instance Functor D where
    fmap f (D a) = D (f a)

instance Applicative D where
    D f <*> D a = D (f a)
    pure x = D x

С D, мы определяем оператор с фиксированной точкой: он говорит, что для создания значения a, вы можете иметь доступ к a вы строите, если вы используете его только завтра.

fixD :: (D a -> a) -> a
fixD f = f (D (fixD f))

Например, поток состоит из значения a У меня сегодня и стрим Stream a который я должен произвести завтра.

data Stream a = Cons a (D (Stream a))

С помощью fixDЯ могу определить map функция на потоках, которая гарантированно будет продуктивной, так как рекурсивный вызов map используется только для произведенных ценностей, которые необходимы завтра.

instance Functor Stream where
    fmap f = fixD $ \go (Cons x xs) -> Cons (f x) (go <*> xs)

Эта проблема. Вот вариант LTerm с явной модальностью задержки.

data Term = Arrow (D Term) (D Term)
          | Bottom
          | Top
    deriving (Show)

С помощью fixD (не допускаются неструктурно-рекурсивные ссылки), как написать функцию conv :: STerm -> Term (или же conv :: STerm -> D Term)? Особенно интересный тестовый пример SMu "x" (SArrow STop (SMu "y" (SVar "x"))); в результирующей структуре не должно быть никаких Низов!

Обновить. Я случайно исключил структурную рекурсию на STermчто не было целью вопроса; Я перефразировал это ограничение.

Answer 1

Вы намерены запретить только неограниченную рекурсию (fix) в SMu в случае если convLили также структурная рекурсия в SArrow дело?

Я не думаю, что это имеет решение без структурной рекурсии на STermпотому что тогда мы должны были бы быть продуктивными даже на бесконечном STerm такие как:

foldr (\n -> SMu ("x" ++ show n)) undefined [0..]  -- μα. μβ. μγ. μδ. …

Чтобы сделать это со структурной рекурсией на STermкажется, дело в хранении Either Term (D Term) в контексте. Когда мы проходим через Arrow и произвести Dмы можем преобразовать все Rightс Lefts.

type Ctx = [(Var, Either Term (D Term))]

dCtx :: Ctx -> D Ctx
dCtx = traverse (traverse (fmap Left . either pure id))

conv :: STerm -> Ctx -> Term
conv STop _ = Top
conv SBottom _ = Bottom
conv (SArrow t1 t2) ctx = Arrow (fmap (conv t1) (dCtx ctx)) (fmap (conv t2) (dCtx ctx))
conv (SVar v) ctx = case lookup v ctx of
                      Nothing -> error "unbound variable"
                      Just (Left t) -> t
                      Just (Right _) -> Bottom
conv (SMu v t) ctx = fixD (\dr -> conv t ((v, Right dr) : ctx))

Answer 2

Моя интуиция заключается в том, что контекст должен содержать только отложенные термины. Сюда, conv ctx (SMu "x" t) будет эквивалентно fixD (\d -> conv ((x,r):ctx) t)как в оригинале convL,

Если это так, то вам нужен общий способ включить задержанные термины в структуру данных, вместо того, чтобы просто указывать их стрелками:

data Term = Arrow Term Term
          | Bottom
          | Top
          | Next (D Term)

Первая попытка conv дает нам:

conv :: [(Var, D Term)] -> STerm -> Term
conv _ STop = Top
conv _ SBottom = SBottom
conv ctx (SArrow t1 t2) = Arrow (conv ctx t1) (conv ctx t2)
conv ctx (SVar v)
  | Just l <- lookup v ctx = Next l
  | otherwise = error "unbound variable"
conv ctx (SMu v t) = fixD (\r -> conv ((x,r):ctx) t)

Однако для этого используются неохраняемые рекурсивные вызовы conv, Если вы хотите избежать этого, вы можете обернуть все fixD рекурсивные вызовы в Next,

conv :: [(Var, D Term)] -> STerm -> Term
conv = fixD step where
        step _ _ STop = Top
        step _ _ SBottom = Bottom
        step d ctx (SArrow t1 t2) = Arrow (Next $ d <*> pure ctx <*> pure t1) 
                                          (Next $ d <*> pure ctx <*> pure t2)
        step d ctx (SVar v)
          | Just l <- lookup v ctx = Next l
          | otherwise = error "unbound variable"
        step d ctx (SMu v t) = fixD (\r -> 
                                    Next $ d <*> pure ((x,r):ctx) <*> pure t)

Я не уверен, что это именно то, что вы ищете, потому что conv [] SMu "x" (SArrow SBottom (SMu "y" (SVar "x"))) все еще имеет основания в получающейся структуре. Какой тип вы хотите получить?