-- SPDX-License-Identifier: MIT
-- Copyright (c) 2021 Chua Hou

-----------------------------------------------------------------------------
-- |
-- Module      : CFGEq.CFG
-- Copyright   : Chua Hou 2021
-- License     : MIT
--
-- Maintainer  : Chua Hou <human+github@chuahou.dev>
-- Stability   : experimental
-- Portability : non-portable
--
-- The DSL used to describe CFGs.
-----------------------------------------------------------------------------

module CFGEq.CFG where

import           Data.Set (Set)

-- | @CFG v t@ is the type of context-free grammars with variables of type @v@
-- and terminals of type @t@. Each such grammar contains the set of 'Rule's
-- and the start symbol. The list of terminals and non-terminals does not need
-- to be explicitly stated for our purposes.
data CFG v t = CFG { CFG v t -> Set (Rule v t)
rules :: Set (Rule v t) -- ^ Set of rules in the CFG.
                   , CFG v t -> v
start :: v              -- ^ The start symbol.
                   }
    deriving Int -> CFG v t -> ShowS
[CFG v t] -> ShowS
CFG v t -> String
(Int -> CFG v t -> ShowS)
-> (CFG v t -> String) -> ([CFG v t] -> ShowS) -> Show (CFG v t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v t. (Show v, Show t) => Int -> CFG v t -> ShowS
forall v t. (Show v, Show t) => [CFG v t] -> ShowS
forall v t. (Show v, Show t) => CFG v t -> String
showList :: [CFG v t] -> ShowS
$cshowList :: forall v t. (Show v, Show t) => [CFG v t] -> ShowS
show :: CFG v t -> String
$cshow :: forall v t. (Show v, Show t) => CFG v t -> String
showsPrec :: Int -> CFG v t -> ShowS
$cshowsPrec :: forall v t. (Show v, Show t) => Int -> CFG v t -> ShowS
Show

-- | @Rule v t@ is a CFG rule with variables of type @v@ and terminals of type
-- @t@. Variables with more than one rule should have multiple @Rule@s, for
-- example, \(S \to AB \mid \epsilon\) should have rules @[S :-> [Left A, Left
-- B], S :-> []]@.
data Rule v t =
    -- | @S :-> s@ is the rule generating the string given by the list @s@ from
    -- the variable @S@.
    v :-> Production v t
    deriving (Int -> Rule v t -> ShowS
[Rule v t] -> ShowS
Rule v t -> String
(Int -> Rule v t -> ShowS)
-> (Rule v t -> String) -> ([Rule v t] -> ShowS) -> Show (Rule v t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v t. (Show v, Show t) => Int -> Rule v t -> ShowS
forall v t. (Show v, Show t) => [Rule v t] -> ShowS
forall v t. (Show v, Show t) => Rule v t -> String
showList :: [Rule v t] -> ShowS
$cshowList :: forall v t. (Show v, Show t) => [Rule v t] -> ShowS
show :: Rule v t -> String
$cshow :: forall v t. (Show v, Show t) => Rule v t -> String
showsPrec :: Int -> Rule v t -> ShowS
$cshowsPrec :: forall v t. (Show v, Show t) => Int -> Rule v t -> ShowS
Show, Rule v t -> Rule v t -> Bool
(Rule v t -> Rule v t -> Bool)
-> (Rule v t -> Rule v t -> Bool) -> Eq (Rule v t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v t. (Eq v, Eq t) => Rule v t -> Rule v t -> Bool
/= :: Rule v t -> Rule v t -> Bool
$c/= :: forall v t. (Eq v, Eq t) => Rule v t -> Rule v t -> Bool
== :: Rule v t -> Rule v t -> Bool
$c== :: forall v t. (Eq v, Eq t) => Rule v t -> Rule v t -> Bool
Eq, Eq (Rule v t)
Eq (Rule v t)
-> (Rule v t -> Rule v t -> Ordering)
-> (Rule v t -> Rule v t -> Bool)
-> (Rule v t -> Rule v t -> Bool)
-> (Rule v t -> Rule v t -> Bool)
-> (Rule v t -> Rule v t -> Bool)
-> (Rule v t -> Rule v t -> Rule v t)
-> (Rule v t -> Rule v t -> Rule v t)
-> Ord (Rule v t)
Rule v t -> Rule v t -> Bool
Rule v t -> Rule v t -> Ordering
Rule v t -> Rule v t -> Rule v t
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v t. (Ord v, Ord t) => Eq (Rule v t)
forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Bool
forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Ordering
forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Rule v t
min :: Rule v t -> Rule v t -> Rule v t
$cmin :: forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Rule v t
max :: Rule v t -> Rule v t -> Rule v t
$cmax :: forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Rule v t
>= :: Rule v t -> Rule v t -> Bool
$c>= :: forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Bool
> :: Rule v t -> Rule v t -> Bool
$c> :: forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Bool
<= :: Rule v t -> Rule v t -> Bool
$c<= :: forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Bool
< :: Rule v t -> Rule v t -> Bool
$c< :: forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Bool
compare :: Rule v t -> Rule v t -> Ordering
$ccompare :: forall v t. (Ord v, Ord t) => Rule v t -> Rule v t -> Ordering
$cp1Ord :: forall v t. (Ord v, Ord t) => Eq (Rule v t)
Ord)

-- | The type of productions in a 'Rule'. The string is a list of 'Either's,
-- with 'Left's representing variables and 'Right's representing terminals.
type Production v t = [Either v t]