summaryrefslogtreecommitdiff
path: root/src/GF/CF/CFtoSRG.hs
blob: 4437417e8d546f5b8e5cb18cd059b6cf0e2984f3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
----------------------------------------------------------------------
-- |
-- Module      : (Module)
-- Maintainer  : (Maintainer)
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date $ 
-- > CVS $Author $
-- > CVS $Revision $
--
-- (Description of the module)
-----------------------------------------------------------------------------

{- 
   **************************************************************
    GF Module
   
    Description   : This module prints a CF as a SRG (Speech 
                    Recognition Grammar).

    Author        : Markus Forsberg (markus@cs.chalmers.se)

    License       : GPL (GNU General Public License)

    Created       : 21 January, 2001                           

    Modified      : 16 April, 2004 by Aarne Ranta for GF 2
   ************************************************************** 
-}

module CFtoSRG where

import Operations
import CF
import CFIdent
---import UseGrammar
import PPrCF
import List (intersperse,nub)

header :: String
header = unlines ["#ABNF 1.0 ISO-8859-1;\n",
		  "language en;",
		  "mode voice;",
		  "root $Main;",
		  "meta \"author\" is \"Grammatical Framework\";\n"]

prSRG :: CF -> String
prSRG cf = (header ++) $ prSRGC (catsOfCF cf) cf

prSRGC :: [CFCat] -> CF -> String
prSRGC [] _      = []
prSRGC (c:cs) cf =  "$" ++ prCFCat c ++ " = " ++ items ++ ";\n"++ prSRGC cs cf
 where items    =   concat $ intersperse " | " $   
		    map f $ nub $ map valItemsCF (rulesForCFCat cf c)
       f [] = "$NULL"
       f xs = unwords $ map prSRGItem xs

prSRGItem :: CFItem -> [Char]
prSRGItem (CFNonterm c) = "$" ++ prCFCat c
prSRGItem (CFTerm a)    = prRegExp a