{-
    BNF Converter: Latex Generator
    Copyright (C) 2004  Author:  Markus Forsberg, Aarne Ranta

-}

module BNFC.Backend.Txt2Tag (cfToTxt)where

import BNFC.CF
import BNFC.Abs (Reg (..))
import BNFC.Utils
import Data.List

cfToTxt :: String -> CF -> String
cfToTxt :: String -> CF -> String
cfToTxt String
name CF
cf = [String] -> String
unlines [
                            String -> String
beginDocument String
name,
                            String
introduction,
                            String -> CF -> String
prtTerminals String
name CF
cf,
                            String -> CF -> String
prtBNF String
name CF
cf
                            ]

introduction :: String
introduction :: String
introduction = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
               [
               String
"\nThis document was automatically generated by ",
               String
"the //BNF-Converter//.",
               String
" It was generated together with the lexer, the parser, and the",
               String
" abstract syntax module, which guarantees that the document",
               String
" matches with the implementation of the language (provided no",
               String
" hand-hacking has taken place).\n"
               ]

prtTerminals :: String -> CF -> String
prtTerminals :: String -> CF -> String
prtTerminals String
name CF
cf = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
  [ String
"==The lexical structure of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=="
  , CF -> String
forall f. CFG f -> String
identSection CF
cf
  , String
"===Literals==="
  , CF -> String
prtLiterals CF
cf
  , [String] -> String
unlines (((String, Reg) -> String) -> [(String, Reg)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Reg) -> String
prtOwnToken (CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf))
  , String
"===Reserved words and symbols==="
  , String -> CF -> String
prtReserved String
name CF
cf
  , String -> CF -> String
prtSymb String
name CF
cf
  , String
"===Comments==="
  , ([(String, String)], [String]) -> String
prtComments (([(String, String)], [String]) -> String)
-> ([(String, String)], [String]) -> String
forall a b. (a -> b) -> a -> b
$ CF -> ([(String, String)], [String])
comments CF
cf
  ]

identSection :: CFG f -> String
identSection CFG f
cf = if Bool -> Bool
not (CFG f -> Bool
forall f. CFG f -> Bool
hasIdent CFG f
cf) then [] else
                    [String] -> String
unlines [
                               String
"===Identifiers===",
                               String
prtIdentifiers
                          ]

prtIdentifiers :: String
prtIdentifiers :: String
prtIdentifiers = [String] -> String
unlines
  [
   String
"Identifiers //Ident// are unquoted strings beginning with a letter,",
   String
"followed by any combination of letters, digits, and the characters ``_ '``",
   String
"reserved words excluded."
  ]

prtLiterals :: CF -> String
prtLiterals :: CF -> String
prtLiterals CF
cf =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
stringLit ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
    (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
catIdent) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ CF -> [String]
forall f. CFG f -> [String]
literals CF
cf

stringLit :: TokenCat -> String
stringLit :: String -> String
stringLit = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  String
"Char" -> [String
"Character literals //Char// have the form",
             String
"``'``//c//``'``, where //c// is any single character.",
             String
""
            ]
  String
"String" -> [String
"String literals //String// have the form",
             String
"``\"``//x//``\"``}, where //x// is any sequence of any characters",
             String
"except ``\"`` unless preceded by ``\\``.",
             String
""]
  String
"Integer" -> [String
"Integer literals //Integer// are nonempty sequences of digits.",
             String
""]
  String
"Double" -> [String
"Double-precision float literals //Double// have the structure",
               String
"indicated by the regular expression" String -> String -> String
+++
               String
"``digit+ '.' digit+ ('e' ('-')? digit+)?`` i.e.\\",
               String
"two sequences of digits separated by a decimal point, optionally",
               String
"followed by an unsigned or negative exponent.",
               String
""]
  String
_ -> []

prtOwnToken :: (String, Reg) -> String
prtOwnToken (String
name,Reg
reg) = [String] -> String
unlines
  [String
name String -> String -> String
+++ String
"literals are recognized by the regular expression",
   String
"```" String -> String -> String
forall a. [a] -> [a] -> [a]
++
   Reg -> String
latexRegExp Reg
reg String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
"```"
  ]

