--                            -*- Mode: Haskell -*- 
-- Copyright 1996 by Peter Thiemann
-- EbnfOutput.hs --- produce EBNF output for yacc/happy input
-- Initial revision
--
-- Last Modified By: M. Walter
--

module EbnfOutput (genEbnfFile) where

import Version
import AbstractSyntax
import GrammarUnfold  (GrammarInfo(..), 
                       getNonterminals, 
		       getTerminals, 
		       getProdsInfo, 
		       getReduces, 
		       getEmpties)

genEbnfFile :: String -> GrammarInfo -> String
genEbnfFile filename grammarInfo
    = (showsHeader .
       showsTerminals .
       showsNonterminals .
       showsUnfoldNonterminals .
       showsEmptyProds .
       showsProductions
      ) ""
    where
       outFileName  = filename ++ ".BNF"
       nonterminals = getNonterminals grammarInfo
       rnonterminals = getReduces grammarInfo
       terminals    = getTerminals grammarInfo
       emptyProds   = getEmpties grammarInfo
       prods        = getProdsInfo grammarInfo
       showsHeader =
	   comment "Ebnf Grammar for:" .
	   comment filename .
	   comment ("generated by Ebnf2ps Version " ++ version) .
	   comment "Ebnf2ps -- Automatic Railroad Diagram Drawing" .
	   comment "(C) Peter Thiemann, 1996" .
   	   comment "(thiemann@informatik.uni-tuebingen.de)" .
	   comment "Michael Walter" .
      	   comment "(walterm@informatik.uni-tuebingen.de)" .
	   strnewline

       showsTerminals =
	   commentHline .
	   comment "Terminals" .
	   commentHline .
	   interleave "" (map showTerminal terminals) .
	   strnewline

       showsNonterminals =
	   commentHline .
	   comment "Nonterminals" .
	   commentHline .
	   interleave "" (map showNonterminal nonterminals) .
	   strnewline

       showsUnfoldNonterminals = 
	   commentHline .
	   comment "Nonterminals [+unfold]" .
	   commentHline .
	   (if null rnonterminals 
	    then comment "\t<none>"
	    else interleave "" (map showNonterminal rnonterminals)) .
	   strnewline

       showsEmptyProds =
	   commentHline .
	   comment "Empty Productions" .
	   commentHline .
	   (if null emptyProds
	    then comment "\t<none>" 
	    else interleave "" (map showNonterminal emptyProds)) .
	   strnewline

       showsProductions =
	   commentHline .
	   comment "Productions" .
	   commentHline .
	   interleave "\n\n" (map showProduction prods) .
	   strnewline .
	   comment "End of file" .
	   comment outFileName 

       showProduction (ProdProduction nt ntAliases p) = showProdProduction nt ntAliases p 
       showProduction (ProdTerm ps) = showProdTerm ps
       showProduction (ProdFactor ps) = showProdFactor ps
       showProduction (ProdNonterminal nt) = str nt 
       showProduction (ProdTerminal t) = str "\"" . str (ebnfstr t) . str "\""
       showProduction (ProdOption p) = showProdOption p
       showProduction (ProdRepeat p) = showProdRepeat p
       showProduction (ProdRepeatWithAtom p1 p2) = showProdRepeatWithAtom p1 p2
       showProduction (ProdRepeat1 p) = showProdRepeat1 p
       showProduction ProdPlus = str " +"
       
       showProdOption p  = str "[" . showProduction p . str "]" 
       showProdRepeat p  = str "{" . showProduction p . str "}"
       showProdRepeat1 p = showProduction p . str " +" 
       showProdRepeatWithAtom p1 p2 = showProduction p1 . str "/ " . showProduction p2

       showProdProduction nt _ ProdEmpty = 
	   comment nt . 
	   comment "\t= <empty roduction>." 
       showProdProduction nt ntAliases (ProdTerm [p]) = 
	   comment nt .
	   strspace . strspace .
	   str nt .
	   strnewline .
	   strtab .
	   str "= " .
	   showProduction p . 
	   strnewline .
	   strtab .
	   str ";"
       showProdProduction nt ntAliases (ProdTerm ps) = 
	   comment nt .
	   strspace . strspace .
	   str nt .
	   strnewline .
	   strtab .
	   str "= " .
	   showTerms ps . 
	   strnewline .
	   strtab .
	   str ";" 
       showProdProduction nt ntAliases p = 
	   comment nt .
	   strspace . strspace . 
           str nt . 
	   strnewline .
	   strtab .
           str "= " . 
	   showProduction  p . 
	   strnewline .
	   strtab .
	   str ";"
 
       showTerminal t     = comment ('\t': t)
       showNonterminal nt = comment ('\t': nt)

       showTerms ts = interleave' "\t| " (map (\p -> showProduction p . strnewline) ts)

       showProdTerm [p] = showProduction p 
       showProdTerm ps  = str "(" . interleave' " | " (map showProduction ps) . str ")"

       showProdFactor [p] = showProduction p 
       showProdFactor ps  = interleave' " " (map showProduction ps) 


ebnfstr "" = ""
ebnfstr ('\\':cs) = '\\':'\\': ebnfstr cs
ebnfstr ('"':cs) = '\\':'"': ebnfstr cs
ebnfstr (c:cs)   = c: ebnfstr cs

str = showString
strspace = str " "
strnewline = str "\n"
strtab = str "\t"
interleave s = foldr (\a b -> a . str s . b) id
interleave' s = foldr1 (\a b -> a . str s . b) 
comment s = str "# " . str s . strnewline
commentHline = str "#----------------------------------------------------------------------\n"