{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.CommonInterface.NamedVariables where

import BNFC.Prelude

import           Control.Arrow (left, (&&&))
import qualified Data.Map      as Map
import           Data.String   (fromString)

import Prettyprinter

import BNFC.CF
import BNFC.Types.Position

type IVar = (String, Int)
--The type of an instance variable
--and a # unique to that type

-- | Converts a list of categories into their types to be used as instance
-- variables. If a category appears only once, it is given the number 0,
-- if it appears more than once, its occurrences are numbered from 1. ex:
--
-- >>> getVars [Cat "A", Cat "B", Cat "A"]
-- [("A",1),("B",0),("A",2)]
--
getVars :: [Cat] -> [IVar]
getVars cs = foldl addVar [] (map identCat cs)
  where
    addVar vs = addVar' vs 0
    addVar' []  n c = [(c, n)]
    addVar' (i@(t,x):is) n c =
      if c == t
          then if x == 0
              then (t, 1) : addVar' is 2 c
              else i : addVar' is (x+1) c
          else i : addVar' is n c

-- # Create variable names for rules rhs
-- This is about creating variable names for the right-hand side of rules.
-- In particular, if you have a rule like Foo. Bar ::= A B A, you need to
-- create unique variable names for the two instances of category A

-- | Anotate the right hand side of a rule with variable names
-- for the non-terminals.
-- >>> numVars [Left (Cat "A"), Right "+", Left (Cat "B")]
-- [Left (A,a_),Right "+",Left (B,b_)]
-- >>> numVars [Left (Cat "A"), Left (Cat "A"), Right ";"]
-- [Left (A,a_1),Left (A,a_2),Right ";"]

numVars :: [Either Cat a] -> [Either (Cat, Doc ()) a]
numVars cats = loop [] withNames
  where
    -- First, we anotate each Left _ with a variable name (not univque)
    withNames = map (left (id &&& (varName . identType . catToType))) cats
    -- next, the function loop adds numbers where needed...
    loop :: [(String, Int)] -> [Either (Cat, String) a] -> [Either (Cat, Doc ()) a]
    loop _ [] = []
    loop env (Right t    : xs) = Right t         : loop env xs
    loop env (Left (c,n) : xs) = Left (c, vname) : loop ((n,i):env) xs
      where
        -- we should use n_i as var name
        i = maybe 1 (+1) $ lookup n env
        -- Is there more use of the name u_ ?
        thereIsMore = n `elem` map snd (lefts xs)
        vname
          | i > 1 || thereIsMore = fromString $ n ++ show i
          | otherwise            = fromString n

fixCoersions :: ASTRules -> ASTRules
fixCoersions astRules = Map.fromList $ fixAll rs rs
  where
  rs :: [(Cat, (Map Label (WithPosition ARuleRHS)))]
  rs = Map.toList astRules
  fixCoercion :: Cat
                -> [(Cat, (Map Label (WithPosition ARuleRHS)))]
                -> Map Label (WithPosition ARuleRHS)
  fixCoercion _ [] = mempty
  fixCoercion category ((c,rhs):rules) = if catToType c == catToType category
    then rhs <> fixCoercion category rules
    else fixCoercion category rules
  fixAll :: [(Cat, (Map Label (WithPosition ARuleRHS)))]
            -> [(Cat, (Map Label (WithPosition ARuleRHS)))]
            -> [(Cat, (Map Label (WithPosition ARuleRHS)))]
  fixAll _ [] = []
  fixAll top ((category,_):cats) = if isCatCoerced category
    then fixAll top cats
    else (category, fixCoercion category top) : fixAll top cats

--A generic variable name for C-like languages.
varName :: [Char] -> [Char]
varName c = map toLower c ++ "_"

--this makes var names a little cleaner.
showNum :: (Eq a, Num a, Show a) => a -> [Char]
showNum n = if n == 0 then [] else show n

-- Makes the first letter a lowercase.
firstLowerCase :: String -> String
firstLowerCase "" = ""
firstLowerCase (a:b) = toLower a : b