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