module BNFC.Backend.OCaml.CFtoOCamlTemplate (
cf2Template
) where
import Data.Char
import BNFC.CF
import BNFC.Backend.OCaml.OCamlUtil
type ModuleName = String
type Constructor = String
cf2Template :: ModuleName -> ModuleName -> CF -> String
cf2Template :: [Char] -> [Char] -> CF -> [Char]
cf2Template [Char]
skelName [Char]
absName CF
cf = [[Char]] -> [Char]
unlines
[
[Char]
"module "forall a. [a] -> [a] -> [a]
++ [Char]
skelName forall a. [a] -> [a] -> [a]
++ [Char]
" = struct\n",
[Char]
"open " forall a. [a] -> [a] -> [a]
++ [Char]
absName forall a. [a] -> [a] -> [a]
++ [Char]
"\n",
[Char]
"type result = string\n",
[Char]
"let failure x = failwith \"Undefined case.\" (* x discarded *)\n",
[[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
mutualDefs forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Cat
s,[([Char], [Cat])]
xs) -> Cat -> [[Char]] -> [Char]
case_fun Cat
s ([([Char], [Cat])] -> [[Char]]
toArgs [([Char], [Cat])]
xs)) forall a b. (a -> b) -> a -> b
$ CF -> [(Cat, [([Char], [Cat])])]
specialData CF
cf forall a. [a] -> [a] -> [a]
++ CF -> [(Cat, [([Char], [Cat])])]
cf2data CF
cf,
[Char]
"end"
]
where toArgs :: [([Char], [Cat])] -> [[Char]]
toArgs [] = []
toArgs (([Char]
cons,[Cat]
args):[([Char], [Cat])]
xs)
= ([Char]
cons forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ ([[Char]] -> [Char]
mkTuple forall a b. (a -> b) -> a -> b
$ [[Char]] -> Int -> [[Char]]
names (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
checkRes forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> [Char]
var) [Cat]
args) (Int
0 :: Int))) forall a. a -> [a] -> [a]
: [([Char], [Cat])] -> [[Char]]
toArgs [([Char], [Cat])]
xs
names :: [String] -> Int -> [String]
names :: [[Char]] -> Int -> [[Char]]
names [] Int
_ = []
names ([Char]
x:[[Char]]
xs) Int
n
| forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
x [[Char]]
xs = ([Char]
x forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n) forall a. a -> [a] -> [a]
: [[Char]] -> Int -> [[Char]]
names [[Char]]
xs (Int
nforall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = [Char]
x forall a. a -> [a] -> [a]
: [[Char]] -> Int -> [[Char]]
names [[Char]]
xs Int
n
var :: Cat -> [Char]
var (ListCat Cat
c) = Cat -> [Char]
var Cat
c forall a. [a] -> [a] -> [a]
++ [Char]
"s"
var (Cat [Char]
"Ident") = [Char]
"id"
var (Cat [Char]
"Integer") = [Char]
"n"
var (Cat [Char]
"String") = [Char]
"str"
var (Cat [Char]
"Char") = [Char]
"c"
var (Cat [Char]
"Double") = [Char]
"d"
var Cat
cat = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Cat -> [Char]
catToStr Cat
cat)
checkRes :: [Char] -> [Char]
checkRes [Char]
s
| forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
s [[Char]]
reservedOCaml = [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"'"
| Bool
otherwise = [Char]
s
case_fun :: Cat -> [Constructor] -> String
case_fun :: Cat -> [[Char]] -> [Char]
case_fun Cat
cat [[Char]]
xs =
[[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$
[[Char]
"trans" forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
catToStr Cat
cat forall a. [a] -> [a] -> [a]
++ [Char]
" (x : " forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
fixType Cat
cat forall a. [a] -> [a] -> [a]
++ [Char]
") : result = match x with",
[[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
insertBar forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
s -> [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
" -> " forall a. [a] -> [a] -> [a]
++ [Char]
"failure x") [[Char]]
xs]