-- | Provides functions to generate new variable names of different kinds.

module Language.Haskell.FreeTheorems.NameStores
    ( typeNameStore
    , relationNameStore
    , typeExpressionNameStore
    , functionNameStore1
    , functionNameStore2
    , variableNameStore
    ) where



import Data.List (unfoldr)



-- | An infinite list of names for type variables.

typeNameStore :: [String]
typeNameStore :: [String]
typeNameStore = String -> Char -> [String]
createNames String
"abcde" Char
'a'



-- | An infinite list of names for relation variables.

relationNameStore :: [String]
relationNameStore :: [String]
relationNameStore = String -> Char -> [String]
createNames String
"RS" Char
'R'



-- | An infinite list of names for type expressions.

typeExpressionNameStore :: [String]
typeExpressionNameStore :: [String]
typeExpressionNameStore = String -> Char -> [String]
createNames String
"" Char
't'



-- | An infinite list of names for function variables.

functionNameStore1 :: [String]
functionNameStore1 :: [String]
functionNameStore1 = String -> Char -> [String]
createNames String
"fgh" Char
'f'


-- | Another infinite list of names for function variables.

functionNameStore2 :: [String]
functionNameStore2 :: [String]
functionNameStore2 = String -> Char -> [String]
createNames String
"pqrs" Char
'p'



-- | An infinite list of names for term variables.

variableNameStore :: [String]
variableNameStore :: [String]
variableNameStore = String -> Char -> [String]
createNames String
"xyzvwabcdeijklmn" Char
'x'



-- | Creates an infinite list of names based on a list of simple names and a
--   default prefix. After simple names have been used, the numbers starting
--   from 1 are appended to the default prefix to generate more names.

createNames :: [Char] -> Char -> [String]
createNames :: String -> Char -> [String]
createNames String
prefixes Char
prefix =
  let unpack :: [a] -> Maybe ([a], [a])
unpack [a]
is = case [a]
is of { (a
c:[a]
cs) -> forall a. a -> Maybe a
Just ([a
c], [a]
cs) ; [a]
otherwise -> forall a. Maybe a
Nothing }
   in forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {a}. [a] -> Maybe ([a], [a])
unpack String
prefixes forall a. [a] -> [a] -> [a]
++ (forall a b. (a -> b) -> [a] -> [b]
map (\Integer
i -> Char
prefix forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Integer
i) [Integer
1..])