module BNFC.Backend.Common.NamedVariables where
import Control.Arrow (left, (&&&))
import Data.Char (toLower)
import Data.Either (lefts)
import Data.List (nub)
import Data.Map (Map)
import Text.PrettyPrint (Doc)
import qualified Text.PrettyPrint as P
import BNFC.CF
type IVar = (String, Int)
type UserDef = TokenCat
type SymEnv = KeywordEnv
type KeywordEnv = [(String, String)]
type SymMap = Map SymKey String
data SymKey
= Keyword String
| Tokentype String
deriving (SymKey -> SymKey -> Bool
(SymKey -> SymKey -> Bool)
-> (SymKey -> SymKey -> Bool) -> Eq SymKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymKey -> SymKey -> Bool
$c/= :: SymKey -> SymKey -> Bool
== :: SymKey -> SymKey -> Bool
$c== :: SymKey -> SymKey -> Bool
Eq, Eq SymKey
Eq SymKey
-> (SymKey -> SymKey -> Ordering)
-> (SymKey -> SymKey -> Bool)
-> (SymKey -> SymKey -> Bool)
-> (SymKey -> SymKey -> Bool)
-> (SymKey -> SymKey -> Bool)
-> (SymKey -> SymKey -> SymKey)
-> (SymKey -> SymKey -> SymKey)
-> Ord SymKey
SymKey -> SymKey -> Bool
SymKey -> SymKey -> Ordering
SymKey -> SymKey -> SymKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SymKey -> SymKey -> SymKey
$cmin :: SymKey -> SymKey -> SymKey
max :: SymKey -> SymKey -> SymKey
$cmax :: SymKey -> SymKey -> SymKey
>= :: SymKey -> SymKey -> Bool
$c>= :: SymKey -> SymKey -> Bool
> :: SymKey -> SymKey -> Bool
$c> :: SymKey -> SymKey -> Bool
<= :: SymKey -> SymKey -> Bool
$c<= :: SymKey -> SymKey -> Bool
< :: SymKey -> SymKey -> Bool
$c< :: SymKey -> SymKey -> Bool
compare :: SymKey -> SymKey -> Ordering
$ccompare :: SymKey -> SymKey -> Ordering
$cp1Ord :: Eq SymKey
Ord, Int -> SymKey -> ShowS
[SymKey] -> ShowS
SymKey -> String
(Int -> SymKey -> ShowS)
-> (SymKey -> String) -> ([SymKey] -> ShowS) -> Show SymKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymKey] -> ShowS
$cshowList :: [SymKey] -> ShowS
show :: SymKey -> String
$cshow :: SymKey -> String
showsPrec :: Int -> SymKey -> ShowS
$cshowsPrec :: Int -> SymKey -> ShowS
Show)
getVars :: [Cat] -> [IVar]
getVars :: [Cat] -> [IVar]
getVars [Cat]
cs = ([IVar] -> String -> [IVar]) -> [IVar] -> [String] -> [IVar]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [IVar] -> String -> [IVar]
forall t t. (Eq t, Eq t, Num t) => [(t, t)] -> t -> [(t, t)]
addVar [] ((Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Cat -> String
identCat [Cat]
cs)
where
addVar :: [(t, t)] -> t -> [(t, t)]
addVar [(t, t)]
vs = [(t, t)] -> t -> t -> [(t, t)]
forall t t. (Eq t, Eq t, Num t) => [(t, t)] -> t -> t -> [(t, t)]
addVar' [(t, t)]
vs t
0
addVar' :: [(t, t)] -> t -> t -> [(t, t)]
addVar' [] t
n t
c = [(t
c, t
n)]
addVar' (i :: (t, t)
i@(t
t,t
x):[(t, t)]
is) t
n t
c =
if t
c t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
t
then if t
x t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0
then (t
t, t
1) (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: [(t, t)] -> t -> t -> [(t, t)]
addVar' [(t, t)]
is t
2 t
c
else (t, t)
i (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: [(t, t)] -> t -> t -> [(t, t)]
addVar' [(t, t)]
is (t
xt -> t -> t
forall a. Num a => a -> a -> a
+t
1) t
c
else (t, t)
i (t, t) -> [(t, t)] -> [(t, t)]
forall a. a -> [a] -> [a]
: [(t, t)] -> t -> t -> [(t, t)]
addVar' [(t, t)]
is t
n t
c
numVars :: [Either Cat a] -> [Either (Cat, Doc) a]
numVars :: [Either Cat a] -> [Either (Cat, Doc) a]
numVars [Either Cat a]
cats =
let withNames :: [Either (Cat, String) a]
withNames = (Either Cat a -> Either (Cat, String) a)
-> [Either Cat a] -> [Either (Cat, String) a]
forall a b. (a -> b) -> [a] -> [b]
map ((Cat -> (Cat, String)) -> Either Cat a -> Either (Cat, String) a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Cat -> Cat
forall a. a -> a
id (Cat -> Cat) -> (Cat -> String) -> Cat -> (Cat, String)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (ShowS
varName ShowS -> (Cat -> String) -> Cat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> String
identCat (Cat -> String) -> (Cat -> Cat) -> Cat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> Cat
normCat))) [Either Cat a]
cats
in [IVar] -> [Either (Cat, String) a] -> [Either (Cat, Doc) a]
forall a b. [IVar] -> [Either (a, String) b] -> [Either (a, Doc) b]
f' [] [Either (Cat, String) a]
withNames
where f' :: [IVar] -> [Either (a, String) b] -> [Either (a, Doc) b]
f' [IVar]
_ [] = []
f' [IVar]
env (Right b
t:[Either (a, String) b]
xs) = b -> Either (a, Doc) b
forall a b. b -> Either a b
Right b
tEither (a, Doc) b -> [Either (a, Doc) b] -> [Either (a, Doc) b]
forall a. a -> [a] -> [a]
:[IVar] -> [Either (a, String) b] -> [Either (a, Doc) b]
f' [IVar]
env [Either (a, String) b]
xs
f' [IVar]
env (Left (a
c,String
n):[Either (a, String) b]
xs) =
let i :: Int
i = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (String -> [IVar] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [IVar]
env)
thereIsMore :: Bool
thereIsMore = String
n String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((a, String) -> String) -> [(a, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> String
forall a b. (a, b) -> b
snd ([Either (a, String) b] -> [(a, String)]
forall a b. [Either a b] -> [a]
lefts [Either (a, String) b]
xs)
vname :: Doc
vname = String -> Doc
P.text String
n Doc -> Doc -> Doc
P.<> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
|| Bool
thereIsMore then Int -> Doc
P.int Int
i else Doc
P.empty
in (a, Doc) -> Either (a, Doc) b
forall a b. a -> Either a b
Left (a
c, Doc
vname) Either (a, Doc) b -> [Either (a, Doc) b] -> [Either (a, Doc) b]
forall a. a -> [a] -> [a]
: [IVar] -> [Either (a, String) b] -> [Either (a, Doc) b]
f' ((String
n,Int
i)IVar -> [IVar] -> [IVar]
forall a. a -> [a] -> [a]
:[IVar]
env) [Either (a, String) b]
xs
fixCoercions :: [(Cat, [Rule])] -> [(Cat, [Rule])]
fixCoercions :: [(Cat, [Rule])] -> [(Cat, [Rule])]
fixCoercions [(Cat, [Rule])]
rs = [(Cat, [Rule])] -> [(Cat, [Rule])]
forall a. Eq a => [a] -> [a]
nub ([(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])]
fixAll [(Cat, [Rule])]
rs [(Cat, [Rule])]
rs)
where
fixCoercion :: Cat -> [(Cat, [Rule])] -> [Rule]
fixCoercion :: Cat -> [(Cat, [Rule])] -> [Rule]
fixCoercion Cat
_ [] = []
fixCoercion Cat
cat ((Cat
c,[Rule]
rules):[(Cat, [Rule])]
cats) = if Cat -> Cat
normCat Cat
c Cat -> Cat -> Bool
forall a. Eq a => a -> a -> Bool
== Cat -> Cat
normCat Cat
cat
then [Rule]
rules [Rule] -> [Rule] -> [Rule]
forall a. [a] -> [a] -> [a]
++ Cat -> [(Cat, [Rule])] -> [Rule]
fixCoercion Cat
cat [(Cat, [Rule])]
cats
else Cat -> [(Cat, [Rule])] -> [Rule]
fixCoercion Cat
cat [(Cat, [Rule])]
cats
fixAll :: [(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])]
fixAll :: [(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])]
fixAll [(Cat, [Rule])]
_ [] = []
fixAll [(Cat, [Rule])]
top ((Cat
cat,[Rule]
_):[(Cat, [Rule])]
cats) = if WithPosition String -> Bool
forall a. IsFun a => a -> Bool
isCoercion (String -> WithPosition String
forall a. a -> WithPosition a
noPosition (String -> WithPosition String) -> String -> WithPosition String
forall a b. (a -> b) -> a -> b
$ Cat -> String
catToStr Cat
cat)
then [(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])]
fixAll [(Cat, [Rule])]
top [(Cat, [Rule])]
cats
else (Cat -> Cat
normCat Cat
cat, Cat -> [(Cat, [Rule])] -> [Rule]
fixCoercion Cat
cat [(Cat, [Rule])]
top) (Cat, [Rule]) -> [(Cat, [Rule])] -> [(Cat, [Rule])]
forall a. a -> [a] -> [a]
: [(Cat, [Rule])] -> [(Cat, [Rule])] -> [(Cat, [Rule])]
fixAll [(Cat, [Rule])]
top [(Cat, [Rule])]
cats
varName :: String -> String
varName :: ShowS
varName String
c = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"
showNum :: Int -> String
showNum :: Int -> String
showNum Int
n = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then String
"" else Int -> String
forall a. Show a => a -> String
show Int
n
firstLowerCase :: String -> String
firstLowerCase :: ShowS
firstLowerCase String
"" = String
""
firstLowerCase (Char
a:String
b) = Char -> Char
toLower Char
aChar -> ShowS
forall a. a -> [a] -> [a]
:String
b