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

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

    import Cryptol.Parser.AST
    import Cryptol.Parser.Names(namesD,tnamesD,namesNT,tnamesNT)
    import Cryptol.ModuleSystem.Name

    exportedDecls :: Ord name => [TopDecl name] -> ExportSpec name
    exportedDecls :: forall name. Ord name => [TopDecl name] -> ExportSpec name
    exportedDecls [TopDecl name]
    ds = [ExportSpec name] -> ExportSpec name
    forall m. Monoid m => [m] -> m
    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 <- [TopDecl name]
    ds ])

    exportedNames :: Ord name => TopDecl name -> [ExportSpec name]
    exportedNames :: forall name. Ord name => TopDecl name -> [ExportSpec name]
    exportedNames TopDecl name
    decl =
        case TopDecl name
    decl of
          Decl 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)
          DPrimType 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) ]
          TDNewtype 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) [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
    exportBind ((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], ())
    namesNT TopLevel (Newtype name)
    nt)
          Include {}  -> []
          DImport {} -> []
          DParamDecl {} -> []
          DInterfaceConstraint {} -> []
          DModule TopLevel (NestedModule name)
    nested ->
            case TopLevel (NestedModule name) -> NestedModule name
    forall a. TopLevel a -> a
    tlValue TopLevel (NestedModule name)
    nested of
              NestedModule ModuleG name name
    x ->
                [Namespace -> TopLevel name -> ExportSpec name
    forall name.
    Ord name =>
    Namespace -> TopLevel name -> ExportSpec name
    exportName Namespace
    NSModule TopLevel (NestedModule name)
    nested { tlValue :: name
    tlValue = Located name -> name
    forall a. Located a -> a
    thing (ModuleG name name -> Located name
    forall mname name. ModuleG mname name -> Located mname
    mName ModuleG name name
    x) }]
          DModParam {} -> []
      where
      names :: (a -> ([Located a], b)) -> TopLevel a -> [TopLevel a]
    names a -> ([Located a], b)
    by 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)) ]

    newtype ExportSpec name = ExportSpec (Map Namespace (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
    $cshowsPrec :: forall name. Show name => Int -> ExportSpec name -> ShowS
    showsPrec :: Int -> ExportSpec name -> ShowS
    $cshow :: forall name. Show name => ExportSpec name -> String
    show :: ExportSpec name -> String
    $cshowList :: forall name. Show name => [ExportSpec name] -> ShowS
    showList :: [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
    $cfrom :: forall name x. ExportSpec name -> Rep (ExportSpec name) x
    from :: forall x. ExportSpec name -> Rep (ExportSpec name) x
    $cto :: forall name x. Rep (ExportSpec name) x -> ExportSpec name
    to :: forall x. Rep (ExportSpec name) x -> ExportSpec name
    Generic)

    instance NFData name => NFData (ExportSpec name)

    instance Ord name => Semigroup (ExportSpec name) where
      ExportSpec Map Namespace (Set name)
    l <> :: ExportSpec name -> ExportSpec name -> ExportSpec name
    <> ExportSpec Map Namespace (Set name)
    r = Map Namespace (Set name) -> ExportSpec name
    forall name. Map Namespace (Set name) -> ExportSpec name
    ExportSpec ((Set name -> Set name -> Set name)
    -> Map Namespace (Set name)
    -> Map Namespace (Set name)
    -> Map Namespace (Set name)
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith Set name -> Set name -> Set name
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union Map Namespace (Set name)
    l Map Namespace (Set name)
    r)

    instance Ord name => Monoid (ExportSpec name) where
      mempty :: ExportSpec name
    mempty  = Map Namespace (Set name) -> ExportSpec name
    forall name. Map Namespace (Set name) -> ExportSpec name
    ExportSpec Map Namespace (Set name)
    forall k a. Map k a
    Map.empty

    exportName :: Ord name => Namespace -> TopLevel name -> ExportSpec name
    exportName :: forall name.
    Ord name =>
    Namespace -> TopLevel name -> ExportSpec name
    exportName Namespace
    ns 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 = Map Namespace (Set name) -> ExportSpec name
    forall name. Map Namespace (Set name) -> ExportSpec name
    ExportSpec
                             (Map Namespace (Set name) -> ExportSpec name)
    -> Map Namespace (Set name) -> ExportSpec name
    forall a b. (a -> b) -> a -> b
    $ Namespace -> Set name -> Map Namespace (Set name)
    forall k a. k -> a -> Map k a
    Map.singleton Namespace
    ns
                             (Set name -> Map Namespace (Set name))
    -> Set name -> Map Namespace (Set name)
    forall a b. (a -> b) -> a -> b
    $ 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

    allExported :: Ord name => ExportSpec name -> Set name
    allExported :: forall name. Ord name => ExportSpec name -> Set name
    allExported (ExportSpec Map Namespace (Set name)
    mp) = [Set name] -> Set name
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions (Map Namespace (Set name) -> [Set name]
    forall k a. Map k a -> [a]
    Map.elems Map Namespace (Set name)
    mp)

    exported :: Namespace -> ExportSpec name -> Set name
    exported :: forall name. Namespace -> ExportSpec name -> Set name
    exported Namespace
    ns (ExportSpec Map Namespace (Set name)
    mp) = Set name -> Namespace -> Map Namespace (Set name) -> Set name
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault Set name
    forall a. Set a
    Set.empty Namespace
    ns Map Namespace (Set name)
    mp

    -- | Add a binding name to the export list, if it should be exported.
    exportBind :: Ord name => TopLevel name -> ExportSpec name
    exportBind :: forall name. Ord name => TopLevel name -> ExportSpec name
    exportBind = Namespace -> TopLevel name -> ExportSpec name
    forall name.
    Ord name =>
    Namespace -> TopLevel name -> ExportSpec name
    exportName Namespace
    NSValue

    -- | Add a type synonym name to the export list, if it should be exported.
    exportType :: Ord name => TopLevel name -> ExportSpec name
    exportType :: forall name. Ord name => TopLevel name -> ExportSpec name
    exportType = Namespace -> TopLevel name -> ExportSpec name
    forall name.
    Ord name =>
    Namespace -> TopLevel name -> ExportSpec name
    exportName Namespace
    NSType

    isExported :: Ord name => Namespace -> name -> ExportSpec name -> Bool
    isExported :: forall name.
    Ord name =>
    Namespace -> name -> ExportSpec name -> Bool
    isExported Namespace
    ns name
    x (ExportSpec Map Namespace (Set name)
    s) =
      case Namespace -> Map Namespace (Set name) -> Maybe (Set name)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Namespace
    ns Map Namespace (Set name)
    s of
        Maybe (Set name)
    Nothing -> Bool
    False
        Just Set name
    mp -> name -> Set name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member name
    x Set name
    mp

    -- | Check to see if a binding is exported.
    isExportedBind :: Ord name => name -> ExportSpec name -> Bool
    isExportedBind :: forall name. Ord name => name -> ExportSpec name -> Bool
    isExportedBind = Namespace -> name -> ExportSpec name -> Bool
    forall name.
    Ord name =>
    Namespace -> name -> ExportSpec name -> Bool
    isExported Namespace
    NSValue

    -- | Check to see if a type synonym is exported.
    isExportedType :: Ord name => name -> ExportSpec name -> Bool
    isExportedType :: forall name. Ord name => name -> ExportSpec name -> Bool
    isExportedType = Namespace -> name -> ExportSpec name -> Bool
    forall name.
    Ord name =>
    Namespace -> name -> ExportSpec name -> Bool
    isExported Namespace
    NSType