{-
    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 -> 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,
  showFile, showFileM,
  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 -> String) -> String -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
absFile SharedOptions
opts)       String -> String
comment (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> CF -> String
cf2Abstract String
absMod CF
cf
    String -> (String -> String) -> String -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
ocamllexFile SharedOptions
opts)  String -> String
comment (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> String
cf2ocamllex String
lexMod String
parMod CF
cf
    String -> (String -> String) -> String -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
ocamlyaccFile SharedOptions
opts) String -> String
C.comment (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$
      OCamlParser -> String -> CF -> String
cf2ocamlyacc (SharedOptions -> OCamlParser
ocamlParser SharedOptions
opts) String
absMod CF
cf
    String -> (String -> String) -> String -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
templateFile SharedOptions
opts)  String -> String
comment (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 -> String) -> String -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
printerFile SharedOptions
opts)   String -> String
comment (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> String
cf2Printer String
prMod String
absMod CF
cf
    String -> (String -> String) -> String -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
showFile SharedOptions
opts)      String -> String
comment (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> CF -> String
cf2show String
showMod String
absMod CF
cf
    String -> (String -> String) -> Doc -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
tFile SharedOptions
opts)         String -> String
comment (Doc -> MkFiles ()) -> Doc -> MkFiles ()
forall a b. (a -> b) -> a -> b
$
      OCamlParser
-> String -> String -> String -> String -> String -> CF -> Doc
ocamlTestfile (SharedOptions -> OCamlParser
ocamlParser SharedOptions
opts) String
absMod String
lexMod String
parMod String
prMod String
showMod CF
cf
    String -> (String -> String) -> String -> MkFiles ()
forall c.
FileContent c =>
String -> (String -> String) -> c -> MkFiles ()
mkfile (SharedOptions -> String
utilFile SharedOptions
opts)      String -> String
comment (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ 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 ()

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

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
$ SharedOptions -> String
forall a. OCamlParserName a => a -> String
ocamlParserName SharedOptions
opts
    , 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
"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"
    ]