BNFC-2.4.2.1: formats/f-sharp/FSharpTop.hs
{-
BNF Converter: F# main file
Copyright (C) 2005 Author: Kristofer Johannisson
Copyright (C) 2007 Author: 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, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
-- based on BNFC O'Caml backend
module FSharpTop (makeFSharp) where
import CF
import CFtoOCamlYacc
import CFtoOCamlLex
import CFtoLatex
import CFtoOCamlAbs
import CFtoOCamlTemplate
import CFtoOCamlPrinter
import CFtoOCamlShow
import CFtoOCamlTest
import CFtoXML
import GetCF
import Utils
import Data.Char
import Data.Maybe (fromMaybe,maybe)
import System.IO
import System.Exit
import Control.Monad(when)
-- naming conventions
noLang :: Options -> String -> String
noLang _ name = name
withLang :: Options -> String -> String
withLang opts name = name ++ lang opts
mkMod :: (Options -> String -> String) -> String -> Options -> String
mkMod addLang name opts =
pref ++ if inDir opts then lang opts ++ "." ++ name else addLang opts name
where pref = maybe "" (++".") (inPackage opts)
mkFile :: (Options -> String -> String) -> String -> String -> Options -> FilePath
mkFile addLang name ext opts =
pref ++ if inDir opts
then lang opts ++ [pathSep] ++ name ++ ext'
else addLang opts name ++ if null ext then "" else ext'
where pref = maybe "" (\p->pkgToDir p++[pathSep]) (inPackage opts)
ext' = if null ext then "" else "." ++ ext
absFile, absFileM, ocamllexFile, ocamllexFileM, dviFile,
ocamlyaccFile, ocamlyaccFileM,
latexFile, utilFile, utilFileM,
templateFile, templateFileM,
printerFile, printerFileM,
psFile, tFile, tFileM :: Options -> String
absFile = mkFile withLang "Abs" "ml"
absFileM = mkMod withLang "Abs"
ocamllexFile = mkFile withLang "Lex" "mll"
ocamllexFileM = mkMod withLang "Lex"
ocamlyaccFile = mkFile withLang "Par" "mly"
ocamlyaccFileM = mkMod withLang "Par"
latexFile = mkFile withLang "Doc" "tex"
templateFile = mkFile withLang "Skel" "ml"
templateFileM = mkMod withLang "Skel"
printerFile = mkFile withLang "Print" "ml"
printerFileM = mkMod withLang "Print"
showFile = mkFile withLang "Show" "ml"
showFileM = mkMod withLang "Show"
dviFile = mkFile withLang "Doc" "dvi"
psFile = mkFile withLang "Doc" "ps"
tFile = mkFile withLang "Test" "ml"
tFileM = mkMod withLang "Test"
utilFile = mkFile noLang "BNFC_Util" "ml"
utilFileM = mkMod noLang "BNFC_Util"
xmlFileM = mkMod withLang "XML"
data Options = Options
{
make :: Bool,
alex1 :: Bool,
inDir :: Bool,
shareStrings :: Bool,
xml :: Int,
inPackage :: Maybe String,
lang :: String
}
-- FIXME: we probably don't need all these arguments
makeFSharp :: Bool -> Bool -> Bool -> Bool -> Bool -> Int
-> Maybe String -- ^ The hierarchical package to put the modules
-- in, or Nothing.
-> String -> FilePath -> IO ()
makeFSharp m a1 d ss g x p n file = do
let opts = Options { make = m, alex1 = a1, inDir = d, shareStrings = ss,
xml = x, inPackage = p, lang = n }
absMod = absFileM opts
lexMod = ocamllexFileM opts
parMod = ocamlyaccFileM opts
prMod = printerFileM opts
showMod = showFileM opts
-- layMod = layoutFileM opts
utilMod = utilFileM opts
(cf, isOK) <- tryReadCF file
if isOK then do
let dir = codeDir opts
when (not (null dir)) $ do
putStrLn $ "Creating directory " ++ dir
prepareDir dir
writeFileRep (absFile opts) $ cf2Abstract absMod cf
writeFileRep (ocamllexFile opts) $ cf2ocamllex lexMod parMod cf
writeFileRep (ocamlyaccFile opts) $
cf2ocamlyacc parMod absMod lexMod cf
writeFileRep (latexFile opts) $ cfToLatex (lang opts) cf
writeFileRep (templateFile opts) $ cf2Template (templateFileM opts) absMod cf
writeFileRep (printerFile opts) $ cf2Printer prMod absMod cf
writeFileRep (showFile opts) $ cf2show showMod absMod cf
writeFileRep (tFile opts) $ ocamlTestfile absMod lexMod parMod prMod showMod cf
writeFileRep (utilFile opts) $ utilM
when (make opts) $ writeFileRep "Makefile" $ makefile opts
case xml opts of
2 -> makeXML (lang opts) True cf
1 -> makeXML (lang opts) False cf
_ -> return ()
putStrLn $ "Done!"
else do putStrLn $ "Failed!"
exitFailure
pkgToDir :: String -> FilePath
pkgToDir s = replace '.' pathSep s
codeDir :: Options -> FilePath
codeDir opts = let pref = maybe "" pkgToDir (inPackage opts)
dir = if inDir opts then lang opts else ""
sep = if null pref || null dir then "" else [pathSep]
in pref ++ sep ++ dir
makefile :: Options -> String
makefile opts = makeA where
dir = let d = codeDir opts in if null d then "" else d ++ [pathSep]
cd c = if null dir then c else "(cd " ++ dir ++ "; " ++ c ++ ")"
makeA = unlines
[
"all:",
"\tfsyacc " ++ ocamlyaccFile opts,
"\tfslex " ++ ocamllexFile opts,
"\t" ++ cd ("latex " ++ basename (latexFile opts)
++ "; " ++ "dvips " ++ basename (dviFile opts)
++ " -o " ++ basename (psFile opts)),
"\tfsc -o " ++ mkFile withLang "Test" "exe" opts +++
utilFile opts +++
absFile opts +++ templateFile opts +++
showFile opts +++ printerFile opts +++
mkFile withLang "Par" "mli" opts +++
mkFile withLang "Par" "ml" opts +++
mkFile withLang "Lex" "fs" opts +++
tFile opts,
"",
"clean:",
"\t-rm -f " ++ unwords (map (dir++) [
"*.log", "*.aux", "*.cmi",
"*.cmo", "*.o", "*.dvi"
]),
"\t-rm -f " ++ psFile opts,
"",
"distclean: clean",
"\t-rm -f " ++ unwords [
mkFile withLang "Doc" "*" opts,
mkFile withLang "Lex" "*" opts,
mkFile withLang "Par" "*" opts,
mkFile withLang "Layout" "*" opts,
mkFile withLang "Skel" "*" opts,
mkFile withLang "Print" "*" opts,
mkFile withLang "Show" "*" opts,
mkFile withLang "Test" "*" opts,
mkFile withLang "Abs" "*" opts,
mkFile withLang "Test" "" opts,
utilFile opts,
"Makefile*"
]
]
utilM :: String
utilM = unlines
["(* automatically generated by BNFC *)",
"",
"open Lexing",
"",
"(* this should really be in the parser, but ocamlyacc won't put it in the .mli *)",
"exception Parse_error of Lexing.position * Lexing.position"
]