twee-2.1.5: misc/bench.hs

{-# LANGUAGE PatternGuards, FlexibleInstances #-}
import Criterion.Main
import Twee.Term hiding (isFun, F)
import qualified Twee.Term
import Test.QuickCheck hiding (Fun)
import Data.Int
import Data.Maybe
import Twee.Term.Core hiding (subst)

instance Num (Fun Int) where fromInteger n = F (fromInteger n)
instance Num Var where fromInteger = V . fromInteger

t0, t1, u0, u1, t2, t, u :: Term Int
t0 = build $ app 0 [var 0, app 0 [var 0, app 0 [app 0 [var 0, var 1], var 2]]]
u0 = build $ app 0 [app 0 [app 2 [app 2 [var 2, var 2], var 1], app 0 [app 2 [var 2, var 2], var 3]], app 0 [app 0 [app 2 [app 2 [var 2, var 2], var 1], app 0 [app 2 [var 2, var 2], var 3]], app 0 [app 0 [app 0 [app 2 [app 2 [var 2, var 2], var 1], app 0 [app 2 [var 2, var 2], var 3]], app 2 [app 2 [var 2, var 2], var 1]], app 2 [var 2, var 2]]]]

t1 = build $ app 0 [app 1 [var 0], app 1 [var 1]]
u1 = build $ app 0 [app 1 [app 0 [app 2 empty, app 3 empty]], app 1 [app 0 [app 4 empty, app 5 empty]]]

t2 = build $ app 0 [var 0, app 1 [var 1, app 1 [var 1, var 1]]]
u2 = build $ app 0 [app 0 [var 2, var 2], var 2]

t = t0
u = u0

Just sub = match t u

mgu1 t u = let Just sub = unifyTri t u in build (subst sub t)
mgu2 t u = let Just sub = unify t u in build (subst sub t)

Just sub' = unifyTri t2 u2
Just csub' = unify t2 u2

main = do
  print t
  print u
  print (match t u)
  print (build (subst sub t))
  print (unifyTri t2 u2)
  print (close sub')
  print (build (subst sub' t2))
  print (build (subst sub' u2))
  print (mgu1 t2 u2)
  print (mgu2 t2 u2)
  print (t == t)
  print (build (subst sub t) == u)
  print (build (subst sub' t2) == build (subst sub' u2))
  print (build (subst csub' t1) == build (subst sub' t1))
  print (mgu1 t2 u2 == mgu2 t2 u2)
  print (build (subst csub' t2) == build (subst sub' t2))
  defaultMain [
    bench "eq-t" (whnf (uncurry (==)) (t, t)),
    bench "eq-u" (whnf (uncurry (==)) (u, u)),
    bench "match" (whnf (fromJust . uncurry match) (t, u)),
    bench "subst" (whnf (build . uncurry subst) (sub, t)),
    bench "unifyTri" (whnf (fromJust . uncurry unifyTri) (t2, u2)),
    bench "unify-close" (whnf (uncurry unify) (t2, u2)),
    bench "unify-subst-iter1" (whnf (build . uncurry subst) (sub', t2)),
    bench "unify-subst-iter2" (whnf (build . uncurry subst) (sub', u2)),
    bench "unify-subst-closed1" (whnf (build . uncurry subst) (csub', t2)),
    bench "unify-subst-closed2" (whnf (build . uncurry subst) (csub', u2)),
    bench "mgu-tri" (whnf (uncurry mgu1) (t2, u2)),
    bench "mgu-close" (whnf (uncurry mgu2) (t2, u2)),
    bench "make-constant" (whnf (build . uncurry app) (F 0, empty)),
    bench "baseline" (whnf (uncurry (+)) (0 :: Int, 0))]

prop :: Bool -> NonNegative (Small Int) -> NonNegative (Small Int) -> Property
prop fun_ (NonNegative (Small index_)) (NonNegative (Small size_)) =
  (isFun x, index x, size x) === (fun_, index_, size_)
  where
    x = toSymbol (fromSymbol (Symbol fun_ index_ size_))

prop2 :: Int64 -> Property
prop2 x = fromSymbol (toSymbol x) === x