{-# LANGUAGE NoImplicitPrelude #-}

{-
    BNF Converter: Java Top File
    Copyright (C) 2004  Author:  Markus Forsberg, Peter Gammie,
                                 Michael Pellauer, Bjorn Bringert

-}

-------------------------------------------------------------------
-- |
-- Module      :  JavaTop
-- Copyright   :  (C)opyright 2003, {markus, aarne, pellauer, peteg, bringert} at cs dot chalmers dot se
--
-- 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 hiding ((<>))

import System.FilePath (pathSeparator, isPathSeparator)
import Data.Foldable (toList)
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 :: SharedOptions -> CF -> MkFiles ()
makeJava SharedOptions
opt = SharedOptions -> CF -> MkFiles ()
makeJava' SharedOptions
opt{ lang :: String
lang = [String] -> NameStyle -> String -> String
mkName [String]
javaReserved NameStyle
SnakeCase (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ SharedOptions -> String
lang SharedOptions
opt }
  -- issue #212: make a legal package name, see also
  -- https://docs.oracle.com/javase/tutorial/java/package/namingpkgs.html

makeJava' :: SharedOptions -> CF -> MkFiles ()
makeJava' :: SharedOptions -> CF -> MkFiles ()
makeJava' options :: SharedOptions
options@Options{Bool
Int
String
Maybe String
TokenText
RecordPositions
JavaLexerParser
OCamlParser
HappyMode
AlexVersion
Target
wcf :: SharedOptions -> Bool
visualStudio :: SharedOptions -> Bool
javaLexerParser :: SharedOptions -> JavaLexerParser
ocamlParser :: SharedOptions -> OCamlParser
agda :: SharedOptions -> Bool
xml :: SharedOptions -> Int
glr :: SharedOptions -> HappyMode
tokenText :: SharedOptions -> TokenText
alexMode :: SharedOptions -> AlexVersion
generic :: SharedOptions -> Bool
functor :: SharedOptions -> Bool
inDir :: SharedOptions -> Bool
linenumbers :: SharedOptions -> RecordPositions
inPackage :: SharedOptions -> Maybe String
make :: SharedOptions -> Maybe String
target :: SharedOptions -> Target
force :: SharedOptions -> Bool
outDir :: SharedOptions -> String
lbnfFile :: SharedOptions -> String
wcf :: Bool
visualStudio :: Bool
javaLexerParser :: JavaLexerParser
ocamlParser :: OCamlParser
agda :: Bool
xml :: Int
glr :: HappyMode
tokenText :: TokenText
alexMode :: AlexVersion
generic :: Bool
functor :: Bool
inDir :: Bool
linenumbers :: RecordPositions
inPackage :: Maybe String
make :: Maybe String
target :: Target
force :: Bool
outDir :: String
lang :: String
lbnfFile :: String
lang :: SharedOptions -> String
..} CF
cf = do
     -- Create the package directories if necessary.
    let packageBase :: String
packageBase  = (String -> String)
-> (String -> String -> String) -> Maybe String -> String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> String
forall a. a -> a
id String -> String -> String
(+.+) Maybe String
inPackage String
lang
        packageAbsyn :: String
packageAbsyn = String
packageBase String -> String -> String
+.+ String
"Absyn"
        dirBase :: String
dirBase      = String -> String
pkgToDir String
packageBase
        dirAbsyn :: String
dirAbsyn     = String -> String
pkgToDir String
packageAbsyn
        javaex :: String -> String
javaex String
str   = String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
+.+ String
"java"
        bnfcfiles :: BNFCGeneratedEntities
bnfcfiles    =
          String
-> String
-> CF
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> BNFCGeneratedEntities
bnfcVisitorsAndTests
            String
packageBase
            String
packageAbsyn
            CF
cf
            CFToJava
cf2JavaPrinter
            CFToJava
cf2VisitSkel
            CFToJava
cf2ComposVisitor
            CFToJava
cf2AbstractVisitor
            CFToJava
cf2FoldVisitor
            CFToJava
cf2AllVisitor
            (ParserLexerSpecification -> TestClass
testclass ParserLexerSpecification
parselexspec
                ([String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ MakeFileDetails -> [String]
results MakeFileDetails
lexmake) -- lexer class
                ([String] -> String
forall a. [a] -> a
head ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ MakeFileDetails -> [String]
results MakeFileDetails
parmake) -- parser class
            )
        makebnfcfile :: (BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, c)
x = String -> c -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String -> String
javaex ((String, c) -> String
forall a b. (a, b) -> a
fst ((String, c) -> String) -> (String, c) -> String
forall a b. (a -> b) -> a -> b
$ BNFCGeneratedEntities -> (String, c)
x BNFCGeneratedEntities
bnfcfiles))
                                        ((String, c) -> c
forall a b. (a, b) -> b
snd ((String, c) -> c) -> (String, c) -> c
forall a b. (a -> b) -> a -> b
$ BNFCGeneratedEntities -> (String, c)
x BNFCGeneratedEntities
bnfcfiles)

    let absynFiles :: [(String, String)]
absynFiles = [(String, String)] -> [(String, String)]
forall a b. Eq a => [(a, b)] -> [(a, b)]
remDups ([(String, String)] -> [(String, String)])
-> [(String, String)] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> RecordPositions -> [(String, String)]
cf2JavaAbs String
packageBase String
packageAbsyn CF
cf RecordPositions
rp
        absynBaseNames :: [String]
absynBaseNames = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
absynFiles
        absynFileNames :: [String]
absynFileNames = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dirAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
absynBaseNames
    let writeAbsyn :: (String, c) -> MkFiles ()
writeAbsyn (String
filename, c
contents) =
          String -> c -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String
dirAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
filename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".java") c
contents
    ((String, String) -> MkFiles ())
-> [(String, String)] -> MkFiles ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String) -> MkFiles ()
forall c. FileContent c => (String, c) -> MkFiles ()
writeAbsyn [(String, String)]
absynFiles
    (BNFCGeneratedEntities -> (String, String)) -> MkFiles ()
forall c.
FileContent c =>
(BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, String)
bprettyprinter
    (BNFCGeneratedEntities -> (String, String)) -> MkFiles ()
forall c.
FileContent c =>
(BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, String)
bskel
    (BNFCGeneratedEntities -> (String, String)) -> MkFiles ()
forall c.
FileContent c =>
(BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, String)
bcompos
    (BNFCGeneratedEntities -> (String, String)) -> MkFiles ()
