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 "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
skelName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = struct\n",
[Char]
"open " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
absName [Char] -> [Char] -> [Char]
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 ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
mutualDefs ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ((Cat, [([Char], [Cat])]) -> [Char])
-> [(Cat, [([Char], [Cat])])] -> [[Char]]
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)) ([(Cat, [([Char], [Cat])])] -> [[Char]])
-> [(Cat, [([Char], [Cat])])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CF -> [(Cat, [([Char], [Cat])])]
specialData CF
cf [(Cat, [([Char], [Cat])])]
-> [(Cat, [([Char], [Cat])])] -> [(Cat, [([Char], [Cat])])]
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 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([[Char]] -> [Char]
mkTuple ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> Int -> [[Char]]
names ((Cat -> [Char]) -> [Cat] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
checkRes ([Char] -> [Char]) -> (Cat -> [Char]) -> Cat -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cat -> [Char]
var) [Cat]
args) (Int
0 :: Int))) [Char] -> [[Char]] -> [[Char]]
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
| [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
x [[Char]]
xs = ([Char]
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> Int -> [[Char]]
names [[Char]]
xs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = [Char]
x [Char] -> [[Char]] -> [[Char]]
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 [Char] -> [Char] -> [Char]
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 = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Cat -> [Char]
catToStr Cat
cat)
checkRes :: [Char] -> [Char]
checkRes [Char]
s
| [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Char]
s [[Char]]
reservedOCaml = [Char]
s [Char] -> [Char] -> [Char]
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 ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
[[Char]
"trans" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
catToStr Cat
cat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (x : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
fixType Cat
cat [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
") : result = match x with",
[[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
insertBar ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
s -> [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -> " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"failure x") [[Char]]
xs]