-- | Analysis of a context-free grammar
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Cfg.Analysis
  ( Analysis(..)
  , mkAnalysis
  , Prediction
  , Predictions
  ) where

import Data.Cfg.Augment
import qualified Data.Cfg.Cfg as Cfg
import Data.Cfg.FreeCfg
import qualified Data.Cfg.Internal.FirstSet as I
import qualified Data.Cfg.Internal.FollowSet as I
import qualified Data.Cfg.Internal.Nullable as I
import qualified Data.Cfg.Internal.PredictSet as I
import Data.Cfg.Internal.PredictSet (Prediction, Predictions)
import Data.Cfg.LookaheadSet
import qualified Data.Map.Strict as M
import qualified Data.Set as S

-- | Analysis of a context-free grammar
data Analysis t nt = Analysis
  { Analysis t nt -> FreeCfg t nt
baseCfg :: FreeCfg t nt
    -- ^ (a 'FreeCfg' equivalent to) the source grammar
  , Analysis t nt -> FreeCfg (AugT t) (AugNT nt)
augmentedCfg :: FreeCfg (AugT t) (AugNT nt)
    -- ^ the augmented grammar
  , Analysis t nt -> Set (AugNT nt)
nullables :: S.Set (AugNT nt)
    -- ^ the nonterminals in the grammar that can produce the
    -- empty string
  , Analysis t nt -> AugNT nt -> LookaheadSet t
firstSet :: AugNT nt -> LookaheadSet t
    -- ^ the first set of the nonterminal for the grammar
  , Analysis t nt -> AugVs t nt -> LookaheadSet t
firstsOfVs :: AugVs t nt -> LookaheadSet t
    -- ^ the first set of a list of symbols
  , Analysis t nt -> AugNT nt -> LookaheadSet t
followSet :: AugNT nt -> LookaheadSet t
    -- ^ the follow set of the nonterminal for the grammar
  , Analysis t nt -> AugProduction t nt -> LookaheadSet t
predictSet :: AugProduction t nt -> LookaheadSet t
    -- ^ the predict set of the production
  , Analysis t nt -> Bool
isLL1 :: Bool
    -- ^ 'True' iff the grammar is LL(1)
  , Analysis t nt -> AugNT nt -> Predictions t nt
ll1Info :: AugNT nt -> Predictions t nt
    -- ^ the productions for this nonterminal and the lookaheads
    -- that predict them
  }

-- | Analyzes a context-free grammar
mkAnalysis ::
     forall cfg t nt. (Cfg.Cfg cfg t nt, Ord nt, Ord t)
  => cfg t nt
  -> Analysis t nt
mkAnalysis :: cfg t nt -> Analysis t nt
mkAnalysis cfg t nt
cfg =
  Analysis :: forall t nt.
FreeCfg t nt
-> FreeCfg (AugT t) (AugNT nt)
-> Set (AugNT nt)
-> (AugNT nt -> LookaheadSet t)
-> (AugVs t nt -> LookaheadSet t)
-> (AugNT nt -> LookaheadSet t)
-> (AugProduction t nt -> LookaheadSet t)
-> Bool
-> (AugNT nt -> Predictions t nt)
-> Analysis t nt
Analysis
    { baseCfg :: FreeCfg t nt
baseCfg = FreeCfg t nt
bcfg
    , augmentedCfg :: FreeCfg (AugT t) (AugNT nt)
augmentedCfg = FreeCfg (AugT t) (AugNT nt)
cfg'
    , nullables :: Set (AugNT nt)
nullables = Set (AugNT nt)
ns
    , firstSet :: AugNT nt -> LookaheadSet t
firstSet = AugNT nt -> LookaheadSet t
fs
    , firstsOfVs :: AugVs t nt -> LookaheadSet t
firstsOfVs = (AugNT nt -> LookaheadSet t) -> AugVs t nt -> LookaheadSet t
forall t nt.
Ord t =>
(AugNT nt -> LookaheadSet t) -> AugVs t nt -> LookaheadSet t
I.firstsOfVs AugNT nt -> LookaheadSet t
fs
    , followSet :: AugNT nt -> LookaheadSet t
followSet = AugNT nt -> LookaheadSet t
fols
    , predictSet :: AugProduction t nt -> LookaheadSet t
predictSet = AugProduction t nt -> LookaheadSet t
predict
    , isLL1 :: Bool
isLL1 = Bool
isLL1'
    , ll1Info :: AugNT nt -> Predictions t nt
ll1Info = (Map (AugNT nt) (Predictions t nt)
ll1InfoMap Map (AugNT nt) (Predictions t nt) -> AugNT nt -> Predictions t nt
forall k a. Ord k => Map k a -> k -> a
M.!)
    }
  where
    bcfg :: FreeCfg t nt
