{- BNF Converter: Antlr4 Java 1.8 Generator Copyright (C) 2004 Author: Markus Forsberg, Michael Pellauer, Bjorn Bringert This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1335, USA -} {- ************************************************************** BNF Converter Module Description : This module generates the ANTLR .g4 input file. It follows the same basic structure of CFtoHappy. Author : Gabriele Paganelli (gapag@distruzione.org), License : GPL (GNU General Public License) Created : 15 Oct, 2015 Modified : ************************************************************** -} module BNFC.Backend.Java.CFtoAntlr4Parser ( cf2AntlrParse ) where import Data.List import BNFC.CF import BNFC.Backend.Java.Utils import BNFC.Backend.Common.NamedVariables import BNFC.Options (RecordPositions(..)) import BNFC.Utils ( (+++), (+.+)) -- Type declarations type Rules = [(NonTerminal,[(Pattern, Fun, Action)])] type Pattern = String type Action = String type MetaVar = (String, Cat) -- | Creates the ANTLR parser grammar for this CF. --The environment comes from CFtoAntlr4Lexer cf2AntlrParse :: String -> String -> CF -> RecordPositions -> SymEnv -> String cf2AntlrParse packageBase packageAbsyn cf _ env = unlines [ header , tokens , prRules packageAbsyn (rulesForAntlr4 packageAbsyn cf env) ] where header :: String header = unlines [ "// -*- Java -*- This ANTLRv4 file was machine-generated by BNFC" , "parser grammar" +++ identifier ++ "Parser;" ] tokens :: String tokens = unlines [ "options {" , " tokenVocab = "++identifier++"Lexer;" , "}" ] identifier = getLastInPackage packageBase --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForAntlr4 :: String -> CF -> SymEnv -> Rules rulesForAntlr4 packageAbsyn cf env = map mkOne getrules where getrules = ruleGroups cf mkOne (cat,rules) = constructRule packageAbsyn cf env rules cat -- | For every non-terminal, we construct a set of rules. A rule is a sequence of -- terminals and non-terminals, and an action to be performed. constructRule :: String -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern, Fun, Action)]) constructRule packageAbsyn cf env rules nt = (nt, [ (p , funRule r , generateAction packageAbsyn nt (funRule r) (revM b m) b) | (index ,r0) <- zip [1..(length rules)] rules, let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs then (True, revSepListRule r0) else (False, r0) (p,m) = generatePatterns index env r]) where revM False = id revM True = reverse revs = cfgReversibleCats cf -- Generates a string containing the semantic action. generateAction :: String -> NonTerminal -> Fun -> [MetaVar] -> Bool -- ^ Whether the list should be reversed or not. -- Only used if this is a list rule. -> Action generateAction packageAbsyn nt f ms rev | isNilFun f = "$result = new " ++ c ++ "();" | isOneFun f = "$result = new " ++ c ++ "(); $result.addLast(" ++ p_1 ++ ");" | isConsFun f = "$result = " ++ p_2 ++ "; " ++ "$result." ++ add ++ "(" ++ p_1 ++ ");" | isCoercion f = "$result = " ++ p_1 ++ ";" | isDefinedRule f = "$result = parser." ++ f ++ "_" ++ "(" ++ intercalate "," (map resultvalue ms) ++ ");" | otherwise = "$result = new " ++ c ++ "(" ++ intercalate "," (map resultvalue ms) ++ ");" where c = packageAbsyn ++ "." ++ if isNilFun f || isOneFun f || isConsFun f then identCat (normCat nt) else f p_1 = resultvalue $ ms!!0 p_2 = resultvalue $ ms!!1 add = if rev then "addLast" else "addFirst" gettext = "getText()" removeQuotes x = "substring(1, "++ x +.+ gettext +.+ "length()-1)" parseint x = "Integer.parseInt("++x++")" parsedouble x = "Double.parseDouble("++x++")" charat = "charAt(1)" resultvalue (n,c) = case c of TokenCat "Ident" -> n'+.+gettext TokenCat "Integer" -> parseint $ n'+.+gettext TokenCat "Char" -> n'+.+gettext+.+charat TokenCat "Double" -> parsedouble $ n'+.+gettext TokenCat "String" -> n'+.+gettext+.+removeQuotes n' _ -> (+.+) n' (if isTokenCat c then gettext else "result") where n' = '$':n -- | Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal -- >>> generatePatterns 2 [] (Rule "myfun" (Cat "A") []) -- (" /* empty */ ",[]) -- >>> generatePatterns 3 [("def", "_SYMB_1")] (Rule "myfun" (Cat "A") [Right "def", Left (Cat "B")]) -- ("_SYMB_1 p_3_2=b ",[("p_3_2",B)]) generatePatterns :: Int -> SymEnv -> Rule -> (Pattern,[MetaVar]) generatePatterns ind env r = case rhsRule r of [] -> (" /* empty */ ",[]) its -> (mkIt 1 its, metas its) where mkIt _ [] = [] mkIt n (i:is) = case i of Left c -> "p_" ++show ind++"_"++ show (n :: Int) ++ "="++ c' +++ mkIt (n+1) is where c' = case c of TokenCat "Ident" -> "IDENT" TokenCat "Integer" -> "INTEGER" TokenCat "Char" -> "CHAR" TokenCat "Double" -> "DOUBLE" TokenCat "String" -> "STRING" _ -> if isTokenCat c then identCat c else firstLowerCase (getRuleName (identCat c)) Right s -> case lookup s env of (Just x) -> x +++ mkIt (n+1) is (Nothing) -> mkIt n is metas its = [("p_" ++ show ind ++"_"++ show i, category) | (i,Left category) <- zip [1 :: Int ..] its] -- | Puts together the pattern and actions and returns a string containing all -- the rules. prRules :: String -> Rules -> String prRules _ [] = [] prRules packabs ((_, []):rs) = prRules packabs rs prRules packabs ((nt,(p, fun, a):ls):rs) = preamble ++ ";\n" ++ prRules packabs rs where preamble = unwords [ nt' , "returns" , "[" , packabs+.+normcat , "result" , "]" , ":" , p , "{" , a , "}" , "#" , antlrRuleLabel fun , '\n' : pr ls ] alternative (p',fun',a') = unwords [" |", p', "{", a' , "}", "#" , antlrRuleLabel fun'] catid = identCat nt normcat = identCat (normCat nt) nt' = getRuleName $ firstLowerCase catid pr [] = [] pr (k:ls) = unlines [alternative k] ++ pr ls antlrRuleLabel fnc | isNilFun fnc = catid ++ "_Empty" | isOneFun fnc = catid ++ "_AppendLast" | isConsFun fnc = catid ++ "_PrependFirst" | isCoercion fnc = "Coercion_" ++ catid | otherwise = getLabelName fnc