{- BNF Converter: OCaml main file Copyright (C) 2005 Author: Kristofer Johannisson -} -- based on BNFC Haskell backend module BNFC.Backend.OCaml (makeOCaml) where import System.FilePath (pathSeparator, ()) import BNFC.Backend.Base (MkFiles, mkfile) import BNFC.Backend.Common.Makefile import BNFC.Backend.OCaml.CFtoOCamlAbs import BNFC.Backend.OCaml.CFtoOCamlLex import BNFC.Backend.OCaml.CFtoOCamlPrinter import BNFC.Backend.OCaml.CFtoOCamlShow import BNFC.Backend.OCaml.CFtoOCamlTemplate import BNFC.Backend.OCaml.CFtoOCamlTest (ocamlTestfile) import BNFC.Backend.OCaml.CFtoOCamlYacc import BNFC.Backend.XML (makeXML) import BNFC.CF import BNFC.Options import BNFC.PrettyPrint import BNFC.Utils import qualified BNFC.Backend.C as C -- naming conventions noLang :: SharedOptions -> String -> String noLang _ name = name withLang :: SharedOptions -> String -> String withLang opts name = name ++ sanitizedLang opts mkMod :: (SharedOptions -> String -> String) -> String -> SharedOptions -> String mkMod addLang name opts = pref ++ if inDir opts then sanitizedLang opts ++ "." ++ name else addLang opts name where pref = maybe "" (++".") (inPackage opts) mkFile :: (SharedOptions -> String -> String) -> String -> String -> SharedOptions -> FilePath mkFile addLang name ext opts = pref ++ if inDir opts then sanitizedLang opts name ++ ext' else addLang opts name ++ if null ext then "" else ext' where pref = maybe "" (\ p -> pkgToDir p "") (inPackage opts) ext' = if null ext then "" else "." ++ ext -- | Turn language name into a valid ocaml module identifier. sanitizedLang :: SharedOptions -> String sanitizedLang = camelCase_ . lang absFile, absFileM, ocamllexFile, ocamllexFileM, ocamlyaccFile, ocamlyaccFileM, utilFile, templateFile, templateFileM, printerFile, printerFileM, tFile :: SharedOptions -> 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" 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" tFile = mkFile withLang "Test" "ml" utilFile = mkFile noLang "BNFC_Util" "ml" makeOCaml :: SharedOptions -> CF -> MkFiles () makeOCaml opts cf = do let absMod = absFileM opts lexMod = ocamllexFileM opts parMod = ocamlyaccFileM opts prMod = printerFileM opts showMod = showFileM opts do mkfile (absFile opts) comment $ cf2Abstract absMod cf mkfile (ocamllexFile opts) comment $ cf2ocamllex lexMod parMod cf mkfile (ocamlyaccFile opts) C.comment $ cf2ocamlyacc (ocamlParser opts) parMod absMod lexMod cf mkfile (templateFile opts) comment $ cf2Template (templateFileM opts) absMod cf mkfile (printerFile opts) comment $ cf2Printer prMod absMod cf mkfile (showFile opts) comment $ cf2show showMod absMod cf mkfile (tFile opts) comment $ ocamlTestfile absMod lexMod parMod prMod showMod cf mkfile (utilFile opts) comment $ utilM mkMakefile opts $ makefile opts case xml opts of 2 -> makeXML opts True cf 1 -> makeXML opts False cf _ -> return () comment :: String -> String comment x = unwords [ "(*", x, "*)" ] pkgToDir :: String -> FilePath pkgToDir = replace '.' pathSeparator codeDir :: SharedOptions -> FilePath codeDir opts = let pref = maybe "" pkgToDir (inPackage opts) dir = if inDir opts then sanitizedLang opts else "" sep = if null pref || null dir then "" else [pathSeparator] in pref ++ sep ++ dir makefile :: SharedOptions -> String -> Doc makefile opts basename = vcat [ mkVar "OCAMLC" "ocamlc" , mkVar "OCAMLYACC" $ case ocamlParser opts of OCamlYacc -> "ocamlyacc" Menhir -> "menhir" , mkVar "OCAMLLEX" "ocamllex" , mkVar "OCAMLCFLAGS" "" , mkRule "all" [] [ "$(OCAMLYACC) " ++ ocamlyaccFile opts , "$(OCAMLLEX) " ++ ocamllexFile opts , "$(OCAMLC) $(OCAMLCFLAGS) -o " ++ mkFile withLang "Test" "" opts +++ utilFile opts +++ absFile opts +++ templateFile opts +++ showFile opts +++ printerFile opts +++ mkFile withLang "Par" "mli" opts +++ mkFile withLang "Par" "ml" opts +++ mkFile withLang "Lex" "ml" opts +++ tFile opts ] , mkRule "clean" [] [ "-rm -f " ++ unwords (map (dir++) [ "*.cmi", "*.cmo", "*.o" ]) ] , mkRule "distclean" ["clean"] [ "-rm -f " ++ unwords [ 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, basename ]] ] where dir = let d = codeDir opts in if null d then "" else d ++ [pathSeparator] utilM :: String utilM = unlines ["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" ]