{-
    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.OCaml.OCamlUtil
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 :: SharedOptions -> [Char] -> [Char]
noLang SharedOptions
_ [Char]
name = [Char]
name

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

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

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

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


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

makeOCaml :: SharedOptions -> CF -> MkFiles ()
makeOCaml :: SharedOptions -> CF -> MkFiles ()
makeOCaml SharedOptions
opts CF
cf = do
  let absMod :: [Char]
absMod = SharedOptions -> [Char]
absFileM SharedOptions
opts
      lexMod :: [Char]
lexMod = SharedOptions -> [Char]
ocamllexFileM SharedOptions
opts
      parMod :: [Char]
parMod = SharedOptions -> [Char]
ocamlyaccFileM SharedOptions
opts
      prMod :: [Char]
prMod  = SharedOptions -> [Char]
printerFileM SharedOptions
opts
      showMod :: [Char]
showMod = SharedOptions -> [Char]
showFileM SharedOptions
opts
  do
    [Char] -> ([Char] -> [Char]) -> [Char] -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
absFile SharedOptions
opts)       [Char] -> [Char]
comment ([Char] -> MkFiles ()) -> [Char] -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ [Char] -> CF -> [Char]
cf2Abstract [Char]
absMod CF
cf
    [Char] -> ([Char] -> [Char]) -> [Char] -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
ocamllexFile SharedOptions
opts)  [Char] -> [Char]
comment ([Char] -> MkFiles ()) -> [Char] -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CF -> [Char]
cf2ocamllex [Char]
lexMod [Char]
parMod CF
cf
    [Char] -> ([Char] -> [Char]) -> [Char] -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
ocamlyaccFile SharedOptions
opts) [Char] -> [Char]
C.comment ([Char] -> MkFiles ()) -> [Char] -> MkFiles ()
forall a b. (a -> b) -> a -> b
$
      OCamlParser -> [Char] -> CF -> [Char]
cf2ocamlyacc (SharedOptions -> OCamlParser
ocamlParser SharedOptions
opts) [Char]
absMod CF
cf
    [Char] -> ([Char] -> [Char]) -> [Char] -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
templateFile SharedOptions
opts)  [Char] -> [Char]
comment ([Char] -> MkFiles ()) -> [Char] -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CF -> [Char]
cf2Template (SharedOptions -> [Char]
templateFileM SharedOptions
opts) [Char]
absMod CF
cf
    [Char] -> ([Char] -> [Char]) -> [Char] -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
printerFile SharedOptions
opts)   [Char] -> [Char]
comment ([Char] -> MkFiles ()) -> [Char] -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CF -> [Char]
cf2Printer [Char]
prMod [Char]
absMod CF
cf
    [Char] -> ([Char] -> [Char]) -> [Char] -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
showFile SharedOptions
opts)      [Char] -> [Char]
comment ([Char] -> MkFiles ()) -> [Char] -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> CF -> [Char]
cf2show [Char]
showMod [Char]
absMod CF
cf
    [Char] -> ([Char] -> [Char]) -> Doc -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
tFile SharedOptions
opts)         [Char] -> [Char]
comment (Doc -> MkFiles ()) -> Doc -> MkFiles ()
forall a b. (a -> b) -> a -> b
$
      OCamlParser
-> [Char] -> [Char] -> [Char] -> [Char] -> [Char] -> CF -> Doc
ocamlTestfile (SharedOptions -> OCamlParser
ocamlParser SharedOptions
opts) [Char]
absMod [Char]
lexMod [Char]
parMod [Char]
prMod [Char]
showMod CF
cf
    [Char] -> ([Char] -> [Char]) -> [Char] -> MkFiles ()
forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile (SharedOptions -> [Char]
utilFile SharedOptions
opts)      [Char] -> [Char]
comment ([Char] -> MkFiles ()) -> [Char] -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ [Char]
utilM
    Maybe [Char] -> ([Char] -> Doc) -> MkFiles ()
mkMakefile (SharedOptions -> Maybe [Char]
optMake SharedOptions
opts) (([Char] -> Doc) -> MkFiles ()) -> ([Char] -> Doc) -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ SharedOptions -> [Char] -> 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 a. a -> WriterT [GeneratedFile] IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

comment :: String -> String
comment :: [Char] -> [Char]
comment [Char]
x = [[Char]] -> [Char]
unwords [ [Char]
"(*", [Char]
x, [Char]
"*)" ]

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

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

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

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