Просто набрал лямбда-исчисление с ошибкой, в Haskell

Question

Я новичок в Haskell, поэтому извиняюсь, если этот вопрос не имеет особого смысла.

Я хочу иметь возможность реализовывать лямбда-выражения с простыми типами в Haskell таким образом, чтобы при попытке применить выражение к другому неправильному типу результатом была бы не ошибка типа, а скорее некоторое заданное значение, например, Nothing. Сначала я думал, что использование монады Maybe было бы правильным подходом, но я не смог заставить что-либо работать. Я задавался вопросом, что, если таковые имеются, будет правильным способом сделать это.

Контекстом проблемы, если она помогает, является проект, над которым я работаю, который назначает POS (часть речи) теги словам в предложениях. Для моего набора тегов я использую категориальные грамматические типы; это типизированные лямбда-выражения, такие как (e -> s) или же (e -> (e -> s)), где e а также s типы для существительных и предложений соответственно. Так, например, kill имеет тип (e -> (e -> s)) - он берет две существительные фразы и возвращает предложение. Я хочу написать функцию, которая берет список объектов таких типов и выясняет, есть ли способ объединить их для достижения объекта типа s, Конечно, это именно то, что делает проверка типов в Haskell, так что должно быть просто назначить каждому слову лямбда-выражение соответствующего типа, и пусть Haskell сделает все остальное. Проблема в том, что если s не может быть достигнуто, проверка типов Haskell естественным образом останавливает запуск программы.

Answer 1

Довольно стандартные вещи. Просто напишите проверку типов и оценивайте термин только тогда, когда он проверяет типы. evalMay Является ли это. Конечно, вы можете обогатить набор констант и базовых типов; Я просто использовал один из них для простоты.

import Control.Applicative ((<$), (<$>))
import Control.Monad (guard)
import Safe (atMay)

data Type
    = Base
    | Arrow Type Type
    deriving (Eq, Ord, Read, Show)

data Term
    = Const
    | Var Int -- deBruijn indexing; the nearest enclosing lambda binds Var 0
    | Lam Type Term
    | App Term Term
    deriving (Eq, Ord, Read, Show)

