perga/app/Check.hs

-- {-# LANGUAGE BangPatterns #-}
module Check where

import Control.Monad (guard)
import Data.List ((!?))

-- import Debug.Trace (trace)
import Expr

type Context = [Expr]

findType :: Context -> Expr -> Maybe Expr
findType g (Var k) = do
    t <- g !? fromInteger k
    kind <- findType g t
    guard $ isSort kind
    pure t
findType _ Star = Just Square
findType _ Square = Nothing
findType g (App m n) = do
    Pi a b <- findType g m
    a' <- findType g n
    guard $ betaEquiv a a'
    pure $ subst n b
findType g (Abs t v) = do
    argType <- findType g t
    guard $ isSort argType
    bodyType <- findType (incIndices t : map incIndices g) v
    resType <- findType g (Pi t bodyType)
    guard $ isSort resType
    pure $ Pi t bodyType
findType g (Pi t v) = do
    argType <- findType g t
    guard $ isSort argType
    bodyType <- findType (incIndices t : map incIndices g) v
    guard $ isSort bodyType
    pure bodyType