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
103
104
105
106
107
108
109
110
111
112
113
|
----------------------------------------------------------------------
-- |
-- Module : PrintCFGrammar
-- Maintainer : BB
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/17 14:04:38 $
-- > CVS $Author: bringert $
-- > CVS $Revision: 1.20 $
--
-- Handles printing a CFGrammar in CFGM format.
-----------------------------------------------------------------------------
module GF.CFGM.PrintCFGrammar (prCanonAsCFGM) where
import GF.Canon.AbsGFC
import qualified GF.CFGM.PrintCFG as PrintCFG
import GF.Infra.Ident
import GF.Canon.GFC
import GF.Infra.Modules
import qualified GF.Conversion.GFC as Cnv
import GF.Infra.Print (prt)
import GF.Formalism.CFG (CFRule(..))
import qualified GF.Formalism.Utilities as GU
import qualified GF.Conversion.Types as GT
import qualified GF.CFGM.AbsCFG as AbsCFG
import GF.Formalism.Utilities (Symbol(..))
import GF.Data.ErrM
import GF.Data.Utilities (compareBy)
import qualified GF.Infra.Option as Option
import Data.List (intersperse, sortBy)
import Data.Maybe (listToMaybe, maybeToList, maybe)
import GF.Infra.Print
import GF.System.Tracing
-- | FIXME: should add an Options argument,
-- to be able to decide which CFG conversion one wants to use
prCanonAsCFGM :: Option.Options -> CanonGrammar -> String
prCanonAsCFGM opts gr = unlines $ map (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 = tracePrt "CFGM languages" (prtBefore "\n")
[ (i, getFlag fs "startcat", getFlag fs "conversion") |
(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, Maybe String) -> String
prLangAsCFGM gr (i, start, cnv) = 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 $ maybeToList $ fmap Option.gfcConversion cnv
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 $ sortCFGMRules $ map ruleToCFGMRule gr
where flags = maybe [] (\c -> [AbsCFG.StartCat $ strToCFGMCat (c++"{}.s")]) start
sortCFGMRules = sortBy (compareBy ruleKey)
ruleKey (AbsCFG.Rule f ps cat rhs) = (cat,f)
ruleToCFGMRule :: GT.CRule -> AbsCFG.Rule
ruleToCFGMRule (CFRule c rhs (GU.Name fun profile))
= AbsCFG.Rule fun' p' c' rhs'
where
fun' = identToFun fun
p' = profileToCFGMProfile profile
c' = catToCFGMCat c
rhs' = map symbolToGFCMSymbol rhs
profileToCFGMProfile :: [GU.Profile (GU.SyntaxForest GT.Fun)] -> AbsCFG.Profiles
profileToCFGMProfile = AbsCFG.Profiles . map cnvProfile
where cnvProfile (GU.Unify ns) = AbsCFG.UnifyProfile $ map fromIntegral ns
-- FIXME: is it always FNode?
cnvProfile (GU.Constant (GU.FNode c _)) = AbsCFG.ConstProfile $ identToCFGMIdent c
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])
|