check :: [Type] -> Term -> Maybe Type
check env Const = return Base
check env (Var v) = atMay env v
check env (Lam ty tm) = Arrow ty <$> check (ty:env) tm
check env (App tm tm') = do
    Arrow i o <- check env tm
    i' <- check env tm'
    guard (i == i')
    return o

eval :: Term -> Term
eval (App tm tm') = case eval tm of
    Lam _ body -> eval (subst 0 tm' body)
eval v = v

subst :: Int -> Term -> Term -> Term
subst n tm Const = Const
subst n tm (Var m) = case compare m n of
    LT -> Var m
    EQ -> tm
    GT -> Var (m-1)
subst n tm (Lam ty body) = Lam ty (subst (n+1) tm body)
subst n tm (App tm' tm'') = App (subst n tm tm') (subst n tm tm'')

evalMay :: Term -> Maybe Term
evalMay tm = eval tm <$ check [] tm

Answer 2

Я хотел бы расширить превосходный ответ @Daniel Wagner немного другим подходом: вместо проверки типов, возвращая допустимый тип (если он есть), возвращает типизированное выражение, которое гарантировано, что мы можем его оценить (так как лямбда с простым типом исчисление сильно нормализуется). Основная идея заключается в том, что check ctx t e возвращается Just (ctx |- e :: t) тогда и только тогда e можно набрать на t в каком-то контексте ctx, а затем дано некоторое типизированное выражение ctx |- e :: tмы можем оценить это в некоторых Envутюжок правильного типа.

Реализация

Я буду использовать синглтоны для эмуляции типа Пи check :: (ctx :: [Type]) -> (a :: Type) -> Term -> Maybe (TTerm ctx a)Это означает, что нам нужно будет включить каждое расширение GHC и кухонную раковину:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds, KindSignatures, TypeFamilies, TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-} -- sigh...

import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Type.Equality

Первый бит - нетипизированное представление, прямо из ответа @Daniel Wagner:

data Type = Base
          | Arrow Type Type
          deriving (Show, Eq)

data Term = Const
          | Var Int
          | Lam Type Term
          | App Term Term
          deriving Show

но мы также дадим семантику для этих типов, интерпретируя Base как () а также Arrow t1 t2 как t1 -> t2:

 type family Interp (t :: Type) where
    Interp Base = ()
    Interp (Arrow t1 t2) = Interp t1 -> Interp t2

Чтобы соответствовать теме де Брюйна, контексты - это список типов, а переменные - это индексы контекста. Учитывая окружение типа контекста, мы можем найти переменный индекс, чтобы получить значение. Обратите внимание, что lookupVar это общая функция.

data VarIdx (ts :: [Type]) (a :: Type) where
    Here :: VarIdx (a ': ts) a
    There :: VarIdx ts a -> VarIdx (b ': ts) a

data Env (ts :: [Type]) where
    Nil :: Env '[]
    Cons :: Interp a -> Env ts -> Env (a ': ts)

lookupVar :: VarIdx ts a -> Env ts -> Interp a
lookupVar Here      (Cons x _)  = x
lookupVar (There v) (Cons _ xs) = lookupVar v xs

Хорошо, у нас есть вся инфраструктура для написания кода. Прежде всего, давайте определим типизированное представление Termвместе с (всего!) оценщиком:

data TTerm (ctx :: [Type]) (a :: Type) where
    TConst :: TTerm ctx Base
    TVar :: VarIdx ctx a -> TTerm ctx a
    TLam :: TTerm (a ': ctx) b -> TTerm ctx (Arrow a b)
    TApp :: TTerm ctx (Arrow a b) -> TTerm ctx a -> TTerm ctx b

eval :: Env ctx -> TTerm ctx a -> Interp a
eval env TConst = ()
eval env (TVar v) = lookupVar v env
eval env (TLam lam) = \x -> eval (Cons x env) lam
eval env (TApp f e) = eval env f $ eval env e

Все идет нормально. eval хорош и тотален, потому что его входные данные могут представлять только хорошо типизированные термины лямбда-исчисления с простыми типами. Таким образом, часть работы оценщика @ Daniel должна будет состоять в преобразовании нетипизированного представления в типизированное.

Основная идея позади infer является то, что если вывод типа успешно, он возвращает Just $ TheTerm t e, где t это SingЛетон свидетель eтип.

$(genSingletons [''Type])
$(singDecideInstance ''Type)

-- I wish I had sigma types...
data SomeTerm (ctx :: [Type]) where
    TheTerm :: Sing a -> TTerm ctx a -> SomeTerm ctx

data SomeVar (ctx :: [Type]) where
    TheVar :: Sing a -> VarIdx ctx a -> SomeVar ctx

-- ... and pi ones as well
infer :: Sing ctx -> Term -> Maybe (SomeTerm ctx)
infer _ Const = return $ TheTerm SBase TConst
infer ts (Var n) = do
    TheVar t v <- inferVar ts n
    return $ TheTerm t $ TVar v
infer ts (App f e) = do
    TheTerm t0 e' <- infer ts e
    TheTerm (SArrow t0' t) f' <- infer ts f
    Refl <- testEquality t0' t0
    return $ TheTerm t $ TApp f' e'
infer ts (Lam ty e) = case toSing ty of
    SomeSing t0 -> do
        TheTerm t e' <- infer (SCons t0 ts) e
        return $ TheTerm (SArrow t0 t) $ TLam e'

inferVar :: Sing ctx -> Int -> Maybe (SomeVar ctx)
inferVar (SCons t _) 0 = return $ TheVar t Here
inferVar (SCons _ ts) n = do
    TheVar t v <- inferVar ts (n-1)
    return $ TheVar t $ There v
inferVar _ _ = Nothing

Надеюсь, последний шаг очевиден: поскольку мы можем оценить только хорошо типизированный термин для данного типа (поскольку именно это дает нам тип его встраивания в Haskell), мы обращаемся к типу inferвступить в тип checkING:

check :: Sing ctx -> Sing a -> Term -> Maybe (TTerm ctx a)
check ctx t e = do
    TheTerm t' e' <- infer ctx e
    Refl <- testEquality t t'
    return e'

Пример сеанса

Давайте попробуем наши функции в GHCi:

λ» :set -XStandaloneDeriving -XGADTs
λ» deriving instance Show (VarIdx ctx a)
λ» deriving instance Show (TTerm ctx a)

λ» let id = Lam Base (Var 0) -- \x -> x
λ» check SNil (SBase `SArrow` SBase) id
Just (TLam (TVar Here))

λ» let const = Lam Base $ Lam Base $ Var 1 -- \x y -> x
λ» check SNil (SBase `SArrow` SBase) const
Nothing -- Oops, wrong type
λ» check SNil (SBase `SArrow` (SBase `SArrow` SBase)) const
Just (TLam (TLam (TVar Here)))

λ» :t eval Nil <$> check SNil (SBase `SArrow` (SBase `SArrow` SBase)) const
eval Nil <$> check SNil (SBase `SArrow` (SBase `SArrow` SBase)) const
  :: Maybe (() -> () -> ())
-- Note that the `Maybe` there comes from `check`, not `eval`!
λ» let Just const' = check SNil (SBase `SArrow` (SBase `SArrow` SBase)) const
λ» :t eval Nil const'
eval Nil const' :: () -> () -> ()
λ» eval Nil const' () ()
()