forall c.
FileContent c =>
(BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, String)
babstract
    (BNFCGeneratedEntities -> (String, String)) -> MkFiles ()
forall c.
FileContent c =>
(BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, String)
bfold
    (BNFCGeneratedEntities -> (String, String)) -> MkFiles ()
forall c.
FileContent c =>
(BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, String)
ball
    (BNFCGeneratedEntities -> (String, String)) -> MkFiles ()
forall c.
FileContent c =>
(BNFCGeneratedEntities -> (String, c)) -> MkFiles ()
makebnfcfile BNFCGeneratedEntities -> (String, String)
btest
    let (Doc
lex, [(String, String)]
env) = CF2LexerFunction
lexfun String
packageBase CF
cf
    -- Where the lexer file is created. lex is the content!
    String -> Doc -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> String
inputfile MakeFileDetails
lexmake ) Doc
lex
    IO () -> MkFiles ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MkFiles ()) -> IO () -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"   (Tested with" String -> String -> String
+++ MakeFileDetails -> String
toolname MakeFileDetails
lexmake
                                          String -> String -> String
+++ MakeFileDetails -> String
toolversion MakeFileDetails
lexmake  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    -- where the parser file is created.
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> String
inputfile MakeFileDetails
parmake)
          (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ CF2ParserFunction
parsefun String
packageBase String
packageAbsyn CF
cf RecordPositions
rp [(String, String)]
env
    IO () -> MkFiles ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MkFiles ()) -> IO () -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      if MakeFileDetails -> Bool
supportsEntryPoints MakeFileDetails
parmake
       then String
"(Parser created for all categories)"
       else String
"   (Parser created only for category " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
forall a. Show a => a -> String
show (CF -> Cat
firstEntry CF
cf) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    IO () -> MkFiles ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MkFiles ()) -> IO () -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"   (Tested with"  String -> String -> String
+++ MakeFileDetails -> String
toolname MakeFileDetails
parmake
                                           String -> String -> String
+++ MakeFileDetails -> String
toolversion MakeFileDetails
parmake String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    SharedOptions -> (String -> Doc) -> MkFiles ()
Makefile.mkMakefile SharedOptions
options ((String -> Doc) -> MkFiles ()) -> (String -> Doc) -> MkFiles ()
forall a b. (a -> b) -> a -> b
$
        String
-> String -> [String] -> ParserLexerSpecification -> String -> Doc
makefile String
dirBase String
dirAbsyn [String]
absynFileNames ParserLexerSpecification
parselexspec
  where
    remDups :: [(a, b)] -> [(a, b)]
remDups [] = []
    remDups ((a
a,b
b):[(a, b)]
as) = case a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
a [(a, b)]
as of
                           Just {} -> [(a, b)] -> [(a, b)]
remDups [(a, b)]
as
                           Maybe b
Nothing -> (a
a, b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)] -> [(a, b)]
remDups [(a, b)]
as
    pkgToDir :: String -> FilePath
    pkgToDir :: String -> String
pkgToDir String
s = Char -> Char -> String -> String
forall a. Eq a => a -> a -> [a] -> [a]
replace Char
'.' Char
pathSeparator String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]

    parselexspec :: ParserLexerSpecification
parselexspec = String
-> JavaLexerParser -> RecordPositions -> ParserLexerSpecification
parserLexerSelector String
lang JavaLexerParser
javaLexerParser RecordPositions
rp
    lexfun :: CF2LexerFunction
lexfun       = CFToLexer -> CF2LexerFunction
cf2lex (CFToLexer -> CF2LexerFunction) -> CFToLexer -> CF2LexerFunction
forall a b. (a -> b) -> a -> b
$ ParserLexerSpecification -> CFToLexer
lexer ParserLexerSpecification
parselexspec
    parsefun :: CF2ParserFunction
parsefun     = CFToParser -> CF2ParserFunction
cf2parse (CFToParser -> CF2ParserFunction)
-> CFToParser -> CF2ParserFunction
forall a b. (a -> b) -> a -> b
$ ParserLexerSpecification -> CFToParser
parser ParserLexerSpecification
parselexspec
    parmake :: MakeFileDetails
parmake      = CFToParser -> MakeFileDetails
makeparserdetails (ParserLexerSpecification -> CFToParser
parser ParserLexerSpecification
parselexspec)
    lexmake :: MakeFileDetails
lexmake      = CFToLexer -> MakeFileDetails
makelexerdetails  (ParserLexerSpecification -> CFToLexer
lexer ParserLexerSpecification
parselexspec)
    rp :: RecordPositions
rp           = (SharedOptions -> RecordPositions
Options.linenumbers SharedOptions
options)

makefile ::  FilePath -> FilePath -> [String] -> ParserLexerSpecification -> String -> Doc
makefile :: String
-> String -> [String] -> ParserLexerSpecification -> String -> Doc
makefile  String
dirBase String
dirAbsyn [String]
absynFileNames ParserLexerSpecification
jlexpar String
basename = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
    [(String, String)] -> [Doc]
