{-
    BNF Converter: Template Generator
    Copyright (C) 2005  Author:  Kristofer Johannisson

-}

-- based on BNFC Haskell backend


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]