module FormalLanguage.GrammarProduct.Op.Add where
import Control.Lens hiding (outside)
import Control.Lens.Fold
import Control.Newtype
import Data.List (genericReplicate)
import Data.Monoid hiding ((<>))
import Data.Semigroup
import qualified Data.Set as S
import Text.Printf
import Data.Default
import FormalLanguage.CFG.Grammar
import FormalLanguage.GrammarProduct.Op.Common
add :: Grammar -> Grammar -> Grammar
add l r = runAdd $ Add l <> Add r
newtype Add a = Add {runAdd :: a}
instance Semigroup (Add Grammar) where
(Add l) <> (Add r)
| Left err <- opCompatible l r = error err
| otherwise = Add $ Grammar (l^.synvars <> r^.synvars)
(l^.synterms <> r^.synterms)
(l^.termvars <> r^.termvars)
(l^.outside)
(l^.rules <> r^.rules)
s
(l^.params <> r^.params)
(l^.grammarName <> r^.grammarName)
False
where s | l^.start == r^.start = l^.start
| l^.start /= mempty && r^.start /= mempty = error "add new start symbol"
| l^.start == mempty = r^.start
| r^.start == mempty = l^.start
instance Monoid (Add Grammar) where
mempty = Add def
mappend = (<>)