-- | Sets of lookahead symbols.
module Data.Cfg.LookaheadSet
  ( LookaheadSet
  , mkLookaheadSet
  , fromList
  , toSet
    -- * Set operations
  , empty
  , singleton
  , unions
  ) where

import Data.Cfg.Augment (AugT(..))
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import qualified Data.Set as S

-- | Set of lookahead symbols providing different 'Monoid' semantics
-- than 'Data.Set.Set'.  ('mappend' implements concatenation, not set
-- union.)
newtype LookaheadSet t = LookaheadSet
  { LookaheadSet t -> Set (AugT t)
toSet :: S.Set (AugT t)
    -- ^ Converts the 'LookaheadSet' to a regular 'Data.Set.Set'
  } deriving (LookaheadSet t -> LookaheadSet t -> Bool
(LookaheadSet t -> LookaheadSet t -> Bool)
-> (LookaheadSet t -> LookaheadSet t -> Bool)
-> Eq (LookaheadSet t)
forall t. Eq t => LookaheadSet t -> LookaheadSet t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookaheadSet t -> LookaheadSet t -> Bool
$c/= :: forall t. Eq t => LookaheadSet t -> LookaheadSet t -> Bool
== :: LookaheadSet t -> LookaheadSet t -> Bool
$c== :: forall t. Eq t => LookaheadSet t -> LookaheadSet t -> Bool
Eq, Eq (LookaheadSet t)
Eq (LookaheadSet t)
-> (LookaheadSet t -> LookaheadSet t -> Ordering)
-> (LookaheadSet t -> LookaheadSet t -> Bool)
-> (LookaheadSet t -> LookaheadSet t -> Bool)
-> (LookaheadSet t -> LookaheadSet t -> Bool)
-> (LookaheadSet t -> LookaheadSet t -> Bool)
-> (LookaheadSet t -> LookaheadSet t -> LookaheadSet t)
-> (LookaheadSet t -> LookaheadSet t -> LookaheadSet t)
-> Ord (LookaheadSet t)
LookaheadSet t -> LookaheadSet t -> Bool
LookaheadSet t -> LookaheadSet t -> Ordering
LookaheadSet t -> LookaheadSet t -> LookaheadSet 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 t. Ord t => Eq (LookaheadSet t)
forall t. Ord t => LookaheadSet t -> LookaheadSet t -> Bool
forall t. Ord t => LookaheadSet t -> LookaheadSet t -> Ordering
forall t.
Ord t =>
LookaheadSet t -> LookaheadSet t -> LookaheadSet t
min :: LookaheadSet t -> LookaheadSet t -> LookaheadSet t
$cmin :: forall t.
Ord t =>
LookaheadSet t -> LookaheadSet t -> LookaheadSet t
max :: LookaheadSet t -> LookaheadSet t -> LookaheadSet t
$cmax :: forall t.
Ord t =>
LookaheadSet t -> LookaheadSet t -> LookaheadSet t
>= :: LookaheadSet t -> LookaheadSet t -> Bool
$c>= :: forall t. Ord t => LookaheadSet t -> LookaheadSet t -> Bool
> :: LookaheadSet t -> LookaheadSet t -> Bool
$c> :: forall t. Ord t => LookaheadSet t -> LookaheadSet t -> Bool
<= :: LookaheadSet t -> LookaheadSet t -> Bool
$c<= :: forall t. Ord t => LookaheadSet t -> LookaheadSet t -> Bool
< :: LookaheadSet t -> LookaheadSet t -> Bool
$c< :: forall t. Ord t => LookaheadSet t -> LookaheadSet t -> Bool
compare :: LookaheadSet t -> LookaheadSet t -> Ordering
$ccompare :: forall t. Ord t => LookaheadSet t -> LookaheadSet t -> Ordering
$cp1Ord :: forall t. Ord t => Eq (LookaheadSet t)
Ord, Int -> LookaheadSet t -> ShowS
[LookaheadSet t] -> ShowS
LookaheadSet t -> String
(Int -> LookaheadSet t -> ShowS)
-> (LookaheadSet t -> String)
-> ([LookaheadSet t] -> ShowS)
-> Show (LookaheadSet t)
forall t. Show t => Int -> LookaheadSet t -> ShowS
forall t. Show t => [LookaheadSet t] -> ShowS
forall t. Show t => LookaheadSet t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookaheadSet t] -> ShowS
$cshowList :: forall t. Show t => [LookaheadSet t] -> ShowS
show :: LookaheadSet t -> String
$cshow :: forall t. Show t => LookaheadSet t -> String
showsPrec :: Int -> LookaheadSet t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> LookaheadSet t -> ShowS
Show)

instance Ord t => Semigroup (LookaheadSet t) where
  l :: LookaheadSet t
l@(LookaheadSet Set (AugT t)
s) <> :: LookaheadSet t -> LookaheadSet t -> LookaheadSet t
<> LookaheadSet Set (AugT t)
s' =
    if AugT t
forall t. AugT t
EOF AugT t -> Set (AugT t) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set (AugT t)
s
      then Set (AugT t) -> LookaheadSet t
