{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Names] -> ShowS
$cshowList :: [Names] -> ShowS
show :: Names -> String
$cshow :: Names -> String
showsPrec :: Int -> Names -> ShowS
$cshowsPrec :: Int -> Names -> ShowS
Show,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
$cto :: forall x. Rep Names x -> Names
$cfrom :: forall x. Names -> Rep Names x
Generic,Names -> ()
forall a. (a -> ()) -> NFData a
rnf :: Names -> ()
$crnf :: Names -> ()
NFData)

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

anyOne :: Names -> Name
anyOne :: Names -> Name
anyOne = forall a. [a] -> a
head 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 forall a. Eq a => a -> a -> Bool
== Name
y           -> Name -> Names
One Name
x
        | Bool
otherwise        -> Set Name -> Names
Ambig forall a b. (a -> b) -> a -> b
$! forall a. Ord a => [a] -> Set a
Set.fromList [Name
x,Name
y]
      (One Name
x, Ambig Set Name
as)    -> Set Name -> Names
Ambig forall a b. (a -> b) -> a -> b
$! 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 forall a b. (a -> b) -> a -> b
$! 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 forall a b. (a -> b) -> a -> b
$! 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 forall a. Set a -> Maybe (a, Set a)
Set.minView Set Name
xs of
    Just (Name
a,Set Name
ys) -> if 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     -> 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
    [] -> forall a. Maybe a
Nothing
    [Names]
_  -> forall a. a -> Maybe a
Just (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 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 (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 forall a. a -> Maybe a
Just (Name -> Names
One Name
x) else forall a. Maybe a
Nothing
    Ambig Set Name
xs -> do let ys :: Set Name
ys = forall a. (a -> Bool) -> Set a -> Set a
Set.filter Name -> Bool
p Set Name
xs
                   (Name
y,Set Name
zs) <- forall a. Set a -> Maybe (a, Set a)
Set.minView Set Name
ys
                   if forall a. Set a -> Bool
Set.null Set Name
zs then forall a. a -> Maybe a
Just (Name -> Names
One Name
y) else 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Name -> f Name
f (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 forall a. Eq a => a -> a -> Bool
== Name
b then forall a. Maybe a
Nothing
                           else forall a. a -> Maybe a
Just (Name -> Names
One Name
a)
        Ambig Set Name
xs -> if Name
a forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Name
xs then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (Name -> Names
One Name
a)
    Ambig Set Name
xs ->
      do (Name
a,Set Name
rest) <- forall a. Set a -> Maybe (a, Set a)
Set.minView Set Name
ys
         forall (f :: * -> *) a. Applicative f => a -> f a
pure if 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    -> forall a. Ord a => a -> Set a -> Set a
Set.delete Name
z Set Name
xs
             Ambig Set Name
zs -> forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set Name
xs Set Name
zs