75 lines
2.1 KiB
Idris
75 lines
2.1 KiB
Idris
module Convert
|
|
|
|
import Term
|
|
import Value
|
|
import Misc
|
|
import Normalize
|
|
|
|
import Control.Monad.RWS
|
|
import Control.Monad.Identity
|
|
import Control.Monad.Either
|
|
|
|
import Data.Nat
|
|
import Data.Vect
|
|
|
|
%default total
|
|
|
|
public export
|
|
convert : Value -> Value -> PI Bool
|
|
convert u1 u2 = do
|
|
u1' <- whnf u1
|
|
u2' <- whnf u2
|
|
logS ("checking equality of terms '" ++ show u1 ++ "' and '" ++ show u2 ++ "'.")
|
|
logS ("with value representations '" ++ show u1' ++ "' and '" ++ show u2' ++ "'.")
|
|
assert_total $ -- :(
|
|
case (u1', u2') of
|
|
(VType, VType) => pure True
|
|
(VTop, VTop) => pure True
|
|
(VStar, VStar) => pure True
|
|
(VBot, VBot) => pure True
|
|
(VNat, VNat) => pure True
|
|
|
|
(VNatTr n, VNatTr m) => pure (n == m)
|
|
|
|
(VApp f1 x1, VApp f2 x2) => (&&) <$> convert f1 f2
|
|
<*> delay <$> convert x1 x2
|
|
(VGen k1, VGen k2) => pure (k1 == k2)
|
|
|
|
(VClos env1 (TLam sc1), VClos env2 (TLam sc2)) => do
|
|
v <- VGen <$> fresh
|
|
convert (VClos (v :: env1) sc1)
|
|
(VClos (v :: env2) sc2)
|
|
|
|
(VClos env1 (TPi a1 b1), VClos env2 (TPi a2 b2)) => do
|
|
v <- VGen <$> fresh
|
|
(&&) <$> convert (VClos env1 a1)
|
|
(VClos env2 a2)
|
|
<*> delay <$> convert (VClos (v :: env1) b1)
|
|
(VClos (v :: env2) b2)
|
|
|
|
(VClos env1 (TTopInd c1 st1), VClos env2 (TTopInd c2 st2)) => do
|
|
c1' <- eval env1 c1
|
|
c2' <- eval env2 c2
|
|
st1' <- eval env1 st1
|
|
st2' <- eval env2 st2
|
|
(&&) <$> convert c1' c2' <*> delay <$> convert st1' st2'
|
|
|
|
(VClos env1 (TBotInd c1), VClos env2 (TBotInd c2)) => do
|
|
c1' <- eval env1 c1
|
|
c2' <- eval env2 c2
|
|
convert c1' c2'
|
|
|
|
-- lmao
|
|
(VClos env1 (TNatInd c1 z1 s1), VClos env2 (TNatInd c2 z2 s2)) => do
|
|
c1' <- eval env1 c1
|
|
c2' <- eval env2 c2
|
|
z1' <- eval env1 z1
|
|
z2' <- eval env2 z2
|
|
s1' <- eval env1 s1
|
|
s2' <- eval env2 s2
|
|
b1 <- (&&) <$> convert c1' c2' <*> delay <$> convert z1' z2'
|
|
guard b1
|
|
convert s1' s2'
|
|
|
|
_ => pure False
|