{-# 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)

-- | The returned list of names will be non-empty.
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 Names
xs =
  case Names
xs of
    One Name
x -> Name
x
    Ambig Set Name
ns
      |  Set Name -> Bool
forall a. Set a -> Bool
Set.null Set Name
ns
      -> String -> [String] -> Name
forall a. HasCallStack => String -> [String] -> a
panic String
"anyOne" [String
"Ambig with no names"]
      |  Bool
otherwise
      -> Int -> Set Name -> Name
forall a. Int -> Set a -> a
Set.elemAt Int
0 Set Name
ns

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