Что именно делает систему типов последовательной?

Я взял András Kovács DBIndex.hs, очень простую реализацию зависимого от типизации ядра, и попробовал упростить его еще дальше, поскольку как я мог, без "разрушения" системы типов. После нескольких упрощений у меня осталось что-то гораздо меньшее:

{-# language LambdaCase, ViewPatterns #-}

data Term
  = V !Int
  | A Term Term
  | L Term Term
  | S
  | E
  deriving (Eq, Show)

data VTerm
  = VV !Int
  | VA VTerm VTerm
  | VL VTerm (VTerm -> VTerm)
  | VS
  | VE

type Ctx = ([VTerm], [VTerm], Int)

eval :: Bool -> Term -> Term
eval typ term = err (quote 0 (eval term typ ([], [], 0))) where

  eval :: Term -> Bool -> Ctx -> VTerm
  eval E _ _ = VE
  eval S _ _ = VS
  eval (V i) typ [email protected](vs, ts, _) = (if typ then ts else vs) !! i
  eval (L a b) typ [email protected](vs,ts,d) = VL a' b' where
    a' = eval a False ctx
    b' = \v -> eval b typ (v:vs, a':ts, d+1)
  eval (A f x) typ ctx = fx where
    f' = eval f typ ctx
    x' = eval x False ctx
    xt = eval x True ctx
    fx = case f' of
      (VL a b) -> if check a xt then b x' else VE -- type mismatch
      VS       -> VE -- non function application
      f        -> VA f x'

  check :: VTerm -> VTerm -> Bool
  check VS _ = True
  check a  b = quote 0 a == quote 0 b

  err :: Term -> Term
  err term = if ok term then term else E where
    ok (A a b) = ok a && ok b
    ok (L a b) = ok a && ok b
    ok E = False
    ok t = True

  quote :: Int -> VTerm -> Term
  quote d = \case
    VV i    -> V (d - i - 1)
    VA f x  -> A (quote d f) (quote d x)
    VL a b  -> L (quote d a) (quote (d + 1) (b (VV d)))
    VS      -> S
    VE      -> E

reduce :: Term -> Term
reduce = eval False

typeof :: Term -> Term
typeof = eval True

Проблема заключается в том, что я понятия не имею, что делает систему типов последовательной, поэтому у меня не было никаких критериев (кроме интуиции) и, возможно, она была разбита несколькими способами. Это, более или менее, делает то, что я думаю, что система типов должна делать, хотя:

main :: IO ()
main = do
  --  id = ∀ (a:*) . (λ (x:a) . a)
  let id = L S (L (V 0) (V 0))

  --  nat = ∀ (a:*) . (a -> a) -> (a -> a)
  let nat = L S (L (L (V 0) (V 1)) (L (V 1) (V 2)))

  --  succ = λ (n:nat) . ∀ (a:*) . λ (s : a -> a) . λ (z:a) . s (n a s z)
  let succ = L nat (L S (L (L (V 0) (V 1)) (L (V 1) (A (V 1) (A (A (A (V 3) (V 2)) (V 1)) (V 0))))))

  --  zero = λ (a:*) . λ (s : a -> a) . λ (z : a) . z
  let zero = L S (L (L (V 0) (V 1)) (L (V 1) (V 0)))

  --  add = λ (x:nat) . λ (y:nat) . λ (a:*) . λ(s: a -> a) . λ (z : a) . (x a s (y a s z))
  let add = L nat (L nat (L S (L (L (V 0) (V 1)) (L (V 1) (A (A (A (V 4) (V 2)) (V 1)) (A (A (A (V 3) (V 2)) (V 1)) (V 0)))))))

  --  bool = ∀ (a:*) . a -> a -> a
  let bool = L S (L (V 0) (L (V 1) (V 2)))

  --  false = ∀ (a:*) . λ (x : a) . λ(y : a) . x
  let false = L S (L (V 0) (L (V 1) (V 0)))

  --  true = ∀ (a:*) . λ (x : a) . λ(y : a) . y
  let true = L S (L (V 0) (L (V 1) (V 1)))

  --  loop = ((λ (x:*) . (x x)) (λ (x:*) . (x x)))
  let loop = A (L S (A (V 0) (V 0))) (L S (A (V 0) (V 0)))

  --  natOrBoolId = λ (a:bool) . λ (t:(if a S then nat else bool)) . λ (x:t) . t
  let natOrBoolId = L bool (L (A (A (A (V 0) S) nat) bool) (V 0))

  -- nat
  let c0 = zero
  let c1 = A succ zero
  let c2 = A succ c1
  let c3 = A succ c2
  let c4 = A succ c3
  let c5 = A succ c4

  -- Tests
  let test name pass = putStrLn $ "- " ++ (if pass then "OK." else "ERR") ++ " " ++ name

  putStrLn "True and false are bools"
  test "typeof true  == bool " $ typeof true  == bool
  test "typeof false == bool " $ typeof false == bool

  putStrLn "Calling 'true nat' on two nats selects the first one"
  test "reduce (true nat c1 c2) == c1"  $ reduce (A (A (A true nat) c1) c2) == reduce c1
  test "typeof (true nat c1 c2) == nat" $ typeof (A (A (A true nat) c1) c2) == nat

  putStrLn "Calling 'true nat' on a bool is a type error"
  test "reduce (true nat true c2) == E" $ reduce (A (A (A true nat) true) c2) == E
  test "reduce (true nat c2 true) == E" $ reduce (A (A (A true nat) c2) true) == E

  putStrLn "More type errors"
  test "reduce (succ true) == E" $ reduce (A succ true) == E

  putStrLn "Addition works"
  test "reduce (add c2 c3) == c5"  $ reduce (A (A add c2) c3) == reduce c5
  test "typeof (add c2 c2) == nat" $ typeof (A (A add c2) c3) == nat

  putStrLn "Loop isn't typeable"
  test "typeof loop == E" $ typeof loop == E

  putStrLn "Function with type that depends on value"
  test "typeof (natOrBoolId true c2) == nat" $ typeof (A (A natOrBoolId true) c2) == nat
  test "typeof (natOrBoolId true true) == E" $ typeof (A (A natOrBoolId true) true) == E
  test "typeof (natOrBoolId false c2) == E" $ typeof (A (A natOrBoolId false) c2) == E
  test "typeof (natOrBoolId false true) == bool"  $ typeof (A (A natOrBoolId false) true) == bool

Мой вопрос: что именно делает систему последовательной? В частности:

  • Какие проблемы я могу получить от того, что я сделал (удаление Pi, слияние infer/eval и т.д.)? Могут ли они быть как-то "оправданными" (генерируя другую систему, но все же "правильно" )?

  • В принципе: можно ли исправить эту систему (т.е. сделать ее "подходящей как ядро ​​зависимого на машинке языка так же, как CoC" ), сохраняя при этом ее небольшую?

Runnable code.

ОТВЕТЫ