    {-# LANGUAGE DeriveGeneric #-}
    module Cryptol.ModuleSystem.Exports where

    import Data.Set(Set)
    import qualified Data.Set as Set
    import Data.Foldable(fold)
    import Control.DeepSeq(NFData)
    import GHC.Generics (Generic)

    import Cryptol.Parser.AST
    import Cryptol.Parser.Names

    modExports :: Ord name => Module name -> ExportSpec name
    modExports :: Module name -> ExportSpec name
    modExports m :: Module name
    m = [ExportSpec name] -> ExportSpec name
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold ([[ExportSpec name]] -> [ExportSpec name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ TopDecl name -> [ExportSpec name]
    forall name. Ord name => TopDecl name -> [ExportSpec name]
    exportedNames TopDecl name
    d | TopDecl name
    d <- Module name -> [TopDecl name]
    forall name. Module name -> [TopDecl name]
    mDecls Module name
    m ])
      where
      names :: (a -> ([Located a], b)) -> TopLevel a -> [TopLevel a]
    names by :: a -> ([Located a], b)
    by td :: TopLevel a
    td = [ TopLevel a
    td { tlValue :: a
    tlValue = Located a -> a
    forall a. Located a -> a
    thing Located a
    n } | Located a
    n <- ([Located a], b) -> [Located a]
    forall a b. (a, b) -> a
    fst (a -> ([Located a], b)
    by (TopLevel a -> a
    forall a. TopLevel a -> a
    tlValue TopLevel a
    td)) ]

      exportedNames :: TopDecl name -> [ExportSpec name]
    exportedNames (Decl td :: TopLevel (Decl name)
    td) = (TopLevel name -> ExportSpec name)
    -> [TopLevel name] -> [ExportSpec name]
    forall a b. (a -> b) -> [a] -> [b]
    map TopLevel name -> ExportSpec name
    forall name. Ord name => TopLevel name -> ExportSpec name
    exportBind  ((Decl name -> ([Located name], Set name))
    -> TopLevel (Decl name) -> [TopLevel name]
    forall a a b. (a -> ([Located a], b)) -> TopLevel a -> [TopLevel a]
    names  Decl name -> ([Located name], Set name)
    forall name. Ord name => Decl name -> ([Located name], Set name)
    namesD TopLevel (Decl name)
    td)
                             [ExportSpec name] -> [ExportSpec name] -> [ExportSpec name]
    forall a. [a] -> [a] -> [a]
    ++ (TopLevel name -> ExportSpec name)
    -> [TopLevel name] -> [ExportSpec name]
    forall a b. (a -> b) -> [a] -> [b]
    map TopLevel name -> ExportSpec name
    forall name. Ord name => TopLevel name -> ExportSpec name
    exportType ((Decl name -> ([Located name], Set name))
    -> TopLevel (Decl name) -> [TopLevel name]
    forall a a b. (a -> ([Located a], b)) -> TopLevel a -> [TopLevel a]
    names Decl name -> ([Located name], Set name)
    forall name. Ord name => Decl name -> ([Located name], Set name)
    tnamesD TopLevel (Decl name)
    td)
      exportedNames (DPrimType t :: TopLevel (PrimType name)
    t) = [ TopLevel name -> ExportSpec name
    forall name. Ord name => TopLevel name -> ExportSpec name
    exportType (Located name -> name
    forall a. Located a -> a
    thing (Located name -> name)
    -> (PrimType name -> Located name) -> PrimType name -> name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrimType name -> Located name
    forall name. PrimType name -> Located name
    primTName (PrimType name -> name)
    -> TopLevel (PrimType name) -> TopLevel name
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TopLevel (PrimType name)
    t) ]
      exportedNames (TDNewtype nt :: TopLevel (Newtype name)
    nt) = (TopLevel name -> ExportSpec name)
    -> [TopLevel name] -> [ExportSpec name]
    forall a b. (a -> b) -> [a] -> [b]
    map TopLevel name -> ExportSpec name
    forall name. Ord name => TopLevel name -> ExportSpec name
    exportType ((Newtype name -> ([Located name], ()))
    -> TopLevel (Newtype name) -> [TopLevel name]
    forall a a b. (a -> ([Located a], b)) -> TopLevel a -> [TopLevel a]
    names Newtype name -> ([Located name], ())
    forall name. Newtype name -> ([Located name], ())
    tnamesNT TopLevel (Newtype name)
    nt)
      exportedNames (Include {})  = []
      exportedNames (DParameterFun {}) = []
      exportedNames (DParameterType {}) = []
      exportedNames (DParameterConstraint {}) = []

    data ExportSpec name = ExportSpec { ExportSpec name -> Set name
    eTypes  :: Set name
                                      , ExportSpec name -> Set name
    eBinds  :: Set name
                                      } deriving (Int -> ExportSpec name -> ShowS
    [ExportSpec name] -> ShowS
    ExportSpec name -> String
    (Int -> ExportSpec name -> ShowS)
    -> (ExportSpec name -> String)
    -> ([ExportSpec name] -> ShowS)
    -> Show (ExportSpec name)
    forall name. Show name => Int -> ExportSpec name -> ShowS
    forall name. Show name => [ExportSpec name] -> ShowS
    forall name. Show name => ExportSpec name -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ExportSpec name] -> ShowS
    $cshowList :: forall name. Show name => [ExportSpec name] -> ShowS
    show :: ExportSpec name -> String
    $cshow :: forall name. Show name => ExportSpec name -> String
    showsPrec :: Int -> ExportSpec name -> ShowS
    $cshowsPrec :: forall name. Show name => Int -> ExportSpec name -> ShowS
    Show, (forall x. ExportSpec name -> Rep (ExportSpec name) x)
    -> (forall x. Rep (ExportSpec name) x -> ExportSpec name)
    -> Generic (ExportSpec name)
    forall x. Rep (ExportSpec name) x -> ExportSpec name
    forall x. ExportSpec name -> Rep (ExportSpec name) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall name x. Rep (ExportSpec name) x -> ExportSpec name
    forall name x. ExportSpec name -> Rep (ExportSpec name) x
    $cto :: forall name x. Rep (ExportSpec name) x -> ExportSpec name
    $cfrom :: forall name x. ExportSpec name -> Rep (ExportSpec name) x
    Generic)

    instance NFData name => NFData (ExportSpec name)

    instance Ord name => Semigroup (ExportSpec name) where
      l :: ExportSpec name
    l <> :: ExportSpec name -> ExportSpec name -> ExportSpec name
    <> r :: ExportSpec name
    r = ExportSpec :: forall name. Set name -> Set name -> ExportSpec name
    ExportSpec { eTypes :: Set name
    eTypes = ExportSpec name -> Set name
    forall name. ExportSpec name -> Set name
    eTypes ExportSpec name
    l Set name -> Set name -> Set name
    forall a. Semigroup a => a -> a -> a
    <> ExportSpec name -> Set name
    forall name. ExportSpec name -> Set name
    eTypes ExportSpec name
    r
                          , eBinds :: Set name
    eBinds = ExportSpec name -> Set name
    forall name. ExportSpec name -> Set name
    eBinds ExportSpec name
    l Set name -> Set name -> Set name
    forall a. Semigroup a => a -> a -> a
    <> ExportSpec name -> Set name
    forall name. ExportSpec name -> Set name
    eBinds  ExportSpec name
    r
                          }

    instance Ord name => Monoid (ExportSpec name) where
      mempty :: ExportSpec name
    mempty  = ExportSpec :: forall name. Set name -> Set name -> ExportSpec name
    ExportSpec { eTypes :: Set name
    eTypes = Set name
    forall a. Monoid a => a
    mempty, eBinds :: Set name
    eBinds = Set name
    forall a. Monoid a => a
    mempty }
      mappend :: ExportSpec name -> ExportSpec name -> ExportSpec name
    mappend = ExportSpec name -> ExportSpec name -> ExportSpec name
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Add a binding name to the export list, if it should be exported.
    exportBind :: Ord name => TopLevel name -> ExportSpec name
    exportBind :: TopLevel name -> ExportSpec name
    exportBind n :: TopLevel name
    n
      | TopLevel name -> ExportType
    forall a. TopLevel a -> ExportType
    tlExport TopLevel name
    n ExportType -> ExportType -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExportType
    Public = ExportSpec name
    forall a. Monoid a => a
    mempty { eBinds :: Set name
    eBinds = name -> Set name
    forall a. a -> Set a
    Set.singleton (TopLevel name -> name
    forall a. TopLevel a -> a
    tlValue TopLevel name
    n) }
      | Bool
    otherwise            = ExportSpec name
    forall a. Monoid a => a
    mempty

    -- | Add a type synonym name to the export list, if it should be exported.
    exportType :: Ord name => TopLevel name -> ExportSpec name
    exportType :: TopLevel name -> ExportSpec name
    exportType n :: TopLevel name
    n
      | TopLevel name -> ExportType
    forall a. TopLevel a -> ExportType
    tlExport TopLevel name
    n ExportType -> ExportType -> Bool
    forall a. Eq a => a -> a -> Bool
    == ExportType
    Public = ExportSpec name
    forall a. Monoid a => a
    mempty { eTypes :: Set name
    eTypes = name -> Set name
    forall a. a -> Set a
    Set.singleton (TopLevel name -> name
    forall a. TopLevel a -> a
    tlValue TopLevel name
    n) }
      | Bool
    otherwise            = ExportSpec name
    forall a. Monoid a => a
    mempty

    -- | Check to see if a binding is exported.
    isExportedBind :: Ord name => name -> ExportSpec name -> Bool
    isExportedBind :: name -> ExportSpec name -> Bool
    isExportedBind n :: name
    n = name -> Set name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member name
    n (Set name -> Bool)
    -> (ExportSpec name -> Set name) -> ExportSpec name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExportSpec name -> Set name
    forall name. ExportSpec name -> Set name
    eBinds

    -- | Check to see if a type synonym is exported.
    isExportedType :: Ord name => name -> ExportSpec name -> Bool
    isExportedType :: name -> ExportSpec name -> Bool
    isExportedType n :: name
    n = name -> Set name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member name
    n (Set name -> Bool)
    -> (ExportSpec name -> Set name) -> ExportSpec name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExportSpec name -> Set name
    forall name. ExportSpec name -> Set name
    eTypes