bcfg = cfg t nt -> FreeCfg t nt
forall (cfg :: * -> * -> *) t nt.
Cfg cfg t nt =>
cfg t nt -> FreeCfg t nt
toFreeCfg cfg t nt
cfg
    cfg' :: FreeCfg (AugT t) (AugNT nt)
cfg' = FreeCfg t nt -> FreeCfg (AugT t) (AugNT nt)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg t nt, Ord nt, Ord t) =>
cfg t nt -> FreeCfg (AugT t) (AugNT nt)
augmentCfg FreeCfg t nt
bcfg
    ns :: Set (AugNT nt)
ns = FreeCfg (AugT t) (AugNT nt) -> Set (AugNT nt)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg t nt, Ord nt) =>
cfg t nt -> Set nt
I.nullables FreeCfg (AugT t) (AugNT nt)
cfg'
    fsm :: Map (AugNT nt) (LookaheadSet t)
fsm = FreeCfg (AugT t) (AugNT nt) -> Map (AugNT nt) (LookaheadSet t)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) =>
cfg (AugT t) (AugNT nt) -> Map (AugNT nt) (LookaheadSet t)
I.firstSetMap FreeCfg (AugT t) (AugNT nt)
cfg'
    fs :: AugNT nt -> LookaheadSet t
fs AugNT nt
nt = Map (AugNT nt) (LookaheadSet t)
fsm Map (AugNT nt) (LookaheadSet t) -> AugNT nt -> LookaheadSet t
forall k a. Ord k => Map k a -> k -> a
M.! AugNT nt
nt
    folm :: Map (AugNT nt) (LookaheadSet t)
folm = FreeCfg (AugT t) (AugNT nt)
-> (AugNT nt -> LookaheadSet t) -> Map (AugNT nt) (LookaheadSet t)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) =>
cfg (AugT t) (AugNT nt)
-> (AugNT nt -> LookaheadSet t) -> Map (AugNT nt) (LookaheadSet t)
I.followSetMap FreeCfg (AugT t) (AugNT nt)
cfg' AugNT nt -> LookaheadSet t
fs
    fols :: AugNT nt -> LookaheadSet t
fols AugNT nt
nt = Map (AugNT nt) (LookaheadSet t)
folm Map (AugNT nt) (LookaheadSet t) -> AugNT nt -> LookaheadSet t
forall k a. Ord k => Map k a -> k -> a
M.! AugNT nt
nt
    predict :: AugProduction t nt -> LookaheadSet t
predict = (AugNT nt -> LookaheadSet t)
-> (AugNT nt -> LookaheadSet t)
-> AugProduction t nt
-> LookaheadSet t
forall t nt.
Ord t =>
(AugNT nt -> LookaheadSet t)
-> (AugNT nt -> LookaheadSet t)
-> AugProduction t nt
-> LookaheadSet t
I.predictSet AugNT nt -> LookaheadSet t
fs AugNT nt -> LookaheadSet t
fols
    ll1InfoMap :: Map (AugNT nt) (Predictions t nt)
ll1InfoMap = FreeCfg (AugT t) (AugNT nt)
-> (AugProduction t nt -> LookaheadSet t)
-> Map (AugNT nt) (Predictions t nt)
forall (cfg :: * -> * -> *) t nt.
(Cfg cfg (AugT t) (AugNT nt), Ord nt, Ord t) =>
cfg (AugT t) (AugNT nt)
-> (AugProduction t nt -> LookaheadSet t)
-> Map (AugNT nt) (Predictions t nt)
I.ll1InfoMap FreeCfg (AugT t) (AugNT nt)
cfg' AugProduction t nt -> LookaheadSet t
predict
    isLL1' :: Bool
isLL1' = Map (AugNT nt) (Predictions t nt) -> Bool
forall nt t. Map (AugNT nt) (Predictions t nt) -> Bool
I.isLL1 Map (AugNT nt) (Predictions t nt)
ll1InfoMap