{- BNF Converter: Named instance variables Copyright (C) 2004 Author: Michael Pellauer -} {- ************************************************************** BNF Converter Module Description : This module provides support for languages which need named instance variables. (IE Java, C, C++) It provides a data type to represent the name mapping and utility functions to work with it. Variables are grouped and numbered in a nice way. Author : Michael Pellauer (pellauer@cs.chalmers.se) ************************************************************** The idea of this module is the following (if I got it correctly): In some target languages (e.g. java or C) you need to create a variable name for each non terminal in a given rule. For instance, the following rules: > SomeFunction. A ::= B C D ; could be represented in C by a structure like: @ struct A { B b_; C c_; D d_; } @ (note that this is not exactly the representation produced by bnfc) but if there is several non terminal of the same category, we need to number them. Eg: > SomeFunction. A = B B ; Should become something like: @ struct A { B b_1, b_2; } @ This is what this module does. -} 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) --The type of an instance variable --and a # unique to that type type UserDef = TokenCat --user-defined types -- | A symbol-mapping environment. type SymEnv = KeywordEnv -- | Map keywords to their token name. type KeywordEnv = [(String, String)] -- | Map keywords and user-defined token types to their token name. type SymMap = Map SymKey String data SymKey = Keyword String -- ^ Keyword like "(", "while", "true", ... | Tokentype String -- ^ Token type like "Integer", "Char", ... 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) -- | 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 :: [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 -- # 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 :: [Either Cat a] -> [Either (Cat, Doc) a] numVars [Either Cat a] cats = -- First, we anotate each Left _ with a variable name (not univque) 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 -- next, the function f' adds numbers where needed... 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) = -- we should use n_i as var name 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) -- Is there more use of the name u_ ? 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 --This fixes the problem with coercions. 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 forall a. Show a => a -> String show Cat cat) -- This is weird: isCoercion is supposed to be applied to functions!!!! 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 --A generic variable name for C-like languages. 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 "_" --this makes var names a little cleaner. showNum :: a -> String showNum a n = if a n a -> a -> Bool forall a. Eq a => a -> a -> Bool == a 0 then [] else a -> String forall a. Show a => a -> String show a n -- Makes the first letter a lowercase. 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