BNFC-2.8.2: src/BNFC/Backend/Java.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-
BNF Converter: Java Top File
Copyright (C) 2004 Author: Markus Forsberg, Peter Gammie,
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
-}
-------------------------------------------------------------------
-- |
-- Module : JavaTop
-- Copyright : (C)opyright 2003, {markus, aarne, pellauer, peteg, bringert} at cs dot chalmers dot se
-- License : GPL (see COPYING for details)
--
-- Maintainer : {markus, aarne} at cs dot chalmers dot se
-- Stability : alpha
-- Portability : Haskell98
--
-- Top-level for the Java back end.
--
-- > $Id: JavaTop15.hs,v 1.12 2007/01/08 18:20:23 aarne Exp $
-------------------------------------------------------------------
module BNFC.Backend.Java ( makeJava ) where
import Prelude'
import System.FilePath (pathSeparator, isPathSeparator)
import Data.List ( intersperse )
import BNFC.Utils
import BNFC.CF
import BNFC.Options as Options
import BNFC.Backend.Base
import BNFC.Backend.Java.Utils
import BNFC.Backend.Java.CFtoCup15 ( cf2Cup )
import BNFC.Backend.Java.CFtoJLex15
import BNFC.Backend.Java.CFtoAntlr4Lexer
import BNFC.Backend.Java.CFtoAntlr4Parser
import BNFC.Backend.Java.CFtoJavaAbs15 ( cf2JavaAbs )
import BNFC.Backend.Java.CFtoJavaPrinter15
import BNFC.Backend.Java.CFtoVisitSkel15
import BNFC.Backend.Java.CFtoComposVisitor
import BNFC.Backend.Java.CFtoAbstractVisitor
import BNFC.Backend.Java.CFtoFoldVisitor
import BNFC.Backend.Java.CFtoAllVisitor
import BNFC.Backend.Common.NamedVariables (SymEnv, firstLowerCase)
import qualified BNFC.Backend.Common.Makefile as Makefile
import BNFC.PrettyPrint
-------------------------------------------------------------------
-- | Build the Java output.
-------------------------------------------------------------------
-- | This creates the Java files.
makeJava :: SharedOptions -> CF -> MkFiles ()
makeJava options@Options{..} cf = do
-- Create the package directories if necessary.
let packageBase = case inPackage of
Nothing -> lang
Just p -> p ++ "." ++ lang
packageAbsyn = packageBase ++ "." ++ "Absyn"
dirBase = pkgToDir packageBase
dirAbsyn = pkgToDir packageAbsyn
javaex str = dirBase ++ str +.+ "java"
bnfcfiles =
bnfcVisitorsAndTests
packageBase
packageAbsyn
cf
cf2JavaPrinter
cf2VisitSkel
cf2ComposVisitor
cf2AbstractVisitor
cf2FoldVisitor
cf2AllVisitor
(testclass parselexspec
(head $ results lexmake) -- lexer class
(head $ results parmake) -- parser class
)
makebnfcfile x = mkfile (javaex (fst $ x bnfcfiles))
(snd $ x bnfcfiles)
let absynFiles = remDups $ cf2JavaAbs packageBase packageAbsyn cf rp
absynBaseNames = map fst absynFiles
absynFileNames = map (dirAbsyn ++) absynBaseNames
let writeAbsyn (filename, contents) =
mkfile (dirAbsyn ++ filename ++ ".java") contents
mapM_ writeAbsyn absynFiles
makebnfcfile bprettyprinter
makebnfcfile bskel
makebnfcfile bcompos
makebnfcfile babstract
makebnfcfile bfold
makebnfcfile ball
makebnfcfile btest
let (lex, env) = lexfun packageBase cf
-- Where the lexer file is created. lex is the content!
mkfile (dirBase ++ inputfile lexmake ) lex
liftIO $ putStrLn $ " (Tested with "+++ toolname lexmake
+++ toolversion lexmake +++")"
-- where the parser file is created.
mkfile (dirBase ++ inputfile parmake)
$ parsefun packageBase packageAbsyn cf rp env
liftIO $ putStrLn $
if supportsEntryPoints parmake
then "(Parser created for all categories)"
else " (Parser created only for category " ++ show (firstEntry cf) ++ ")"
liftIO $ putStrLn $ " (Tested with " +++ toolname parmake
+++ toolversion parmake +++ ")"
Makefile.mkMakefile options $
makefile dirBase dirAbsyn absynFileNames parselexspec
where
remDups [] = []
remDups ((a,b):as) = case lookup a as of
Just {} -> remDups as
Nothing -> (a, b) : remDups as
pkgToDir :: String -> FilePath
pkgToDir s = replace '.' pathSeparator s ++ [pathSeparator]
parselexspec = parserLexerSelector lang javaLexerParser rp
lexfun = cf2lex $ lexer parselexspec
parsefun = cf2parse $ parser parselexspec
parmake = makeparserdetails (parser parselexspec)
lexmake = makelexerdetails (lexer parselexspec)
rp = (Options.linenumbers options)
makefile :: FilePath -> FilePath -> [String] -> ParserLexerSpecification -> Doc
makefile dirBase dirAbsyn absynFileNames jlexpar = vcat $
makeVars [ ("JAVAC", "javac"),
("JAVAC_FLAGS", "-sourcepath ."),
( "JAVA", "java"),
( "JAVA_FLAGS", ""),
-- parser executable
( "PARSER", executable parmake),
-- parser flags
( "PARSER_FLAGS", flags parmake dirBase),
-- lexer executable (and flags?)
( "LEXER", executable lexmake),
( "LEXER_FLAGS", flags lexmake dirBase)
]
++
makeRules [ ("all", [ "test" ], []),
( "test", "absyn" : classes, []),
( ".PHONY", ["absyn"], []),
("%.class", [ "%.java" ], [ runJavac "$^" ]),
("absyn", [absynJavaSrc],[ runJavac "$^" ])
]++
[-- running the lexergen: output of lexer -> input of lexer : calls lexer
let ff = filename lexmake -- name of input file without extension
dirBaseff = dirBase ++ ff -- prepend directory
inp = dirBase ++ inputfile lexmake in
Makefile.mkRule (dirBaseff +.+ "java") [ inp ]
[ "${LEXER} ${LEXER_FLAGS} "++ inp ]
-- running the parsergen, these there are its outputs
-- output of parser -> input of parser : calls parser
, let inp = dirBase ++ inputfile parmake in
Makefile.mkRule (unwords (map (dirBase++) (dotJava $ results parmake)))
[ inp ] $
("${PARSER} ${PARSER_FLAGS} " ++ inp) :
["mv " ++ unwords (dotJava $ results parmake) +++ dirBase
| moveresults parmake]
-- Class of the output of lexer generator wants java of :
-- output of lexer and parser generator
, let lexerOutClass = dirBase ++ filename lexmake +.+ "class"
outname x = dirBase ++ x +.+ "java"
deps = map outname (results lexmake ++ results parmake) in
Makefile.mkRule lexerOutClass deps []
]++
reverse [Makefile.mkRule tar dep [] |
(tar,dep) <- partialParserGoals dirBase (results parmake)]
++[ Makefile.mkRule (dirBase ++ "PrettyPrinter.class")
[ dirBase ++ "PrettyPrinter.java" ] []
-- Removes all the class files created anywhere
, Makefile.mkRule "clean" [] [ "rm -f " ++ dirAbsyn ++ "*.class" ++ " "
++ dirBase ++ "*.class" ]
-- Remains the same
, Makefile.mkRule "distclean" [ "vclean" ] []
-- removes everything
, Makefile.mkRule "vclean" []
[ " rm -f " ++ absynJavaSrc ++ " " ++ absynJavaClass
, " rm -f " ++ dirAbsyn ++ "*.class"
, " rmdir " ++ dirAbsyn
, " rm -f " ++ unwords (map (dirBase ++) $
[ inputfile lexmake
, inputfile parmake
]
++ dotJava (results lexmake)
++ [ "VisitSkel.java"
, "ComposVisitor.java"
, "AbstractVisitor.java"
, "FoldVisitor.java"
, "AllVisitor.java"
, "PrettyPrinter.java"
, "Skeleton.java"
, "Test.java"
]
++ dotJava (results parmake)
++ ["*.class"])
, " rm -f Makefile"
, " rmdir -p " ++ dirBase
]
]
where
makeVars x = [Makefile.mkVar n v | (n,v) <- x]
makeRules x = [Makefile.mkRule tar dep recipe | (tar, dep, recipe) <- x]
parmake = makeparserdetails (parser jlexpar)
lexmake = makelexerdetails (lexer jlexpar)
absynJavaSrc = unwords (dotJava absynFileNames)
absynJavaClass = unwords (dotClass absynFileNames)
classes = prependPath dirBase lst
lst = dotClass (results lexmake) ++ [ "PrettyPrinter.class", "Test.class"
, "ComposVisitor.class", "AbstractVisitor.class"
, "FoldVisitor.class", "AllVisitor.class"]++
dotClass (results parmake) ++ ["Test.class"]
type TestClass = String
-- ^ class of the lexer
-> String
-- ^ class of the parser
-> String
-- ^ package where the non-abstract syntax classes are created
-> String
-- ^ package where the abstract syntax classes are created
-> CF
-- ^ the CF bundle
-> String
-- | Test class details for J(F)Lex + CUP
cuptest :: TestClass
cuptest =
javaTest
["java_cup.runtime"]
"Throwable"
(const [])
(\x i -> x <> i <> ";")
(\x i -> x <> "(" <> i <> ", " <> i <> ".getSymbolFactory());")
showOpts
(\_ pabs enti ->
pabs <> "." <> enti <+> "ast = p."<> "p" <> enti
<> "();")
locs
where
locs = "At line \" + String.valueOf(t.l.line_num()) + \","
++ " near \\\"\" + t.l.buff() + \"\\\" :"
showOpts _ = ["not available."]
-- | Test class details for ANTLR4
antlrtest :: TestClass
antlrtest =
javaTest
[ "org.antlr.v4.runtime","org.antlr.v4.runtime.atn"
, "org.antlr.v4.runtime.dfa","java.util"
]
"TestError"
antlrErrorHandling
(\x i -> vcat
[ x <> "(new ANTLRInputStream" <> i <>");"
, "l.addErrorListener(new BNFCErrorListener());"
])
(\x i -> vcat
[x <> "(new CommonTokenStream(" <> i <>"));"
, "p.addErrorListener(new BNFCErrorListener());"
])
showOpts
(\pbase pabs enti -> vcat
[
let rulename = getRuleName (show enti)
typename = text rulename
methodname = text $ firstLowerCase rulename
in
pbase <> "." <> typename <> "Context pc = p."
<> methodname <> "();"
, "org.antlr.v4.runtime.Token _tkn = p.getInputStream()"
<> ".getTokenSource().nextToken();"
, "if(_tkn.getType() != -1) throw new TestError"
<> "(\"Stream does not end with EOF\","
<> "_tkn.getLine(),_tkn.getCharPositionInLine());",
pabs <> "." <> enti <+> "ast = pc.result;"
])
"At line \" + e.line + \", column \" + e.column + \" :"
where
showOpts [] = []
showOpts (x:xs)
| normCat x /= x = showOpts xs
| otherwise = text (firstLowerCase $ identCat x) : showOpts xs
parserLexerSelector :: String
-> JavaLexerParser
-> RecordPositions -- ^Pass line numbers to the symbols
-> ParserLexerSpecification
parserLexerSelector _ JLexCup rp = ParseLexSpec
{ lexer = cf2JLex rp
, parser = cf2cup rp
, testclass = cuptest
}
parserLexerSelector _ JFlexCup rp =
(parserLexerSelector "" JLexCup rp){lexer = cf2JFlex rp}
parserLexerSelector l Antlr4 _ = ParseLexSpec
{ lexer = cf2AntlrLex' l
, parser = cf2AntlrParse' l
, testclass = antlrtest
}
data ParserLexerSpecification = ParseLexSpec
{ parser :: CFToParser
, lexer :: CFToLexer
, testclass :: TestClass
}
-- |CF -> LEXER GENERATION TOOL BRIDGE
-- | function translating the CF to an appropriate lexer generation tool.
type CF2LexerFunction = String -> CF -> (Doc, SymEnv)
-- Chooses the translation from CF to the lexer
data CFToLexer = CF2Lex
{ cf2lex :: CF2LexerFunction
, makelexerdetails :: MakeFileDetails
}
-- | Instances of cf-lexergen bridges
cf2JLex, cf2JFlex :: RecordPositions -> CFToLexer
cf2JLex rp = CF2Lex
{ cf2lex = BNFC.Backend.Java.CFtoJLex15.cf2jlex JLexCup rp
, makelexerdetails = jlexmakedetails
}
cf2JFlex rp = CF2Lex
{ cf2lex = BNFC.Backend.Java.CFtoJLex15.cf2jlex JFlexCup rp
, makelexerdetails = jflexmakedetails
}
cf2AntlrLex' :: String -> CFToLexer
cf2AntlrLex' l = CF2Lex
{ cf2lex =
BNFC.Backend.Java.CFtoAntlr4Lexer.cf2AntlrLex
, makelexerdetails = antlrmakedetails $ l++"Lexer"
}
-- | CF -> PARSER GENERATION TOOL BRIDGE
-- | function translating the CF to an appropriate parser generation tool.
type CF2ParserFunction = String -> String -> CF -> RecordPositions -> SymEnv -> String
-- | Chooses the translation from CF to the parser
data CFToParser = CF2Parse
{ cf2parse :: CF2ParserFunction
, makeparserdetails :: MakeFileDetails
}
-- | Instances of cf-parsergen bridges
cf2cup :: RecordPositions -> CFToParser
cf2cup rp = CF2Parse
{ cf2parse = BNFC.Backend.Java.CFtoCup15.cf2Cup
, makeparserdetails = cupmakedetails rp
}
cf2AntlrParse' :: String -> CFToParser
cf2AntlrParse' l = CF2Parse
{ cf2parse =
BNFC.Backend.Java.CFtoAntlr4Parser.cf2AntlrParse
, makeparserdetails = antlrmakedetails $ l++"Parser"
}
-- | shorthand for Makefile command running javac or java
runJavac , runJava:: String -> String
runJava = mkRunProgram "JAVA"
runJavac = mkRunProgram "JAVAC"
-- | function returning a string executing a program contained in a variable j
-- on input s
mkRunProgram :: String -> String -> String
mkRunProgram j s = Makefile.refVar j +++ Makefile.refVar (j +-+ "FLAGS") +++ s
type OutputDirectory = String
-- | Makefile details from running the parser-lexer generation tools.
data MakeFileDetails = MakeDetails
{ -- | The string that executes the generation tool
executable :: String
-- | Flags to pass to the tool
, flags :: OutputDirectory -> String
-- | Input file to the tool
, filename :: String
-- | Extension of input file to the tool
, fileextension :: String
-- | name of the tool
, toolname :: String
-- | Tool version
, toolversion :: String
-- | true if the tool is a parser and supports entry points,
-- false otherwise
, supportsEntryPoints :: Bool
-- | list of names (without extension!) of files resulting from the
-- application of the tool which are relevant to a make rule
, results :: [String]
-- | if true, the files are moved to the base directory, otherwise
-- they are left where they are
, moveresults :: Bool
}
mapEmpty :: a -> String
mapEmpty _ = ""
-- Instances of makefile details.
jflexmakedetails, jlexmakedetails :: MakeFileDetails
cupmakedetails :: RecordPositions -> MakeFileDetails
jlexmakedetails = MakeDetails
{ executable = runJava "JLex.Main"
, flags = mapEmpty
, filename = "Yylex"
, fileextension = ""
, toolname = "JLex"
, toolversion = "1.2.6."
, supportsEntryPoints = False
, results = ["Yylex"]
, moveresults = False
}
jflexmakedetails = jlexmakedetails
{ executable = "jflex"
, toolname = "JFlex"
, toolversion = "1.4.3"
}
cupmakedetails rp = MakeDetails
{ executable = runJava "java_cup.Main"
, flags = const (lnFlags ++ " -expect 100")
, filename = "_cup"
, fileextension = "cup"
, toolname = "CUP"
, toolversion = "0.10k"
, supportsEntryPoints = False
, results = ["parser", "sym"]
, moveresults = True
}
where
lnFlags = if rp == RecordPositions then "-locations" else "-nopositions"
antlrmakedetails :: String -> MakeFileDetails
antlrmakedetails l = MakeDetails
{ executable = runJava "org.antlr.v4.Tool"
, flags = \x -> unwords $
let path = take (length x - 1) x
pointed = map cnv path
cnv y = if isPathSeparator y
then '.'
else y
in [ "-lib", path
, "-package", pointed]
, filename = l
, fileextension = "g4"
, toolname = "ANTLRv4"
, toolversion = "4.5.1"
, supportsEntryPoints = True
, results = [l]
, moveresults = False
}
prependPath , appendExtension :: String -> [String] -> [String]
prependPath s fi = [ s ++ x | x <- fi ]
appendExtension s fi = [ x +.+ s | x <- fi ]
dotJava,dotClass :: [String] -> [String]
dotJava = appendExtension "java"
dotClass = appendExtension "class"
type CFToJava = String -> String -> CF -> String
-- | Contains the pairs filename/content for all the non-abstract syntax files
-- generated by BNFC.
data BNFCGeneratedEntities = BNFCGenerated
{ bprettyprinter :: (String, String)
, btest :: (String, String)
, bcompos :: (String, String)
, babstract :: (String, String)
, bfold :: (String, String)
, ball :: (String, String)
, bskel :: (String, String)
}
bnfcVisitorsAndTests :: String -> String -> CF ->
CFToJava -> CFToJava -> CFToJava ->
CFToJava -> CFToJava -> CFToJava ->
CFToJava -> BNFCGeneratedEntities
bnfcVisitorsAndTests pbase pabsyn cf cf0 cf1 cf2 cf3 cf4 cf5 cf6 =
BNFCGenerated
{ bprettyprinter = ( "PrettyPrinter" , app cf0)
, bskel = ( "VisitSkel", app cf1)
, bcompos = ( "ComposVisitor" , app cf2)
, babstract = ( "AbstractVisitor" , app cf3)
, bfold = ( "FoldVisitor", app cf4)
, ball = ( "AllVisitor", app cf5)
, btest = ( "Test" , app cf6)
}
where app x = x pbase pabsyn cf
inputfile x = filename x ++ case fileextension x of
"" -> ""
a -> '.':a
-- | constructs the rules regarding the parser in the makefile
partialParserGoals :: String -> [String] -> [(String, [String])]
partialParserGoals _ [] = []
partialParserGoals dbas (x:rest) =
(dbas ++ x +.+ "class", map (\ y -> dbas ++ y +.+ "java") (x:rest))
: partialParserGoals dbas rest
-- | Creates the Test.java class.
javaTest :: [Doc]
-- ^ list of imported packages
-> String
-- ^ name of the exception thrown in case of parsing failure
-> (String -> [Doc])
-- ^ handler for the exception thrown
-> (Doc -> Doc -> Doc)
-- ^ function formulating the construction of the lexer object
-> (Doc -> Doc -> Doc)
-- ^ as above, for parser object
-> ([Cat] -> [Doc])
-- ^ Function processing the names of the methods corresponding
-- to entry points
-> (Doc -> Doc -> Doc -> Doc)
-- ^ function formulating the invocation of the parser tool within
-- Java
-> String
-- ^ error string output in consequence of a parsing failure
-> TestClass
javaTest imports
err
errhand
lexerconstruction
parserconstruction
showOpts
invocation
errmsg
lexer
parser
packageBase
packageAbsyn
cf =
render $ vcat $
[ "package" <+> text packageBase <> ";"
, "import" <+> text packageBase <> ".*;"
, "import" <+> text packageAbsyn <> ".*;"
, "import java.io.*;"
]
++ map importfun imports
++ errhand err
++[ ""
, "public class Test"
, codeblock 2
[ lx <+> "l;"
, px <+> "p;"
, ""
, "public Test(String[] args)"
, codeblock 2 [
"try"
, codeblock 2 [ "Reader input;"
, "if (args.length == 0)"
<> "input = new InputStreamReader(System.in);"
, "else input = new FileReader(args[0]);"
, "l = new "<>lexerconstruction lx "(input)"
]
, "catch(IOException e)"
, codeblock 2 [ "System.err.println"
<>"(\"Error: File not found: \" + args[0]);"
, "System.exit(1);"
]
, "p = new "<> parserconstruction px "l"
]
, ""
, "public" <+> text packageAbsyn <> "." <> absentity
<+>"parse() throws Exception"
, codeblock 2
[ "/* The default parser is the first-defined entry point. */"
, "/* Other options are: */"
, "/* " <> fsep (punctuate "," (showOpts (tail eps))) <> " */"
, invocation px (text packageAbsyn) absentity
, printOuts [ "\"Parse Succesful!\""
, "\"[Abstract Syntax]\""
, "PrettyPrinter.show(ast)"
, "\"[Linearized Tree]\""
, "PrettyPrinter.print(ast)"
]
, "return ast;"
]
, ""
, "public static void main(String args[]) throws Exception"
, codeblock 2 [ "Test t = new Test(args);"
, "try"
, codeblock 2 [ "t.parse();" ]
,"catch("<>text err<+>"e)"
, codeblock 2 [ "System.err.println(\""<>text errmsg<>"\");"
, "System.err.println(\" \" + e.getMessage());"
, "System.exit(1);"
]
]
]
]
where
printOuts x = vcat $ map javaPrintOut (messages x)
messages x = "" : intersperse "" x
javaPrintOut x = text $ "System.out.println(" ++ x ++ ");"
importfun x = "import" <+> x <> ".*;"
lx = text lexer
px = text parser
absentity = text $ show def
eps = allEntryPoints cf
def = head eps
-- | Error handling in ANTLR.
-- By default, ANTLR does not stop after any parsing error and attempts to go
-- on, delivering what it has been able to parse.
-- It does not throw any exception, unlike J(F)lex+CUP.
-- The below code makes the test class behave as with J(F)lex+CUP.
antlrErrorHandling :: String -> [Doc]
antlrErrorHandling te =
[ "class"<+>tedoc<+>"extends RuntimeException"
, codeblock 2 [ "int line;"
, "int column;"
, "public"<+>tedoc<>"(String msg, int l, int c)"
, codeblock 2 [ "super(msg);"
, "line = l;"
, "column = c;"
]
]
, "class BNFCErrorListener implements ANTLRErrorListener"
, codeblock 2 [ "@Override"
, "public void syntaxError(Recognizer<?, ?> recognizer, Object o, int i"
<> ", int i1, String s, RecognitionException e)"
, codeblock 2 [ "throw new"<+>tedoc<>"(s,i,i1);"]
, "@Override"
, "public void reportAmbiguity(Parser parser, DFA dfa, int i, int i1, "
<>"boolean b, BitSet bitSet, ATNConfigSet atnConfigSet)"
, codeblock 2[ "throw new"<+>tedoc<>"(\"Ambiguity at\",i,i1);" ]
, "@Override"
, "public void reportAttemptingFullContext(Parser parser, DFA dfa, "
<>"int i, int i1, BitSet bitSet, ATNConfigSet atnConfigSet)"
, codeblock 2 []
, "@Override"
,"public void reportContextSensitivity(Parser parser, DFA dfa, int i, "
<>"int i1, int i2, ATNConfigSet atnConfigSet)"
,codeblock 2 []
]
]
where tedoc = text te