makeVars [  (String
"JAVAC", String
"javac"),
                (String
"JAVAC_FLAGS", String
"-sourcepath ."),
                ( String
"JAVA", String
"java"),
                ( String
"JAVA_FLAGS", String
""),
            -- parser executable
                ( String
"PARSER", MakeFileDetails -> String
executable MakeFileDetails
parmake),
            -- parser flags
                ( String
"PARSER_FLAGS", MakeFileDetails -> String -> String
flags MakeFileDetails
parmake String
dirBase),
             -- lexer executable (and flags?)
                ( String
"LEXER", MakeFileDetails -> String
executable MakeFileDetails
lexmake),
                ( String
"LEXER_FLAGS", MakeFileDetails -> String -> String
flags MakeFileDetails
lexmake String
dirBase)
    ]
    [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
    [(String, [String], [String])] -> [Doc]
makeRules [ (String
"all", [ String
"test" ], []),
                ( String
"test", String
"absyn" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
classes, []),
                ( String
".PHONY", [String
"absyn"],     []),
                (String
"%.class", [ String
"%.java" ],  [ String -> String
runJavac String
"$^" ]),
                (String
"absyn",   [String
absynJavaSrc],[ String -> String
runJavac String
"$^" ])
                ][Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
    [-- running the lexergen: output of lexer -> input of lexer : calls lexer
    let ff :: String
ff = MakeFileDetails -> String
filename MakeFileDetails
lexmake -- name of input file without extension
        dirBaseff :: String
dirBaseff = String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ff -- prepend directory
        inp :: String
inp = String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> String
inputfile MakeFileDetails
lexmake in
        String -> [String] -> [String] -> Doc
Makefile.mkRule (String
dirBaseff String -> String -> String
+.+ String
"java") [ String
inp ]
        [ String
"${LEXER} ${LEXER_FLAGS} "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inp ]

    -- running the parsergen, these there are its outputs
    -- output of parser -> input of parser : calls parser
  , let inp :: String
inp = String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> String
inputfile MakeFileDetails
parmake in
        String -> [String] -> [String] -> Doc
Makefile.mkRule ([String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dirBaseString -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]
dotJava ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ MakeFileDetails -> [String]
results MakeFileDetails
parmake)))
          [ String
inp ] ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$
          (String
"${PARSER} ${PARSER_FLAGS} " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inp) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
          [String
"mv " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ([String] -> [String]
dotJava ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ MakeFileDetails -> [String]
results MakeFileDetails
parmake) String -> String -> String
+++ String
dirBase
              | MakeFileDetails -> Bool
moveresults MakeFileDetails
parmake]
  -- Class of the output of lexer generator wants java of :
  -- output of lexer and parser generator
  , let lexerOutClass :: String
lexerOutClass = String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> String
filename MakeFileDetails
lexmake String -> String -> String
+.+ String
"class"
        outname :: String -> String
outname String
x = String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
+.+ String
"java"
        deps :: [String]
deps = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
outname (MakeFileDetails -> [String]
results MakeFileDetails
lexmake [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> [String]
results MakeFileDetails
parmake) in
        String -> [String] -> [String] -> Doc
Makefile.mkRule String
lexerOutClass [String]
deps []
    ][Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
  [Doc] -> [Doc]
forall a. [a] -> [a]
reverse [String -> [String] -> [String] -> Doc
Makefile.mkRule String
tar [String]
dep [] |
    (String
tar,[String]
dep) <- String -> [String] -> [(String, [String])]
partialParserGoals String
dirBase (MakeFileDetails -> [String]
results MakeFileDetails
parmake)]
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++[ String -> [String] -> [String] -> Doc
Makefile.mkRule (String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"PrettyPrinter.class")
        [ String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"PrettyPrinter.java" ] []
    -- Removes all the class files created anywhere
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"clean" [] [ String
"rm -f " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*.class" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
                                            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*.class" ]
    -- Remains the same
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"distclean" [ String
"vclean" ] []
    -- removes everything
    , String -> [String] -> [String] -> Doc
Makefile.mkRule String
"vclean" []
        [ String
" rm -f " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
absynJavaSrc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
absynJavaClass
        , String
" rm -f " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirAbsyn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*.class"
        , String
" rmdir " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirAbsyn
        , String
" rm -f " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
dirBase String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
                    [ MakeFileDetails -> String
inputfile MakeFileDetails
lexmake
                    , MakeFileDetails -> String
inputfile MakeFileDetails
parmake
                    ]
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
dotJava (MakeFileDetails -> [String]
results MakeFileDetails
lexmake)
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"VisitSkel.java"
                      , String
"ComposVisitor.java"
                      , String
"AbstractVisitor.java"
                      , String
"FoldVisitor.java"
                      , String
"AllVisitor.java"
                      , String
"PrettyPrinter.java"
                      , String
"Skeleton.java"
                      , String
"Test.java"
                      ]
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String] -> [String]
dotJava (MakeFileDetails -> [String]
results MakeFileDetails
parmake)
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"*.class"]
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> [String]
other_results MakeFileDetails
lexmake
                    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ MakeFileDetails -> [String]
other_results MakeFileDetails
parmake)
        , String
" rm -f " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
basename
        , String
" rmdir -p " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dirBase
        ]
    ]
    where
      makeVars :: [(String, String)] -> [Doc]
makeVars [(String, String)]
x = [String -> String -> Doc
Makefile.mkVar String
n String
v | (String
n,String
v) <- [(String, String)]
x]
      makeRules :: [(String, [String], [String])] -> [Doc]
makeRules [(String, [String], [String])]
x = [String -> [String] -> [String] -> Doc
Makefile.mkRule String
tar [String]
dep [String]
recipe  | (String
tar, [String]
dep, [String]
recipe) <- [(String, [String], [String])]
x]
      parmake :: MakeFileDetails
parmake           = CFToParser -> MakeFileDetails
makeparserdetails (ParserLexerSpecification -> CFToParser
parser ParserLexerSpecification
jlexpar)
      lexmake :: MakeFileDetails
lexmake           = CFToLexer -> MakeFileDetails
makelexerdetails (ParserLexerSpecification -> CFToLexer
lexer ParserLexerSpecification
jlexpar)
      absynJavaSrc :: String
absynJavaSrc      = [String] -> String
unwords ([String] -> [String]
dotJava [String]
absynFileNames)
      absynJavaClass :: String
absynJavaClass    = [String] -> String
unwords ([String] -> [String]
dotClass [String]
absynFileNames)
      classes :: [String]
classes = String -> [String] -> [String]
prependPath String
dirBase [String]
lst
      lst :: [String]
lst = [String] -> [String]
dotClass (MakeFileDetails -> [String]
results MakeFileDetails
lexmake) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"PrettyPrinter.class", String
"Test.class"
          , String
"VisitSkel.class"
          , String
"ComposVisitor.class", String
"AbstractVisitor.class"
          , String
