    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE BlockArguments #-}
    module Cryptol.ModuleSystem.Names where

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

    import Cryptol.Utils.Panic (panic)
    import Cryptol.ModuleSystem.Name

    -- | A non-empty collection of names used by the renamer.
    data Names = One Name | Ambig (Set Name) -- ^ Non-empty
      deriving (Int -> Names -> ShowS
    [Names] -> ShowS
    Names -> String
    (Int -> Names -> ShowS)
    -> (Names -> String) -> ([Names] -> ShowS) -> Show Names
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Names -> ShowS
    showsPrec :: Int -> Names -> ShowS
    $cshow :: Names -> String
    show :: Names -> String
    $cshowList :: [Names] -> ShowS
    showList :: [Names] -> ShowS
    Show,(forall x. Names -> Rep Names x)
    -> (forall x. Rep Names x -> Names) -> Generic Names
    forall x. Rep Names x -> Names
    forall x. Names -> Rep Names x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Names -> Rep Names x
    from :: forall x. Names -> Rep Names x
    $cto :: forall x. Rep Names x -> Names
    to :: forall x. Rep Names x -> Names
    Generic,Names -> ()
    (Names -> ()) -> NFData Names
    forall a. (a -> ()) -> NFData a
    $crnf :: Names -> ()
    rnf :: Names -> ()
    NFData)

    namesToList :: Names -> [Name]
    namesToList :: Names -> [Name]
    namesToList Names
    xs =
      case Names
    xs of
        One Name
    x -> [Name
    x]
        Ambig Set Name
    ns -> Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList Set Name
    ns

    anyOne :: Names -> Name
    anyOne :: Names -> Name
    anyOne = [Name] -> Name
    forall a. HasCallStack => [a] -> a
    head ([Name] -> Name) -> (Names -> [Name]) -> Names -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Names -> [Name]
    namesToList

    instance Semigroup Names where
      Names
    xs <> :: Names -> Names -> Names
    <> Names
    ys =
        case (Names
    xs,Names
    ys) of
          (One Name
    x, One Name
    y)
            | Name
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    y           -> Name -> Names
    One Name
    x
            | Bool
    otherwise        -> Set Name -> Names
    Ambig (Set Name -> Names) -> Set Name -> Names
    forall a b. (a -> b) -> a -> b
    $! [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList [Name
    x,Name
    y]
          (One Name
    x, Ambig Set Name
    as)    -> Set Name -> Names
    Ambig (Set Name -> Names) -> Set Name -> Names
    forall a b. (a -> b) -> a -> b
    $! Name -> Set Name -> Set Name
    forall a. Ord a => a -> Set a -> Set a
    Set.insert Name
    x Set Name
    as
          (Ambig Set Name
    as, One Name
    x)    -> Set Name -> Names
    Ambig (Set Name -> Names) -> Set Name -> Names
    forall a b. (a -> b) -> a -> b
    $! Name -> Set Name -> Set Name
    forall a. Ord a => a -> Set a -> Set a
    Set.insert Name
    x Set Name
    as
          (Ambig Set Name
    as, Ambig Set Name
    bs) -> Set Name -> Names
    Ambig (Set Name -> Names) -> Set Name -> Names
    forall a b. (a -> b) -> a -> b
    $! Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union Set Name
    as Set Name
    bs

    namesFromSet :: Set Name {- ^ Non-empty -} -> Names
    namesFromSet :: Set Name -> Names
    namesFromSet Set Name
    xs =
      case Set Name -> Maybe (Name, Set Name)
    forall a. Set a -> Maybe (a, Set a)
    Set.minView Set Name
    xs of
        Just (Name
    a,Set Name
    ys) -> if Set Name -> Bool
    forall a. Set a -> Bool
    Set.null Set Name
    ys then Name -> Names
    One Name
    a else Set Name -> Names
    Ambig Set Name
    xs
        Maybe (Name, Set Name)
    Nothing     -> String -> [String] -> Names
    forall a. HasCallStack => String -> [String] -> a
    panic String
    "namesFromSet" [String
    "empty set"]

    unionManyNames :: [Names] -> Maybe Names
    unionManyNames :: [Names] -> Maybe Names
    unionManyNames [Names]
    xs =
      case [Names]
    xs of
        [] -> Maybe Names
    forall a. Maybe a
    Nothing
        [Names]
    _  -> Names -> Maybe Names
    forall a. a -> Maybe a
    Just ((Names -> Names -> Names) -> [Names] -> Names
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 Names -> Names -> Names
    forall a. Semigroup a => a -> a -> a
    (<>) [Names]
    xs)

    mapNames :: (Name -> Name) -> Names -> Names
    mapNames :: (Name -> Name) -> Names -> Names
    mapNames Name -> Name
    f Names
    xs =
      case Names
    xs of
        One Name
    x -> Name -> Names
    One (Name -> Name
    f Name
    x)
        Ambig Set Name
    as -> Set Name -> Names
    namesFromSet ((Name -> Name) -> Set Name -> Set Name
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    Set.map Name -> Name
    f Set Name
    as)

    filterNames :: (Name -> Bool) -> Names -> Maybe Names
    filterNames :: (Name -> Bool) -> Names -> Maybe Names
    filterNames Name -> Bool
    p Names
    names =
      case Names
    names of
        One Name
    x -> if Name -> Bool
    p Name
    x then Names -> Maybe Names
    forall a. a -> Maybe a
    Just (Name -> Names
    One Name
    x) else Maybe Names
    forall a. Maybe a
    Nothing
        Ambig Set Name
    xs -> do let ys :: Set Name
    ys = (Name -> Bool) -> Set Name -> Set Name
    forall a. (a -> Bool) -> Set a -> Set a
    Set.filter Name -> Bool
    p Set Name
    xs
                       (Name
    y,Set Name
    zs) <- Set Name -> Maybe (Name, Set Name)
    forall a. Set a -> Maybe (a, Set a)
    Set.minView Set Name
    ys
                       if Set Name -> Bool
    forall a. Set a -> Bool
    Set.null Set Name
    zs then Names -> Maybe Names
    forall a. a -> Maybe a
    Just (Name -> Names
    One Name
    y) else Names -> Maybe Names
    forall a. a -> Maybe a
    Just (Set Name -> Names
    Ambig Set Name
    ys)

    travNames :: Applicative f => (Name -> f Name) -> Names -> f Names
    travNames :: forall (f :: * -> *).
    Applicative f =>
    (Name -> f Name) -> Names -> f Names
    travNames Name -> f Name
    f Names
    xs =
      case Names
    xs of
        One Name
    x -> Name -> Names
    One (Name -> Names) -> f Name -> f Names
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> f Name
    f Name
    x
        Ambig Set Name
    as -> Set Name -> Names
    namesFromSet (Set Name -> Names) -> ([Name] -> Set Name) -> [Name] -> Names
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Name] -> Set Name
    forall a. Ord a => [a] -> Set a
    Set.fromList ([Name] -> Names) -> f [Name] -> f Names
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Name -> f Name) -> [Name] -> f [Name]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse Name -> f Name
    f (Set Name -> [Name]
    forall a. Set a -> [a]
    Set.toList Set Name
    as)

    -- Names that are in the first but not the second
    diffNames :: Names -> Names -> Maybe Names
    diffNames :: Names -> Names -> Maybe Names
    diffNames Names
    x Names
    y =
      case Names
    x of
        One Name
    a ->
          case Names
    y of
            One Name
    b -> if Name
    a Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    b then Maybe Names
    forall a. Maybe a
    Nothing
                               else Names -> Maybe Names
    forall a. a -> Maybe a
    Just (Name -> Names
    One Name
    a)
            Ambig Set Name
    xs -> if Name
    a Name -> Set Name -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set Name
    xs then Maybe Names
    forall a. Maybe a
    Nothing else Names -> Maybe Names
    forall a. a -> Maybe a
    Just (Name -> Names
    One Name
    a)
        Ambig Set Name
    xs ->
          do (Name
    a,Set Name
    rest) <- Set Name -> Maybe (Name, Set Name)
    forall a. Set a -> Maybe (a, Set a)
    Set.minView Set Name
    ys
             Names -> Maybe Names
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure if Set Name -> Bool
    forall a. Set a -> Bool
    Set.null Set Name
    rest then Name -> Names
    One Name
    a else Set Name -> Names
    Ambig Set Name
    xs

          where
          ys :: Set Name
    ys = case Names
    y of
                 One Name
    z    -> Name -> Set Name -> Set Name
    forall a. Ord a => a -> Set a -> Set a
    Set.delete Name
    z Set Name
    xs
                 Ambig Set Name
    zs -> Set Name -> Set Name -> Set Name
    forall a. Ord a => Set a -> Set a -> Set a
    Set.difference Set Name
    xs Set Name
    zs