forall t. Set (AugT t) -> LookaheadSet t
LookaheadSet (Set (AugT t) -> LookaheadSet t) -> Set (AugT t) -> LookaheadSet t
forall a b. (a -> b) -> a -> b
$ AugT t -> Set (AugT t) -> Set (AugT t)
forall a. Ord a => a -> Set a -> Set a
S.delete AugT t
forall t. AugT t
EOF Set (AugT t)
s Set (AugT t) -> Set (AugT t) -> Set (AugT t)
forall a. Ord a => Set a -> Set a -> Set a
`S.union` Set (AugT t)
s'
      else LookaheadSet t
l

instance Ord t => Monoid (LookaheadSet t) where
  mempty :: LookaheadSet t
mempty = Set (AugT t) -> LookaheadSet t
forall t. Set (AugT t) -> LookaheadSet t
LookaheadSet (Set (AugT t) -> LookaheadSet t) -> Set (AugT t) -> LookaheadSet t
forall a b. (a -> b) -> a -> b
$ AugT t -> Set (AugT t)
forall a. a -> Set a
S.singleton AugT t
forall t. AugT t
EOF
  mappend :: LookaheadSet t -> LookaheadSet t -> LookaheadSet t
mappend = LookaheadSet t -> LookaheadSet t -> LookaheadSet t
forall a. Semigroup a => a -> a -> a
(<>)

-- | Creates a 'LookaheadSet'
mkLookaheadSet ::
     (Ord t)
  => Bool -- ^ true iff it has 'EOF'
  -> [t] -- ^ terminal symbols
  -> LookaheadSet t
mkLookaheadSet :: Bool -> [t] -> LookaheadSet t
mkLookaheadSet Bool
hasEOF = Set (AugT t) -> LookaheadSet t
forall t. Set (AugT t) -> LookaheadSet t
LookaheadSet (Set (AugT t) -> LookaheadSet t)
-> ([t] -> Set (AugT t)) -> [t] -> LookaheadSet t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AugT t] -> Set (AugT t)
forall a. Ord a => [a] -> Set a
S.fromList ([AugT t] -> Set (AugT t))
-> ([t] -> [AugT t]) -> [t] -> Set (AugT t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AugT t] -> [AugT t]
forall t. [AugT t] -> [AugT t]
f ([AugT t] -> [AugT t]) -> ([t] -> [AugT t]) -> [t] -> [AugT t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> AugT t) -> [t] -> [AugT t]
forall a b. (a -> b) -> [a] -> [b]
map t -> AugT t
forall t. t -> AugT t
AugT
  where
    f :: [AugT t] -> [AugT t]
f =
      if Bool
hasEOF
        then (AugT t
forall t. AugT t
EOF AugT t -> [AugT t] -> [AugT t]
forall a. a -> [a] -> [a]
:)
        else [AugT t] -> [AugT t]
forall a. a -> a
id

-- | Creates a 'LookaheadSet' from a list of augmented terminals.
fromList :: Ord t => [AugT t] -> LookaheadSet t
fromList :: [AugT t] -> LookaheadSet t
fromList = Set (AugT t) -> LookaheadSet t
forall t. Set (AugT t) -> LookaheadSet t
LookaheadSet (Set (AugT t) -> LookaheadSet t)
-> ([AugT t] -> Set (AugT t)) -> [AugT t] -> LookaheadSet t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AugT t] -> Set (AugT t)
forall a. Ord a => [a] -> Set a
S.fromList

-- | The empty lookahead set.
empty :: LookaheadSet t
empty :: LookaheadSet t
empty = Set (AugT t) -> LookaheadSet t
forall t. Set (AugT t) -> LookaheadSet t
LookaheadSet Set (AugT t)
forall a. Set a
S.empty

-- | Creates a singleton lookahead set.
singleton :: AugT t -> LookaheadSet t
singleton :: AugT t -> LookaheadSet t
singleton = Set (AugT t) -> LookaheadSet t
forall t. Set (AugT t) -> LookaheadSet t
LookaheadSet (Set (AugT t) -> LookaheadSet t)
-> (AugT t -> Set (AugT t)) -> AugT t -> LookaheadSet t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AugT t -> Set (AugT t)
forall a. a -> Set a
S.singleton

-- | Returns the union of all the lookahead sets.
unions :: Ord t => [LookaheadSet t] -> LookaheadSet t
unions :: [LookaheadSet t] -> LookaheadSet t
unions = Set (AugT t) -> LookaheadSet t
forall t. Set (AugT t) -> LookaheadSet t
LookaheadSet (Set (AugT t) -> LookaheadSet t)
-> ([LookaheadSet t] -> Set (AugT t))
-> [LookaheadSet t]
-> LookaheadSet t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set (AugT t)] -> Set (AugT t)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set (AugT t)] -> Set (AugT t))
-> ([LookaheadSet t] -> [Set (AugT t)])
-> [LookaheadSet t]
-> Set (AugT t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LookaheadSet t -> Set (AugT t))
-> [LookaheadSet t] -> [Set (AugT t)]
forall a b. (a -> b) -> [a] -> [b]
map LookaheadSet t -> Set (AugT t)
forall t. LookaheadSet t -> Set (AugT t)
toSet