{-
    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 hiding (Backend)
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
import BNFC.Backend.OCaml.CFtoOCamlYacc
import BNFC.Backend.XML
import BNFC.CF
import BNFC.Options
import BNFC.PrettyPrint
import BNFC.Utils

-- naming conventions

noLang :: SharedOptions -> String -> String
noLang :: SharedOptions -> String -> String
noLang SharedOptions
_ String
name = String
name

withLang :: SharedOptions -> String -> String
withLang :: SharedOptions -> String -> String
withLang SharedOptions
opts String
name = String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ SharedOptions -> String
sanitizedLang SharedOptions
opts

mkMod :: (SharedOptions -> String -> String) -> String -> SharedOptions -> String
mkMod :: (SharedOptions -> String -> String)
-> String -> SharedOptions -> String
mkMod SharedOptions -> String -> String
addLang String
name SharedOptions
opts =
    String
pref String -> String -> String
forall a. [a] -> [a] -> [a]
++ if SharedOptions -> Bool
inDir SharedOptions
opts then SharedOptions -> String
sanitizedLang SharedOptions
opts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name else SharedOptions -> String -> String
addLang SharedOptions
opts String
name
        where pref :: String
pref = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
".") (SharedOptions -> Maybe String
inPackage SharedOptions
opts)

mkFile :: (SharedOptions -> String -> String) -> String -> String -> SharedOptions -> FilePath
mkFile :: (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
addLang String
name String
ext SharedOptions
opts =
    String
pref String -> String -> String
forall a. [a] -> [a] -> [a]
++ if SharedOptions -> Bool
inDir SharedOptions
opts
       then SharedOptions -> String
sanitizedLang SharedOptions
opts String -> String -> String
</> String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ext'
       else SharedOptions -> String -> String
addLang SharedOptions
opts String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ext then String
"" else String
ext'
    where pref :: String
pref = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\ String
p -> String -> String
pkgToDir String
p String -> String -> String
</> String
"") (SharedOptions -> Maybe String
inPackage SharedOptions
opts)
          ext' :: String
ext' = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ext then String
"" else String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ext

-- | Turn language name into a valid ocaml module identifier.
sanitizedLang :: SharedOptions -> String
sanitizedLang :: SharedOptions -> String
sanitizedLang = String -> String
camelCase_ (String -> String)
-> (SharedOptions -> String) -> SharedOptions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedOptions -> String
lang


absFile, absFileM, ocamllexFile, ocamllexFileM, ocamlyaccFile, ocamlyaccFileM,
  utilFile, templateFile, templateFileM, printerFile, printerFileM,
  tFile :: SharedOptions -> String
absFile :: SharedOptions -> String
absFile       = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Abs" String
"ml"
absFileM :: SharedOptions -> String
absFileM      = (SharedOptions -> String -> String)
-> String -> SharedOptions -> String
mkMod  SharedOptions -> String -> String
withLang String
"Abs"
ocamllexFile :: SharedOptions -> String
ocamllexFile      = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Lex" String
"mll"
ocamllexFileM :: SharedOptions -> String
ocamllexFileM     = (SharedOptions -> String -> String)
-> String -> SharedOptions -> String
mkMod  SharedOptions -> String -> String
withLang String
"Lex"
ocamlyaccFile :: SharedOptions -> String
ocamlyaccFile     = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Par" String
"mly"
ocamlyaccFileM :: SharedOptions -> String
ocamlyaccFileM    = (SharedOptions -> String -> String)
-> String -> SharedOptions -> String
mkMod  SharedOptions -> String -> String
withLang String
"Par"
templateFile :: SharedOptions -> String
templateFile  = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Skel" String
"ml"
templateFileM :: SharedOptions -> String
templateFileM = (SharedOptions -> String -> String)
-> String -> SharedOptions -> String
mkMod  SharedOptions -> String -> String
withLang String
"Skel"
printerFile :: SharedOptions -> String
printerFile   = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Print" String
"ml"
printerFileM :: SharedOptions -> String
printerFileM  = (SharedOptions -> String -> String)
-> String -> SharedOptions -> String
mkMod  SharedOptions -> String -> String
withLang String
"Print"
showFile :: SharedOptions -> String
showFile      = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile  SharedOptions -> String -> String
withLang String
"Show" String
"ml"
showFileM :: SharedOptions -> String
showFileM     = (SharedOptions -> String -> String)
-> String -> SharedOptions -> String
mkMod  SharedOptions -> String -> String
withLang String
"Show"
tFile :: SharedOptions -> String
tFile         = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Test" String
"ml"
utilFile :: SharedOptions -> String
utilFile       = (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
noLang   String
"BNFC_Util" String
"ml"

makeOCaml :: SharedOptions -> CF -> MkFiles ()
makeOCaml :: SharedOptions -> CF -> MkFiles ()
makeOCaml SharedOptions
opts CF
cf = do
  let absMod :: String
absMod = SharedOptions -> String
absFileM SharedOptions
opts
      lexMod :: String
lexMod = SharedOptions -> String
ocamllexFileM SharedOptions
opts
      parMod :: String
parMod = SharedOptions -> String
ocamlyaccFileM SharedOptions
opts
      prMod :: String
prMod  = SharedOptions -> String
printerFileM SharedOptions
opts
      showMod :: String
showMod = SharedOptions -> String
showFileM SharedOptions
opts
  do
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
absFile SharedOptions
opts) (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> CF -> String
cf2Abstract String
absMod CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
ocamllexFile SharedOptions
opts) (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> String
cf2ocamllex String
lexMod String
parMod CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
ocamlyaccFile SharedOptions
opts) (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$
                 String -> String -> String -> CF -> String
cf2ocamlyacc String
parMod String
absMod String
lexMod  CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
templateFile SharedOptions
opts) (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> String
cf2Template (SharedOptions -> String
templateFileM SharedOptions
opts) String
absMod CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
printerFile SharedOptions
opts)  (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> String
cf2Printer String
prMod String
absMod CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
showFile SharedOptions
opts)  (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> String
cf2show String
showMod String
absMod CF
cf
    String -> Doc -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
tFile SharedOptions
opts) (Doc -> MkFiles ()) -> Doc -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> CF -> Doc
ocamlTestfile String
absMod String
lexMod String
parMod String
prMod String
showMod CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (SharedOptions -> String
utilFile SharedOptions
opts) String
utilM
    SharedOptions -> (String -> Doc) -> MkFiles ()
