tests/Test/Term.hs

   1 {-# OPTIONS_GHC -fno-warn-orphans #-}
   2
   3 module Test.Term where
   4
   5 import Test.QuickCheck
   6 import Control.Applicative
   7 import Lambda.Parser.Fancy
   8 import Lambda.Term
   9
  10 cP :: Term
  11 cP = tRead "(λa d c.(λa.e) b (λc.d)) ((λa.(λd.a) (λd c.b ((λa.a) a)) (a ((λa.(λd.e) ((λe.(λd b.a) (λa c.(λa a d.(λd.b (λa d.c) e) (λb b.c a (a d (λb d d e a.d (λb b.d))))) ((λb.a) c)) (d ((λc.(λd.a (λe.e)) (c d)) ((λe.b) a))) c (λa.d (e (λe.(λd c.b) a))) (c (b a)) a (λe.(λa b e b a.d) b)) ((λe.b) (λa.b)) ((λe d.b) b) e) b) ((λc c.a e) (λb.(λb.e) a)))) (λe.e) b (λd c e e c a.c)) a)"
  12
  13 cY :: Term
  14 cY = tRead "λf.(λx.f (x x)) (λx.f (x x))"
  15 cI :: Term
  16 cI = tRead "λx.x"
  17 cK :: Term
  18 cK = tRead "λx y.x"
  19 cS :: Term
  20 cS = tRead "λx y z.x z (y z)"
  21
  22 instance Arbitrary Term
  23   where arbitrary = sized aTerm
  24
  25 aVarName :: Gen String
  26 aVarName = oneof . map (pure . (:[])) $ ['a'..'e']
  27
  28 aComb :: Gen Term
  29 aComb = oneof . map pure $ [cS, cK, cI, cY]
  30
  31 aVar :: Gen Term
  32 aVar = liftA Var aVarName
  33
  34 aTerm :: Int -> Gen Term
  35 aTerm 0 = aVar
  36 aTerm n = oneof [aVar, aComb, liftA2 Lambda aVarName $ aTerm (n - 1), liftA2 App (aTerm (n `div` 2)) (aTerm (n `div` 2))]
  37 --
  38 -- TODO: shrink Terms
  39 -- TODO: timed tests
  40
  41