39 lines
1.4 KiB
Haskell
39 lines
1.4 KiB
Haskell
module Eval where
|
|
|
|
import Control.Monad.Reader
|
|
import qualified Data.Map as M
|
|
import Data.Maybe
|
|
import Data.Text (Text)
|
|
import Expr
|
|
|
|
type Env = M.Map Text Expr
|
|
|
|
-- substitute s for k *AND* decrement indices; only use after reducing a redex.
|
|
subst :: Integer -> Expr -> Expr -> Expr
|
|
subst k s (Var n x)
|
|
| k == n = s
|
|
| n > k = Var (n - 1) x
|
|
| otherwise = Var n x
|
|
subst _ _ (Free s) = Free s
|
|
subst _ _ Star = Star
|
|
subst _ _ Square = Square
|
|
subst k s (App m n) = App (subst k s m) (subst k s n)
|
|
subst k s (Abs x m n) = Abs x (subst k s m) (subst (k + 1) (incIndices s) n)
|
|
subst k s (Pi x m n) = Pi x (subst k s m) (subst (k + 1) (incIndices s) n)
|
|
|
|
whnf :: Expr -> Expr
|
|
whnf (App (Abs _ _ v) n) = whnf $ subst 0 n v
|
|
whnf e = e
|
|
|
|
betaEquiv :: Expr -> Expr -> Reader Env Bool
|
|
betaEquiv e1 e2
|
|
| e1 == e2 = pure True
|
|
| otherwise = case (whnf e1, whnf e2) of
|
|
(Var k1 _, Var k2 _) -> pure $ k1 == k2
|
|
(Free n, Free m) -> pure $ n == m
|
|
(Free n, e) -> fromMaybe False <$> (asks (M.lookup n) >>= traverse (`betaEquiv` e))
|
|
(e, Free n) -> fromMaybe False <$> (asks (M.lookup n) >>= traverse (`betaEquiv` e))
|
|
(Star, Star) -> pure True
|
|
(Abs _ t1 v1, Abs _ t2 v2) -> (&&) <$> betaEquiv t1 t2 <*> betaEquiv v1 v2 -- i want idiom brackets
|
|
(Pi _ t1 v1, Pi _ t2 v2) -> (&&) <$> betaEquiv t1 t2 <*> betaEquiv v1 v2
|
|
_ -> pure False -- remaining cases impossible or false
|