prtComments :: ([(String,String)],[String]) -> String
prtComments :: ([(String, String)], [String]) -> String
prtComments ([(String, String)]
xs,[String]
ys) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                   [
                   if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ys then
                    String
"There are no single-line comments in the grammar."
                   else
                    String
"Single-line comments begin with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sing String -> String -> String
forall a. [a] -> [a] -> [a]
++String
".",
                   if [(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
xs then
                    String
"There are no multiple-line comments in the grammar."
                   else
                   String
"Multiple-line comments are  enclosed with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mult String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"."
                   ]
 where
 sing :: String
sing = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
symbol(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
prt) [String]
ys
 mult :: String
mult = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
         ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x,String
y) -> String -> String
symbol (String -> String
prt String
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
symbol (String -> String
prt String
y)) [(String, String)]
xs

prtSymb :: String -> CF -> String
prtSymb :: String -> CF -> String
prtSymb String
name CF
cf = case CF -> [String]
forall f. CFG f -> [String]
cfgSymbols CF
cf of
                   [] -> String
"\nThere are no symbols in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".\n"
                   [String]
xs -> String
"The symbols used in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" are the following:\n"
                         String -> String -> String
forall a. [a] -> [a] -> [a]
++
                         Int -> [[String]] -> String
tabular Int
4 ([String] -> [[String]]
three ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
symbol(String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> String
prt) [String]
xs)

prtReserved :: String -> CF -> String
prtReserved :: String -> CF -> String
prtReserved String
name CF
cf = case CF -> [String]
forall f. CFG f -> [String]
reservedWords CF
cf of
                       [] -> String -> String
stringRes String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             String
"\nThere are no reserved words in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".\n"
                       [String]
xs -> String -> String
stringRes String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++
                             Int -> [[String]] -> String
tabular Int
4 ([String] -> [[String]]
three ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quote [String]
xs)

stringRes :: String -> String
stringRes :: String -> String
stringRes String
name = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                 [String
"The set of reserved words is the set of terminals ",
                  String
"appearing in the grammar. Those reserved words ",
                  String
"that consist of non-letter characters are called symbols, and ",
                  String
"they are treated in a different way from those that ",
                  String
"are similar to identifiers. The lexer ",
                  String
"follows rules familiar from languages ",
                  String
"like Haskell, C, and Java, including longest match ",
                  String
"and spacing conventions.",
                  String
"\n\n",
                  String
"The reserved words used in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" are the following:\n"]

three :: [String] -> [[String]]
three :: [String] -> [[String]]
three []         = []
three [String
x]        = [[String
x,[],[],[]]]
three [String
x,String
y]      = [[String
x,String
y,[],[]]]
three [String
x,String
y,String
z]      = [[String
x,String
y,String
z,[]]]
three (String
x:String
y:String
z:String
u:[String]
xs) = [String
x,String
y,String
z,String
u] [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [String] -> [[String]]
three [String]
xs

prtBNF :: String -> CF -> String
prtBNF :: String -> CF -> String
prtBNF String
name CF
cf = [String] -> String
unlines [
                     String
"==The syntactic structure of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"==",
                     String
"Non-terminals are enclosed between < and >. ",
                     String
"The symbols " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
arrow String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (production), " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                      String
delimiter String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" (union) ",
                     String
"and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
empty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (empty rule) belong to the BNF notation. ",
                     String
"All other symbols are terminals.",
                     String
"",
                     [(Cat, [Rule])] -> String
prtRules (CF -> [(Cat, [Rule])]
ruleGroups CF
cf)
                     ]

prtRules :: [(Cat,[Rule])] -> String
prtRules :: [(Cat, [Rule])] -> String
prtRules          [] = []
prtRules ((Cat
c,[]):[(Cat, [Rule])]
xs)
    = Int -> [[String]] -> String
tabular Int
3 [[Cat -> String
nonterminal Cat
c,String
arrow,[]]] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(Cat, [Rule])] -> String
prtRules [(Cat, [Rule])]
xs
prtRules ((Cat
c, Rule
r : [Rule]
rs) : [(Cat, [Rule])]
xs)
    = Int -> [[String]] -> String
tabular Int
3 ([[Cat -> String
nonterminal Cat
c,String
arrow,[Either Cat String] -> String
prtSymbols ([Either Cat String] -> String) -> [Either Cat String] -> String
forall a b. (a -> b) -> a -> b
$ Rule -> [Either Cat String]
forall function. Rul function -> [Either Cat String]
rhsRule Rule
r]] [[String]] -> [[String]] -> [[String]]
forall a. [a] -> [a] -> [a]
++
                 [[[],String
delimiter,[Either Cat String] -> String
prtSymbols (Rule -> [Either Cat String]
forall function. Rul function -> [Either Cat String]
rhsRule Rule
y)] | Rule
y <-  [Rule]
rs]) String -> String -> String
forall a. [a] -> [a] -> [a]
++
    ---  "\n\n" ++ --- with empty lines good for latex, bad for html
      [(Cat, [Rule])] -> String
prtRules [(Cat, [Rule])]
xs

prtSymbols :: [Either Cat String] -> String
prtSymbols :: [Either Cat String] -> String
prtSymbols [] = String
empty
prtSymbols [Either Cat String]
xs = (Either Cat String -> String -> String)
-> String -> [Either Cat String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (String -> String -> String
(+++) (String -> String -> String)
-> (Either Cat String -> String)
-> Either Cat String
-> String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either Cat String -> String
p) [] [Either Cat String]
xs
 where p :: Either Cat String -> String
p (Left  Cat
r) = Cat -> String
nonterminal Cat
r
       p (Right String
r) = String -> String
terminal String
r

prt :: String -> String
prt :: String -> String
prt String
s = String
s

empty :: String
empty :: String
empty = String
"**eps**"

symbol :: String -> String
symbol :: String -> String
symbol String
s = String
s

tabular :: Int -> [[String]] -> String
tabular :: Int -> [[String]] -> String
tabular Int
_ [[String]]
xs = [String] -> String
unlines [[String] -> String
unwords (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"|" (String
" " String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
x)) | [String]
x <- [[String]]
xs]

terminal :: String -> String
terminal :: String -> String
terminal String
s = String
"``" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"``"

nonterminal :: Cat -> String
nonterminal :: Cat -> String
nonterminal Cat
s = String
"//" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
forall a. Show a => a -> String
show Cat
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"//"

arrow :: String
arrow :: String
arrow = String
"->"

delimiter :: String
delimiter :: String
delimiter = String
" **|** "

beginDocument :: String -> String
beginDocument :: String -> String
beginDocument String
name = [String] -> String
unlines [
 String
"The Language " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name,
 String
"BNF Converter",
 String
"",
 String
"",
 String
"%This txt2tags file is machine-generated by the BNF-converter",
 String
"%Process by txt2tags to generate html or latex",
 String
""
 ]

latexRegExp :: Reg -> String
latexRegExp :: Reg -> String
latexRegExp = String -> String
quote (String -> String) -> (Reg -> String) -> Reg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reg -> String
forall t. (Ord t, Num t) => t -> Reg -> String
rex (Int
0 :: Int) where
  rex :: t -> Reg -> String
rex t
i Reg
e = case Reg
e of
    RSeq Reg
reg0 Reg
reg  -> t -> t -> String -> String
forall a. Ord a => a -> a -> String -> String
ifPar t
i t
2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> Reg -> String
rex t
2 Reg
reg0 String -> String -> String
+++ t -> Reg -> String
rex t
2 Reg
reg
    RAlt Reg
reg0 Reg
reg  -> t -> t -> String -> String
forall a. Ord a => a -> a -> String -> String
ifPar t
i t
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> Reg -> String
rex t
1 Reg
reg0 String -> String -> String
+++ String
"|" String -> String -> String
+++ t -> Reg -> String
rex t
1 Reg
reg
    RMinus Reg
reg0 Reg
reg  -> t -> t -> String -> String
forall a. Ord a => a -> a -> String -> String
ifPar t
i t
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ t -> Reg -> String
rex t
2 Reg
reg0 String -> String -> String
+++ String
"-" String -> String -> String
+++ t -> Reg -> String
rex t
2 Reg
reg
    RStar Reg
reg  -> t -> Reg -> String
rex t
3 Reg
reg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*"
    RPlus Reg
reg  -> t -> Reg -> String
rex t
3 Reg
reg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+"
    ROpt Reg
reg  -> t -> Reg -> String
rex t
3 Reg
reg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?"
    Reg
REps  -> String
"eps"
    RChar Char
c  -> String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
    RAlts String
str  -> String
"[\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"]"
    RSeqs String
str  -> String
"{\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"}"
    Reg
RDigit  -> String
"digit"
    Reg
RLetter  -> String
"letter"
    Reg
RUpper  -> String
"upper"
    Reg
RLower  -> String
"lower"
    Reg
RAny  -> String
"char"
  ifPar :: a -> a -> String -> String
ifPar a
i a
j String
s = if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
j then String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")" else String
s

quote :: String -> String
quote String
s = String
"``" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"``"