content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -- | Check whether generated AST will have empty types.
  --
  -- Internal rules are included.
  --
  -- We compute by a saturation algorithm which token types are used in which non-terminal.
  -- A non-terminal does not use any token types, we flag an empty type.
  
  module BNFC.Check.EmptyTypes (emptyData) where
  
  import Data.Maybe
  import Data.Map (Map)
  
  import qualified Data.List as List
  import qualified Data.Map as Map
  
  import BNFC.CF
  
  -- | Compute the categories that have empty data type declarations in the abstract syntax.
  --   Disregards list types.
  emptyData :: forall f. (IsFun f) => [Rul f] -> [RCat]
  emptyData rs =
    [ pc
    | Rule _ pc _ _ <- rs
    , let c = wpThing pc
    , not $ isList c
    , Left x <- [baseCat c]
    , maybe True List.null $ Map.lookup x ruleMap
    ]
    where
    ruleMap :: Map BaseCat [f]
    ruleMap = Map.unionsWith (++) $ (`mapMaybe` rs) $ \case
      Rule f pc _ _
        | not (isCoercion f), Left x <- baseCat (wpThing pc)
            -> Just $ Map.singleton x [f]
        | otherwise
            -> Nothing
  
  
  -- -- STILLBORN CODE:
  
  -- type UsedTokenTypes = Map BaseCat (Set TokenCat)
  
  -- -- | Not sure what emptyCats computes:
  -- emptyCats :: [Rul f] -> [RCat]
  -- emptyCats rs =
  --   [ pc
  --   | Rule _ pc _ _ <- rs
  --   , let c = wpThing pc
  --   , not $ isList c
  --   , Left x <- [baseCat c]
  --   , maybe False Set.null $ Map.lookup x usedTokenMap
  --   ]
  --   where
  --   -- The computation of the UsedTokenTypes is likely correct (but untested).
  --   usedTokenMap = saturate Map.empty
  --   -- standard least fixed-point iteration from below
  --   saturate m = if m' == m then m' else saturate m'
  --     where m' = step m
  --   -- step is monotone!
  --   step :: UsedTokenTypes -> UsedTokenTypes
  --   step m = Map.unionsWith Set.union $ map stepRule rs
  --     where
  --     -- Compute the used tokens for a NT based on a single rule,
  --     -- using the information we have already for the NTs on the rhs.
  --     stepRule (Rule _ (WithPosition _ c0) rhs _) =
  --       case baseCat c0 of
  --         Left x -> Map.singleton x $ Set.unions $ map typesFor rhsCats
  --         -- The TokenCat case is actually impossible, but this is consistent:
  --         Right x -> Map.singleton x $ Set.singleton x
  --       where
  --       rhsCats = mapMaybe (either (Just . baseCat) (const Nothing)) rhs
  --     typesFor = \case
  --       -- Not token cat:
  --       Left c  -> Map.findWithDefault Set.empty c m
  --       -- TokenCat:
  --       Right c -> Set.singleton c
  