"FoldVisitor.class", String
"AllVisitor.class"][String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
           [String] -> [String]
dotClass (MakeFileDetails -> [String]
results MakeFileDetails
parmake) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"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

-- | Record to name arguments of 'javaTest'.
data JavaTestParams = JavaTestParams
  { JavaTestParams -> [Doc]
jtpImports            :: [Doc]
      -- ^ List of imported packages.
  , JavaTestParams -> String
jtpErr                :: String
      -- ^ Name of the exception thrown in case of parsing failure.
  , JavaTestParams -> String -> [Doc]
jtpErrHand            :: (String -> [Doc])
      -- ^ Handler for the exception thrown.
  , JavaTestParams -> Doc -> Doc -> Doc
jtpLexerConstruction  :: (Doc -> Doc -> Doc)
      -- ^ Function formulating the construction of the lexer object.
  , JavaTestParams -> Doc -> Doc -> Doc
jtpParserConstruction :: (Doc -> Doc -> Doc)
      -- ^ As above, for parser object.
  , JavaTestParams -> [Cat] -> [Doc]
jtpShowAlternatives   :: ([Cat] -> [Doc])
      -- ^ Pretty-print the names of the methods corresponding to entry points to the user.
  , JavaTestParams -> Doc -> Doc -> Doc -> Doc -> Doc
jtpInvocation         :: (Doc -> Doc -> Doc -> Doc -> Doc)
      -- ^ Function formulating the invocation of the parser tool within Java.
  , JavaTestParams -> String
jtpErrMsg             :: String
      -- ^ Error string output in consequence of a parsing failure.
  }

-- | Test class details for J(F)Lex + CUP
cuptest :: TestClass
cuptest :: TestClass
cuptest = JavaTestParams -> TestClass
javaTest (JavaTestParams -> TestClass) -> JavaTestParams -> TestClass
forall a b. (a -> b) -> a -> b
$ JavaTestParams :: [Doc]
-> String
-> (String -> [Doc])
-> (Doc -> Doc -> Doc)
-> (Doc -> Doc -> Doc)
-> ([Cat] -> [Doc])
-> (Doc -> Doc -> Doc -> Doc -> Doc)
-> String
-> JavaTestParams
JavaTestParams
  { jtpImports :: [Doc]
jtpImports            = [Doc
"java_cup.runtime"]
  , jtpErr :: String
jtpErr                = String
"Throwable"
  , jtpErrHand :: String -> [Doc]
jtpErrHand            = [Doc] -> String -> [Doc]
forall a b. a -> b -> a
const []
  , jtpLexerConstruction :: Doc -> Doc -> Doc
jtpLexerConstruction  = \ Doc
x Doc
i -> Doc
x Doc -> Doc -> Doc
<> Doc
i Doc -> Doc -> Doc
<> Doc
";"
  , jtpParserConstruction :: Doc -> Doc -> Doc
jtpParserConstruction = \ Doc
x Doc
i -> Doc
x Doc -> Doc -> Doc
<> Doc
"(" Doc -> Doc -> Doc
<> Doc
i Doc -> Doc -> Doc
<> Doc
", " Doc -> Doc -> Doc
<> Doc
i Doc -> Doc -> Doc
<> Doc
".getSymbolFactory());"
  , jtpShowAlternatives :: [Cat] -> [Doc]
jtpShowAlternatives   = [Doc] -> [Cat] -> [Doc]
forall a b. a -> b -> a
const ([Doc] -> [Cat] -> [Doc]) -> [Doc] -> [Cat] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Doc
"not available."]
  , jtpInvocation :: Doc -> Doc -> Doc -> Doc -> Doc
jtpInvocation         = \ Doc
_ Doc
pabs Doc
dat Doc
enti -> [Doc] -> Doc
hcat [ Doc
pabs, Doc
".", Doc
dat, Doc
" ast = p.p", Doc
enti, Doc
"();" ]
  , jtpErrMsg :: String
jtpErrMsg             = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
      [ String
"At line \" + String.valueOf(t.l.line_num()) + \","
      , String
"near \\\"\" + t.l.buff() + \"\\\" :"
      ]
  }

