99 lines
2.8 KiB
Idris
99 lines
2.8 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
|
|
|
|
{- TODO: I should throw eval, eval, convert into a helper sometime -}
|
|
|
|
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)
|
|
|
|
(VPair a1 b1, VPair a2 b2) => (&&) <$> convert a1 a2 <*> delay <$> convert b1 b2
|
|
|
|
(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
|
|
guard =<< convert (VClos env1 a1) (VClos env2 a2)
|
|
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
|
|
guard =<< convert c1' c2'
|
|
st1' <- eval env1 st1
|
|
st2' <- eval env2 st2
|
|
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
|
|
guard =<< convert c1' c2'
|
|
z1' <- eval env1 z1
|
|
z2' <- eval env2 z2
|
|
guard =<< convert z1' z2'
|
|
s1' <- eval env1 s1
|
|
s2' <- eval env2 s2
|
|
convert s1' s2'
|
|
|
|
(VClos env1 (TSigma a1 b1), VClos env2 (TSigma a2 b2)) => do
|
|
a1' <- eval env1 a1
|
|
a2' <- eval env2 a2
|
|
guard =<< convert a1' a2'
|
|
b1' <- eval env1 b1
|
|
b2' <- eval env2 b2
|
|
convert b1' b2'
|
|
|
|
(VClos env1 (TSigInd a1 b1 c1 f1), VClos env2 (TSigInd a2 b2 c2 f2)) => do
|
|
a1' <- eval env1 a1
|
|
a2' <- eval env2 a2
|
|
guard =<< convert a1' a2'
|
|
b1' <- eval env1 b1
|
|
b2' <- eval env2 b2
|
|
guard =<< convert b1' b2'
|
|
c1' <- eval env1 c1
|
|
c2' <- eval env2 c2
|
|
guard =<< convert c1' c2'
|
|
f1' <- eval env1 f1
|
|
f2' <- eval env2 f2
|
|
convert f1' f2'
|
|
|
|
_ => pure False
|