mkMakefile SharedOptions
opts ((String -> Doc) -> MkFiles ()) -> (String -> Doc) -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ SharedOptions -> String -> Doc
makefile SharedOptions
opts
    case SharedOptions -> Int
xml SharedOptions
opts of
      Int
2 -> SharedOptions -> Bool -> CF -> MkFiles ()
makeXML SharedOptions
opts Bool
True CF
cf
      Int
1 -> SharedOptions -> Bool -> CF -> MkFiles ()
makeXML SharedOptions
opts Bool
False CF
cf
      Int
_ -> () -> MkFiles ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

pkgToDir :: String -> FilePath
pkgToDir :: String -> String
pkgToDir = Char -> Char -> String -> String
forall a. Eq a => a -> a -> [a] -> [a]
replace Char
'.' Char
pathSeparator

codeDir :: SharedOptions -> FilePath
codeDir :: SharedOptions -> String
codeDir SharedOptions
opts = let pref :: String
pref = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" String -> String
pkgToDir (SharedOptions -> Maybe String
inPackage SharedOptions
opts)
                   dir :: String
dir = if SharedOptions -> Bool
inDir SharedOptions
opts then SharedOptions -> String
sanitizedLang SharedOptions
opts else String
""
                   sep :: String
sep = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pref Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir then String
"" else [Char
pathSeparator]
                 in String
pref String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir

makefile :: SharedOptions -> String -> Doc
makefile :: SharedOptions -> String -> Doc
makefile SharedOptions
opts String
basename = [Doc] -> Doc
vcat
    [ String -> String -> Doc
mkVar String
"OCAMLC" String
"ocamlc"
    , String -> String -> Doc
mkVar String
"OCAMLYACC" (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ case SharedOptions -> OCamlParser
ocamlParser SharedOptions
opts of
        OCamlParser
OCamlYacc -> String
"ocamlyacc"
        OCamlParser
Menhir    -> String
"menhir"
    , String -> String -> Doc
mkVar String
"OCAMLLEX" String
"ocamllex"
    , String -> String -> Doc
mkVar String
"OCAMLCFLAGS" String
""
    , String -> [String] -> [String] -> Doc
mkRule String
"all" []
        [ String
"$(OCAMLYACC) " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SharedOptions -> String
ocamlyaccFile SharedOptions
opts
        , String
"$(OCAMLLEX) "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ SharedOptions -> String
ocamllexFile SharedOptions
opts
        , String
"$(OCAMLC) $(OCAMLCFLAGS) -o " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Test" String
"" SharedOptions
opts String -> String -> String
+++
                          SharedOptions -> String
utilFile SharedOptions
opts String -> String -> String
+++
                          SharedOptions -> String
absFile SharedOptions
opts String -> String -> String
+++ SharedOptions -> String
templateFile SharedOptions
opts String -> String -> String
+++
                          SharedOptions -> String
showFile SharedOptions
opts String -> String -> String
+++ SharedOptions -> String
printerFile SharedOptions
opts String -> String -> String
+++
                          (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Par" String
"mli" SharedOptions
opts String -> String -> String
+++
                          (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Par" String
"ml" SharedOptions
opts String -> String -> String
+++
                          (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Lex" String
"ml" SharedOptions
opts String -> String -> String
+++
                          SharedOptions -> String
tFile SharedOptions
opts ]
    , String -> [String] -> [String] -> Doc
mkRule String
"clean" []
        [ 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
dirString -> String -> String
forall a. [a] -> [a] -> [a]
++) [ String
"*.cmi", String
"*.cmo", String
"*.o" ]) ]
    , String -> [String] -> [String] -> Doc
mkRule String
"distclean" [String
"clean"]
        [ String
"-rm -f " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [ (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Lex" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Par" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Layout" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Skel" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Print" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Show" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Test" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Abs" String
"*" SharedOptions
opts,
                                 (SharedOptions -> String -> String)
-> String -> String -> SharedOptions -> String
mkFile SharedOptions -> String -> String
withLang String
"Test" String
"" SharedOptions
opts,
                                 SharedOptions -> String
utilFile SharedOptions
opts,
                                 String
basename ]]
    ]
  where dir :: String
dir = let d :: String
d = SharedOptions -> String
codeDir SharedOptions
opts in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
d then String
"" else String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]

utilM :: String
utilM :: String
utilM = [String] -> String
unlines
    [String
"(* automatically generated by BNFC *)",
     String
"",
     String
"open Lexing",
     String
"",
     String
"(* this should really be in the parser, but ocamlyacc won't put it in the .mli *)",
     String
"exception Parse_error of Lexing.position * Lexing.position"
    ]