-- | Test class details for ANTLR4
antlrtest :: TestClass
antlrtest :: TestClass
antlrtest = JavaTestParams -> TestClass
javaTest (JavaTestParams -> TestClass) -> JavaTestParams -> TestClass
forall a b. (a -> b) -> a -> b
$ JavaTestParams :: [Doc]
-> String
-> (String -> [Doc])
-> (Doc -> Doc -> Doc)
-> (Doc -> Doc -> Doc)
-> ([Cat] -> [Doc])
-> (Doc -> Doc -> Doc -> Doc -> Doc)
-> String
-> JavaTestParams
JavaTestParams
  { jtpImports :: [Doc]
jtpImports =
      [ Doc
"org.antlr.v4.runtime"
      , Doc
"org.antlr.v4.runtime.atn"
      , Doc
"org.antlr.v4.runtime.dfa"
      , Doc
"java.util"
      ]
  , jtpErr :: String
jtpErr =
      String
"TestError"
  , jtpErrHand :: String -> [Doc]
jtpErrHand =
      String -> [Doc]
antlrErrorHandling
  , jtpLexerConstruction :: Doc -> Doc -> Doc
jtpLexerConstruction  =
      \ Doc
x Doc
i -> [Doc] -> Doc
vcat
        [ Doc
x Doc -> Doc -> Doc
<> Doc
"(new ANTLRInputStream" Doc -> Doc -> Doc
<> Doc
i Doc -> Doc -> Doc
<>Doc
");"
        , Doc
"l.addErrorListener(new BNFCErrorListener());"
        ]
  , jtpParserConstruction :: Doc -> Doc -> Doc
jtpParserConstruction =
      \ Doc
x Doc
i -> [Doc] -> Doc
vcat
        [ Doc
x Doc -> Doc -> Doc
<> Doc
"(new CommonTokenStream(" Doc -> Doc -> Doc
<> Doc
i Doc -> Doc -> Doc
<>Doc
"));"
        , Doc
"p.addErrorListener(new BNFCErrorListener());"
        ]
  , jtpShowAlternatives :: [Cat] -> [Doc]
jtpShowAlternatives   =
      [Cat] -> [Doc]
showOpts
  , jtpInvocation :: Doc -> Doc -> Doc -> Doc -> Doc
jtpInvocation         =
      \ Doc
pbase Doc
pabs Doc
dat Doc
enti -> [Doc] -> Doc
vcat
         [
           let rulename :: String
rulename = String -> String
getRuleName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
startSymbol (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Doc -> String
render Doc
enti
               typename :: Doc
typename = String -> Doc
text String
rulename
               methodname :: Doc
methodname = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String -> String
firstLowerCase String
rulename
           in
               Doc
pbase Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
typename Doc -> Doc -> Doc
<> Doc
"Context pc = p." Doc -> Doc -> Doc
<> Doc
methodname Doc -> Doc -> Doc
<> Doc
"();"
         , Doc
pabs Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
dat Doc -> Doc -> Doc
<+> Doc
"ast = pc.result;"
         ]
  , jtpErrMsg :: String
jtpErrMsg             =
      String
"At line \" + e.line + \", column \" + e.column + \" :"
  }
  where
    showOpts :: [Cat] -> [Doc]
showOpts [] = []
    showOpts (Cat
x:[Cat]
xs)
      | Cat -> Cat
normCat Cat
x Cat -> Cat -> Bool
forall a. Eq a => a -> a -> Bool
/= Cat
x = [Cat] -> [Doc]
showOpts [Cat]
xs
      | Bool
otherwise      = String -> Doc
text (String -> String
firstLowerCase (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat Cat
x) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Cat] -> [Doc]
showOpts [Cat]
xs

parserLexerSelector :: String
    -> JavaLexerParser
    -> RecordPositions -- ^Pass line numbers to the symbols
    -> ParserLexerSpecification
parserLexerSelector :: String
-> JavaLexerParser -> RecordPositions -> ParserLexerSpecification
parserLexerSelector String
_ JavaLexerParser
JLexCup RecordPositions
rp = ParseLexSpec :: CFToParser -> CFToLexer -> TestClass -> ParserLexerSpecification
ParseLexSpec
    { lexer :: CFToLexer
lexer     = RecordPositions -> CFToLexer
cf2JLex RecordPositions
rp
    , parser :: CFToParser
parser    = RecordPositions -> CFToParser
cf2cup RecordPositions
rp
    , testclass :: TestClass
testclass = TestClass
cuptest
    }
parserLexerSelector String
_ JavaLexerParser
JFlexCup RecordPositions
rp =
    (String
-> JavaLexerParser -> RecordPositions -> ParserLexerSpecification
parserLexerSelector String
"" JavaLexerParser
JLexCup RecordPositions
rp){lexer :: CFToLexer
lexer = RecordPositions -> CFToLexer
cf2JFlex RecordPositions
rp}
parserLexerSelector String
l JavaLexerParser
Antlr4 RecordPositions
_ = ParseLexSpec :: CFToParser -> CFToLexer -> TestClass -> ParserLexerSpecification
ParseLexSpec
    { lexer :: CFToLexer
lexer     = String -> CFToLexer
cf2AntlrLex' String
l
    , parser :: CFToParser
parser    = String -> CFToParser
cf2AntlrParse' String
l
    , testclass :: TestClass
testclass = TestClass
antlrtest
    }

data ParserLexerSpecification = ParseLexSpec
    { ParserLexerSpecification -> CFToParser
parser    :: CFToParser
    , ParserLexerSpecification -> CFToLexer
lexer     :: CFToLexer
    , ParserLexerSpecification -> TestClass
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
    { CFToLexer -> CF2LexerFunction
cf2lex           :: CF2LexerFunction
    , CFToLexer -> MakeFileDetails
makelexerdetails :: MakeFileDetails
    }

-- | Instances of cf-lexergen bridges
cf2JLex, cf2JFlex :: RecordPositions -> CFToLexer

cf2JLex :: RecordPositions -> CFToLexer
cf2JLex RecordPositions
rp = CF2Lex :: CF2LexerFunction -> MakeFileDetails -> CFToLexer
CF2Lex
       { cf2lex :: CF2LexerFunction
cf2lex           = JavaLexerParser -> RecordPositions -> CF2LexerFunction
BNFC.Backend.Java.CFtoJLex15.cf2jlex JavaLexerParser
JLexCup RecordPositions
rp
       , makelexerdetails :: MakeFileDetails
makelexerdetails = MakeFileDetails
jlexmakedetails
       }

cf2JFlex :: RecordPositions -> CFToLexer
cf2JFlex RecordPositions
rp = CF2Lex :: CF2LexerFunction -> MakeFileDetails -> CFToLexer
CF2Lex
       { cf2lex :: CF2LexerFunction
cf2lex           = JavaLexerParser -> RecordPositions -> CF2LexerFunction
BNFC.Backend.Java.CFtoJLex15.cf2jlex JavaLexerParser
JFlexCup RecordPositions
rp
       , makelexerdetails :: MakeFileDetails
makelexerdetails = MakeFileDetails
jflexmakedetails
       }

cf2AntlrLex' :: String -> CFToLexer
cf2AntlrLex' :: String -> CFToLexer
cf2AntlrLex' String
l = CF2Lex :: CF2LexerFunction -> MakeFileDetails -> CFToLexer
CF2Lex
               { cf2lex :: CF2LexerFunction
cf2lex           =
                   CF2LexerFunction
BNFC.Backend.Java.CFtoAntlr4Lexer.cf2AntlrLex
               , makelexerdetails :: MakeFileDetails
makelexerdetails = String -> MakeFileDetails
antlrmakedetails (String -> MakeFileDetails) -> String -> MakeFileDetails
forall a b. (a -> b) -> a -> b
$ String
lString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"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
    { CFToParser -> CF2ParserFunction
cf2parse          :: CF2ParserFunction
    , CFToParser -> MakeFileDetails
makeparserdetails :: MakeFileDetails
    }

-- | Instances of cf-parsergen bridges
cf2cup :: RecordPositions -> CFToParser
cf2cup :: RecordPositions -> CFToParser
cf2cup RecordPositions
rp = CF2Parse :: CF2ParserFunction -> MakeFileDetails -> CFToParser
CF2Parse
    { cf2parse :: CF2ParserFunction
cf2parse          = CF2ParserFunction
BNFC.Backend.Java.CFtoCup15.cf2Cup
    , makeparserdetails :: MakeFileDetails
makeparserdetails = RecordPositions -> MakeFileDetails
cupmakedetails RecordPositions
rp
    }

cf2AntlrParse' :: String -> CFToParser
cf2AntlrParse' :: String -> CFToParser
cf2AntlrParse' String
l = CF2Parse :: CF2ParserFunction -> MakeFileDetails -> CFToParser
CF2Parse
                { cf2parse :: CF2ParserFunction
cf2parse          =
                    CF2ParserFunction
BNFC.Backend.Java.CFtoAntlr4Parser.cf2AntlrParse
                , makeparserdetails :: MakeFileDetails
makeparserdetails = String -> MakeFileDetails
antlrmakedetails (String -> MakeFileDetails) -> String -> MakeFileDetails
forall a b. (a -> b) -> a -> b
$ String
lString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"Parser"
                }


-- | shorthand for Makefile command running javac or java
runJavac , runJava:: String -> String
runJava :: String -> String
runJava   = String -> String -> String
mkRunProgram String
"JAVA"
runJavac :: String -> String
runJavac  = String -> String -> String
mkRunProgram String
"JAVAC"

-- | function returning a string executing a program contained in a variable j
-- on input s
mkRunProgram :: String -> String -> String
mkRunProgram :: String -> String -> String
mkRunProgram String
j String
s = String -> String
Makefile.refVar String
j String -> String -> String
+++ String -> String
Makefile.refVar (String
j String -> String -> String
+-+ String
"FLAGS") String -> String -> String
+++ String
s

type OutputDirectory = String

-- | Makefile details from running the parser-lexer generation tools.
data MakeFileDetails = MakeDetails
    { -- | The string that executes the generation tool
      MakeFileDetails -> String
executable          :: String
      -- | Flags to pass to the tool
    , MakeFileDetails -> String -> String
flags               :: OutputDirectory -> String
      -- | Input file to the tool
    , MakeFileDetails -> String
filename            :: String
      -- | Extension of input file to the tool
    , MakeFileDetails -> String
fileextension       :: String
      -- | name of the tool
    , MakeFileDetails -> String
toolname            :: String
      -- | Tool version
    , MakeFileDetails -> String
toolversion         :: String
      -- | true if the tool is a parser and supports entry points,
      -- false otherwise
    , MakeFileDetails -> Bool
supportsEntryPoints :: Bool
      -- | list of names (without extension!) of files resulting from the
      -- application of the tool which are relevant to a make rule
    , MakeFileDetails -> [String]
results             :: [String]
      -- | list of names of files resulting from the application of
      -- the tool which are irrelevant to the make rules but need to
      -- be cleaned
    , MakeFileDetails -> [String]
other_results       :: [String]
      -- | if true, the files are moved to the base directory, otherwise
      -- they are left where they are
    , MakeFileDetails -> Bool
moveresults         :: Bool
    }


mapEmpty :: a -> String
mapEmpty :: a -> String
mapEmpty a
_ = String
""

-- Instances of makefile details.
jflexmakedetails, jlexmakedetails :: MakeFileDetails
cupmakedetails :: RecordPositions -> MakeFileDetails

jlexmakedetails :: MakeFileDetails
jlexmakedetails = MakeDetails :: String
-> (String -> String)
-> String
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Bool
-> MakeFileDetails
MakeDetails
    { executable :: String
executable          = String -> String
runJava String
"JLex.Main"
    , flags :: String -> String
flags               = String -> String
forall a. a -> String
mapEmpty
    , filename :: String
filename            = String
"Yylex"
    , fileextension :: String
fileextension       = String
""
    , toolname :: String
toolname            = String
"JLex"
    , toolversion :: String
toolversion         = String
"1.2.6"
    , supportsEntryPoints :: Bool
supportsEntryPoints = Bool
False
    , results :: [String]
results             = [String
"Yylex"]
    , other_results :: [String]
other_results       = []
    , moveresults :: Bool
moveresults         = Bool
False
    }

jflexmakedetails :: MakeFileDetails
jflexmakedetails = MakeFileDetails
jlexmakedetails
    { executable :: String
executable  = String
"jflex"
    , toolname :: String
toolname    = String
"JFlex"
    , toolversion :: String
toolversion = String
"1.4.3 - 1.7.0"
    }

cupmakedetails :: RecordPositions -> MakeFileDetails
cupmakedetails RecordPositions
rp = MakeDetails :: String
-> (String -> String)
-> String
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Bool
-> MakeFileDetails
MakeDetails
    { executable :: String
executable          = String -> String
runJava String
"java_cup.Main"
    , flags :: String -> String
flags               = String -> String -> String
forall a b. a -> b -> a
const (String
lnFlags String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -expect 100")
    , filename :: String
filename            = String
"_cup"
    , fileextension :: String
fileextension       = String
"cup"
    , toolname :: String
toolname            = String
"CUP"
    , toolversion :: String
toolversion         = String
"0.11b"
    , supportsEntryPoints :: Bool
supportsEntryPoints = Bool
False
    , results :: [String]
results             = [String
"parser", String
"sym"]
    , other_results :: [String]
other_results       = []
    , moveresults :: Bool
moveresults         = Bool
True
    }
  where
    lnFlags :: String
lnFlags = if RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions then String
"-locations" else String
"-nopositions"


antlrmakedetails :: String -> MakeFileDetails
antlrmakedetails :: String -> MakeFileDetails
antlrmakedetails String
l = MakeDetails :: String
-> (String -> String)
-> String
-> String
-> String
-> String
-> Bool
-> [String]
-> [String]
-> Bool
-> MakeFileDetails
MakeDetails
    { executable :: String
executable = String -> String
runJava String
"org.antlr.v4.Tool"
    , flags :: String -> String
flags               = \String
x -> [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                                    let path :: String
path    = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
x
                                        pointed :: String
pointed = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
cnv String
path
                                        cnv :: Char -> Char
cnv Char
y   = if Char -> Bool
isPathSeparator Char
y
                                                        then Char
'.'
                                                        else Char
y
                                        in [ String
"-lib", String
path
                                           , String
"-package", String
pointed]
    , filename :: String
filename            = String
l
    , fileextension :: String
fileextension       = String
"g4"
    , toolname :: String
toolname            = String
"ANTLRv4"
    , toolversion :: String
toolversion         = String
"4.5.1"
    , supportsEntryPoints :: Bool
supportsEntryPoints = Bool
True
    , results :: [String]
results             = [String
l]
    , other_results :: [String]
other_results       = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String
".tokens",String
"BaseListener.java",String
"Listener.java"]
    , moveresults :: Bool
moveresults         = Bool
False
    }

prependPath , appendExtension :: String -> [String] -> [String]
prependPath :: String -> [String] -> [String]
prependPath String
s [String]
fi     = [ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x  | String
x <- [String]
fi ]
appendExtension :: String -> [String] -> [String]
appendExtension String
s [String]
fi = [ String
x String -> String -> String
+.+ String
s | String
x <- [String]
fi ]

dotJava,dotClass :: [String] -> [String]
dotJava :: [String] -> [String]
dotJava  = String -> [String] -> [String]
appendExtension String
"java"
dotClass :: [String] -> [String]
dotClass = String -> [String] -> [String]
appendExtension String
"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
    { BNFCGeneratedEntities -> (String, String)
bprettyprinter :: (String, String)
    , BNFCGeneratedEntities -> (String, String)
btest          :: (String, String)
    , BNFCGeneratedEntities -> (String, String)
bcompos        :: (String, String)
    , BNFCGeneratedEntities -> (String, String)
babstract      :: (String, String)
    , BNFCGeneratedEntities -> (String, String)
bfold          :: (String, String)
    , BNFCGeneratedEntities -> (String, String)
ball           :: (String, String)
    , BNFCGeneratedEntities -> (String, String)
bskel          :: (String, String)
    }

bnfcVisitorsAndTests :: String   -> String    -> CF      ->
                        CFToJava -> CFToJava -> CFToJava ->
                        CFToJava -> CFToJava -> CFToJava ->
                        CFToJava -> BNFCGeneratedEntities
bnfcVisitorsAndTests :: String
-> String
-> CF
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> CFToJava
-> BNFCGeneratedEntities
bnfcVisitorsAndTests String
pbase String
pabsyn CF
cf CFToJava
cf0 CFToJava
cf1 CFToJava
cf2 CFToJava
cf3 CFToJava
cf4 CFToJava
cf5 CFToJava
cf6 =
    BNFCGenerated :: (String, String)
-> (String, String)
-> (String, String)
-> (String, String)
-> (String, String)
-> (String, String)
-> (String, String)
-> BNFCGeneratedEntities
BNFCGenerated
    { bprettyprinter :: (String, String)
bprettyprinter = ( String
"PrettyPrinter" , CFToJava -> String
forall t. (String -> String -> CF -> t) -> t
app CFToJava
cf0)
    , bskel :: (String, String)
bskel          = ( String
"VisitSkel", CFToJava -> String
forall t. (String -> String -> CF -> t) -> t
app CFToJava
cf1)
    , bcompos :: (String, String)
bcompos        = ( String
"ComposVisitor" , CFToJava -> String
forall t. (String -> String -> CF -> t) -> t
app CFToJava
cf2)
    , babstract :: (String, String)
babstract      = ( String
"AbstractVisitor" , CFToJava -> String
forall t. (String -> String -> CF -> t) -> t
app CFToJava
cf3)
    , bfold :: (String, String)
bfold          = ( String
"FoldVisitor", CFToJava -> String
forall t. (String -> String -> CF -> t) -> t
app CFToJava
cf4)
    , ball :: (String, String)
ball           = ( String
"AllVisitor", CFToJava -> String
forall t. (String -> String -> CF -> t) -> t
app CFToJava
cf5)
    , btest :: (String, String)
btest          = ( String
"Test" , CFToJava -> String
forall t. (String -> String -> CF -> t) -> t
app CFToJava
cf6)
    }
  where app :: (String -> String -> CF -> t) -> t
app String -> String -> CF -> t
x = String -> String -> CF -> t
x String
pbase String
pabsyn CF
cf

inputfile :: MakeFileDetails -> String
inputfile MakeFileDetails
x = MakeFileDetails -> String
filename MakeFileDetails
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ case MakeFileDetails -> String
fileextension MakeFileDetails
x of
                                String
"" -> String
""
                                String
a -> Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
a

-- |  constructs the rules regarding the parser in the makefile
partialParserGoals :: String -> [String] -> [(String, [String])]
partialParserGoals :: String -> [String] -> [(String, [String])]
partialParserGoals String
_ []          = []
partialParserGoals String
dbas (String
x:[String]
rest) =
    (String
dbas String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
+.+ String
"class", (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ String
y -> String
dbas String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y String -> String -> String
+.+ String
"java") (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
rest))
        (String, [String]) -> [(String, [String])] -> [(String, [String])]
forall a. a -> [a] -> [a]
: String -> [String] -> [(String, [String])]
partialParserGoals String
dbas [String]
rest

-- | Creates the Test.java class.
javaTest :: JavaTestParams -> TestClass
javaTest :: JavaTestParams -> TestClass
javaTest (JavaTestParams
    [Doc]
imports
    String
err
    String -> [Doc]
errhand
    Doc -> Doc -> Doc
lexerconstruction
    Doc -> Doc -> Doc
parserconstruction
    [Cat] -> [Doc]
showOpts
    Doc -> Doc -> Doc -> Doc -> Doc
invocation
    String
errmsg)
    String
lexer
    String
parser
    String
packageBase
    String
packageAbsyn
    CF
cf =
    Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Doc]] -> [Doc]) -> [[Doc]] -> [Doc]
forall a b. (a -> b) -> a -> b
$
      [ [ Doc
"package" Doc -> Doc -> Doc
<+> String -> Doc
text String
packageBase Doc -> Doc -> Doc
<> Doc
";"
        , Doc
""
        , Doc
"import" Doc -> Doc -> Doc
<+> String -> Doc
text String
packageBase Doc -> Doc -> Doc
<> Doc
".*;"
        , Doc
"import java.io.*;"
        ]
      , (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
importfun [Doc]
imports
      , [ Doc
"" ]
      , String -> [Doc]
errhand String
err
      , [ Doc
""
        , Doc
"public class Test"
        , Int -> [Doc] -> Doc
codeblock Int
2
            [ Doc
lx Doc -> Doc -> Doc
<+> Doc
"l;"
            , Doc
px Doc -> Doc -> Doc
<+> Doc
"p;"
            , Doc
""
            , Doc
"public Test(String[] args)"
            , Int -> [Doc] -> Doc
codeblock Int
2
                [ Doc
"try"
                , Int -> [Doc] -> Doc
codeblock Int
2
                    [ Doc
"Reader input;"
                    , Doc
"if (args.length == 0) input = new InputStreamReader(System.in);"
                    , Doc
"else input = new FileReader(args[0]);"
                    , Doc
"l = new " Doc -> Doc -> Doc
<> Doc -> Doc -> Doc
lexerconstruction Doc
lx Doc
"(input)"
                    ]
                , Doc
"catch(IOException e)"
                , Int -> [Doc] -> Doc
codeblock Int
2
                    [ Doc
"System.err.println(\"Error: File not found: \" + args[0]);"
                    , Doc
"System.exit(1);"
                    ]
                , Doc
"p = new "Doc -> Doc -> Doc
<> Doc -> Doc -> Doc
parserconstruction Doc
px Doc
"l"
                ]
            , Doc
""
            , Doc
"public" Doc -> Doc -> Doc
<+> String -> Doc
text String
packageAbsyn Doc -> Doc -> Doc
<> Doc
"." Doc -> Doc -> Doc
<> Doc
dat
                Doc -> Doc -> Doc
<+> Doc
"parse() throws Exception"
            , Int -> [Doc] -> Doc
codeblock Int
2 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ [ Doc
"/* The default parser is the first-defined entry point. */" ]
                , [Cat] -> ([Cat] -> [Doc]) -> [Doc]
forall m a. Monoid m => [a] -> ([a] -> m) -> m
unlessNull (Int -> [Cat] -> [Cat]
forall a. Int -> [a] -> [a]
drop Int
1 [Cat]
eps) (([Cat] -> [Doc]) -> [Doc]) -> ([Cat] -> [Doc]) -> [Doc]
forall a b. (a -> b) -> a -> b
$ \ [Cat]
eps' ->
                  [ Doc
"/* Other options are: */"
                  , Doc
"/* " Doc -> Doc -> Doc
<> [Doc] -> Doc
fsep (Doc -> [Doc] -> [Doc]
punctuate Doc
"," ([Cat] -> [Doc]
showOpts [Cat]
eps')) Doc -> Doc -> Doc
<> Doc
" */"
                  ]
                , [ Doc -> Doc -> Doc -> Doc -> Doc
invocation Doc
px (String -> Doc
text String
packageAbsyn) Doc
dat Doc
absentity
                  , [String] -> Doc
printOuts
                     [ String
"\"Parse Succesful!\""
                     , String
"\"[Abstract Syntax]\""
                     , String
"PrettyPrinter.show(ast)"
                     , String
"\"[Linearized Tree]\""
                     , String
"PrettyPrinter.print(ast)"
                     ]
                  , Doc
"return ast;"
                  ]
                ]
            , Doc
""
            , Doc
"public static void main(String args[]) throws Exception"
            , Int -> [Doc] -> Doc
codeblock Int
2
                [ Doc
"Test t = new Test(args);"
                , Doc
"try"
                , Int -> [Doc] -> Doc
codeblock Int
2 [ Doc
"t.parse();" ]
                ,Doc
"catch(" Doc -> Doc -> Doc
<> String -> Doc
text String
err Doc -> Doc -> Doc
<+> Doc
"e)"
                , Int -> [Doc] -> Doc
codeblock Int
2
                    [ Doc
"System.err.println(\"" Doc -> Doc -> Doc
<> String -> Doc
text String
errmsg Doc -> Doc -> Doc
<> Doc
"\");"
                    , Doc
"System.err.println(\"     \" + e.getMessage());"
                    , Doc
"System.exit(1);"
                    ]
                ]
            ]
        ]
      ]
    where
      printOuts :: [String] -> Doc
printOuts [String]
x    = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
javaPrintOut ([String] -> [String]
forall a. IsString a => [a] -> [a]
messages [String]
x)
      messages :: [a] -> [a]
messages [a]
x     = a
"" a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
forall a. a -> [a] -> [a]
intersperse a
"" [a]
x
      javaPrintOut :: String -> Doc
javaPrintOut String
x = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"System.out.println(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
      importfun :: Doc -> Doc
importfun Doc
x    = Doc
"import" Doc -> Doc -> Doc
<+> Doc
x Doc -> Doc -> Doc
<> Doc
".*;"
      lx :: Doc
lx             = String -> Doc
text String
lexer
      px :: Doc
px             = String -> Doc
text String
parser
      dat :: Doc
dat            = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat (Cat -> String) -> Cat -> String
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCat Cat
def  -- Use for AST types.
      absentity :: Doc
absentity      = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Cat -> String
identCat Cat
def            -- Use for parser/printer name.
      eps :: [Cat]
eps            = NonEmpty Cat -> [Cat]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Cat -> [Cat]) -> NonEmpty Cat -> [Cat]
forall a b. (a -> b) -> a -> b
$ CF -> NonEmpty Cat
forall f. CFG f -> NonEmpty Cat
allEntryPoints CF
cf
      def :: Cat
def            = [Cat] -> Cat
forall a. [a] -> a
head [Cat]
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 :: String -> [Doc]
antlrErrorHandling String
te =
    [ Doc
"class"Doc -> Doc -> Doc
<+>Doc
tedocDoc -> Doc -> Doc
<+>Doc
"extends RuntimeException"
    , Int -> [Doc] -> Doc
codeblock Int
2 [ Doc
"int line;"
        , Doc
"int column;"
        , Doc
"public"Doc -> Doc -> Doc
<+>Doc
tedocDoc -> Doc -> Doc
<>Doc
"(String msg, int l, int c)"
        , Int -> [Doc] -> Doc
codeblock Int
2 [ Doc
"super(msg);"
            , Doc
"line = l;"
            , Doc
"column = c;"
            ]
        ]
    , Doc
"class BNFCErrorListener implements ANTLRErrorListener"
    , Int -> [Doc] -> Doc
codeblock Int
2 [ Doc
"@Override"
        , Doc
"public void syntaxError(Recognizer<?, ?> recognizer, Object o, int i"
            Doc -> Doc -> Doc
<> Doc
", int i1, String s, RecognitionException e)"
        , Int -> [Doc] -> Doc
codeblock Int
2 [ Doc
"throw new"Doc -> Doc -> Doc
<+>Doc
tedocDoc -> Doc -> Doc
<>Doc
"(s,i,i1);"]
        , Doc
"@Override"
        , Doc
"public void reportAmbiguity(Parser parser, DFA dfa, int i, int i1, "
            Doc -> Doc -> Doc
<>Doc
"boolean b, BitSet bitSet, ATNConfigSet atnConfigSet)"
        , Int -> [Doc] -> Doc
codeblock Int
2[ Doc
"throw new"Doc -> Doc -> Doc
<+>Doc
tedocDoc -> Doc -> Doc
<>Doc
"(\"Ambiguity at\",i,i1);" ]
        , Doc
"@Override"
        , Doc
"public void reportAttemptingFullContext(Parser parser, DFA dfa, "
            Doc -> Doc -> Doc
<>Doc
"int i, int i1, BitSet bitSet, ATNConfigSet atnConfigSet)"
        , Int -> [Doc] -> Doc
codeblock Int
2 []
        , Doc
"@Override"
        ,Doc
"public void reportContextSensitivity(Parser parser, DFA dfa, int i, "
            Doc -> Doc -> Doc
<>Doc
"int i1, int i2, ATNConfigSet atnConfigSet)"
        ,Int -> [Doc] -> Doc
codeblock Int
2 []
        ]
    ]
    where tedoc :: Doc
tedoc = String -> Doc
text String
te