module Language.Lambda.Shared.UniqueSupply where

import Language.Lambda.Shared.Errors (LambdaException(..))

import Control.Monad.Except (MonadError(..), throwError)
import RIO
import RIO.List (find)
import RIO.Text (pack, toUpper)

type Unique = Text

defaultUniques :: [Unique]
defaultUniques :: [Unique]
defaultUniques = forall a b. (a -> b) -> [a] -> [b]
map String -> Unique
pack [String]
strings
  where strings :: [String]
strings = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
p -> forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:String
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [Char
'a'..Char
'z']) [String]
suffix
        suffix :: [String]
suffix = String
"" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [(Int
0::Int)..]

defaultTyUniques :: [Unique]
defaultTyUniques :: [Unique]
defaultTyUniques = forall a b. (a -> b) -> [a] -> [b]
map Unique -> Unique
toUpper [Unique]
defaultUniques

next
  :: (Ord name, MonadError LambdaException m)
  => [name] -- ^ Unique supply
  -> [name] -- ^ Free Variables
  -> m name
next :: forall name (m :: * -> *).
(Ord name, MonadError LambdaException m) =>
[name] -> [name] -> m name
next [name]
freeVars [name]
uniques' = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [name]
freeVars) [name]
uniques' of
  Just name
unique -> forall (f :: * -> *) a. Applicative f => a -> f a
pure name
unique
  Maybe name
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError LambdaException
ImpossibleError