{-# LANGUAGE FlexibleInstances #-}
{-|
Module: Lambek
Description: Lambek grammatical types
License: GPL-3
This module implements Lambek grammatical types. This is done by
taking a free monoid over the base types with their left and right
adjoints and adding the Lambek pregroup reductions as equations for
that monoid.
|-}
module Discokitty.Lambek
( Type (..)
, Lambek
, agreeOn
)
where
-- | Lambek basic grammatical types.
data Type = N | S | L Type | R Type deriving (Eq, Ord, Show)
-- | A Lambek pregroup type.
type Lambek = [Type]
-- | This operation checks if two types can be reduced. That is,
-- if one is the left/right adjoint of the other. Note that this is
-- not commutative.
(>~<) :: Type -> Type -> Bool
a >~< (L b) = a == b
(R a) >~< b = a == b
_ >~< _ = False
-- | Outputs true if the two Lambek pregroup words can be completely
-- reduced.
agree :: Lambek -> Lambek -> Bool
agree p = and . zipWith (>~<) p
-- | Checks if two Lambek types can be reduced a given number of
-- steps.
agreeOn :: Int -> Lambek -> Lambek -> Bool
agreeOn n p q = agree (take n (reverse p)) (take n q)