blob: 005da1404fc9910e12f43849642eb641ff365c94 (
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
----------------------------------------------------------------------
-- |
-- Module : PrintCFGrammar
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/04/16 05:40:50 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.16 $
--
-- Handles printing a CFGrammar in CFGM format.
-----------------------------------------------------------------------------
module PrintCFGrammar (prCanonAsCFGM) where
import AbsGFC
import qualified PrintCFG
import Ident
import GFC
import Modules
import qualified GF.Conversion.GFC as Cnv
import GF.Infra.Print (prt)
import GF.Formalism.CFG (CFRule(..))
import qualified GF.Conversion.Types as GT
import qualified AbsCFG
import GF.Formalism.Utilities (Symbol(..))
import ErrM
import qualified Option
import List (intersperse)
import Maybe (listToMaybe, maybe)
-- | FIXME: should add an Options argument,
-- to be able to decide which CFG conversion one wants to use
prCanonAsCFGM :: CanonGrammar -> String
prCanonAsCFGM gr = unlines $ map (uncurry (prLangAsCFGM gr)) xs
where
cncs = maybe [] (allConcretes gr) (greatestAbstract gr)
cncms = map (\i -> (i,fromOk (lookupModule gr i))) cncs
fromOk (Ok x) = x
fromOk (Bad y) = error y
xs = [(i,getFlag fs "startcat") | (i,ModMod (Module{flags=fs})) <- cncms]
-- | FIXME: need to look in abstract module too
getFlag :: [Flag] -> String -> Maybe String
getFlag fs x = listToMaybe [v | Flg (IC k) (IC v) <- fs, k == x]
-- | FIXME: (1) Should use 'ShellState.stateCFG'
-- instead of 'Cnv.gfc2cfg' (which recalculates the grammar every time)
--
-- FIXME: (2) Should use the state options, when calculating the CFG
-- (this is solved automatically if one solves (1) above)
prLangAsCFGM :: CanonGrammar -> Ident -> Maybe String -> String
prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.gfc2cfg opts (gr, i)) i start
-- prLangAsCFGM gr i start = prCFGrammarAsCFGM (Cnv.cfg (Cnv.pInfo opts gr i)) i start
where opts = Option.Opts [Option.gfcConversion "nondet"]
prCFGrammarAsCFGM :: GT.CGrammar -> Ident -> Maybe String -> String
prCFGrammarAsCFGM gr i start = PrintCFG.printTree $ cfGrammarToCFGM gr i start
cfGrammarToCFGM :: GT.CGrammar -> Ident -> Maybe String -> AbsCFG.Grammar
cfGrammarToCFGM gr i start = AbsCFG.Grammar (identToCFGMIdent i) flags (map ruleToCFGMRule gr)
where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start
ruleToCFGMRule :: GT.CRule -> AbsCFG.Rule
ruleToCFGMRule (CFRule c rhs (GT.Name fun profile))
= AbsCFG.Rule fun' p' c' rhs'
where
fun' = identToFun fun
p' = profileToCFGMProfile profile
c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs
profileToCFGMProfile :: [GT.Profile a] -> AbsCFG.Profile
profileToCFGMProfile = AbsCFG.Profile . map cnvProfile
where cnvProfile (GT.Unify ns) = AbsCFG.Ints $ map fromIntegral ns
cnvProfile (GT.Constant a) = AbsCFG.Ints []
-- FIXME: this should be replaced with a new constructor in 'AbsCFG'
identToCFGMIdent :: Ident -> AbsCFG.Ident
identToCFGMIdent = AbsCFG.Ident . prt
identToFun :: Ident -> AbsCFG.Fun
identToFun IW = AbsCFG.Coerce
identToFun i = AbsCFG.Cons (identToCFGMIdent i)
strToCFGMCat :: String -> AbsCFG.Category
strToCFGMCat = AbsCFG.Category . AbsCFG.SingleQuoteString . quoteSingle
catToCFGMCat :: GT.CCat -> AbsCFG.Category
catToCFGMCat = strToCFGMCat . prt
symbolToGFCMSymbol :: Symbol GT.CCat GT.Token -> AbsCFG.Symbol
symbolToGFCMSymbol (Cat c) = AbsCFG.CatS (catToCFGMCat c)
symbolToGFCMSymbol (Tok t) = AbsCFG.TermS (prt t)
quoteSingle :: String -> String
quoteSingle s = "'" ++ escapeSingle s ++ "'"
where escapeSingle = concatMap (\c -> if c == '\'' then "\\'" else [c])
|
