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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
----------------------------------------------------------------------
-- |
-- Maintainer : PL
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/08/18 13:18:10 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.2 $
--
-- Converting/Printing different grammar formalisms in Prolog-readable format
-----------------------------------------------------------------------------
module GF.Conversion.Prolog (prtSGrammar, prtSMulti, prtSHeader, prtSRule,
prtMGrammar, prtMMulti, prtMHeader, prtMRule,
prtCGrammar, prtCMulti, prtCHeader, prtCRule) where
import GF.Formalism.GCFG
import GF.Formalism.SimpleGFC
import GF.Formalism.MCFG
import GF.Formalism.CFG
import GF.Formalism.Utilities
import GF.Conversion.Types
import qualified GF.Conversion.GFC as Cnv
import GF.Data.Operations ((++++), (+++++))
import GF.Infra.Print
import qualified GF.Infra.Modules as Mod
import qualified GF.Infra.Option as Option
import GF.Data.Operations (okError)
import GF.Canon.AbsGFC (Flag(..))
import GF.Canon.GFC (CanonGrammar)
import GF.Infra.Ident (Ident(..))
import Data.Maybe (maybeToList, listToMaybe)
----------------------------------------------------------------------
-- | printing multiple languages at the same time
prtSMulti, prtMMulti, prtCMulti :: Option.Options -> CanonGrammar -> String
prtSMulti = prtMulti prtSHeader prtSRule (const Cnv.gfc2simple)
prtMMulti = prtMulti prtMHeader prtMRule Cnv.gfc2mcfg
prtCMulti = prtMulti prtCHeader prtCRule Cnv.gfc2cfg
-- code and ideas stolen from GF.CFGM.PrintCFGrammar
prtMulti prtHeader prtRule conversion opts gr
= prtHeader ++++ unlines
[ "\n\n" ++ prtLine ++++
"%% Language module: " ++ prtQ langmod +++++
unlines (map (prtRule langmod) rules) |
lang <- maybe [] (Mod.allConcretes gr) (Mod.greatestAbstract gr),
let Mod.ModMod (Mod.Module{Mod.flags=fs}) = okError (Mod.lookupModule gr lang),
let cnvopts = Option.Opts $ map Option.gfcConversion $ getFlag fs "conversion",
let rules = conversion cnvopts (gr, lang),
let langmod = (let IC lg = lang in "gf_" ++ lg) ]
getFlag :: [Flag] -> String -> [String]
getFlag fs x = [v | Flg (IC k) (IC v) <- fs, k == x]
----------------------------------------------------------------------
-- | SimpleGFC to Prolog
--
-- assumes that the profiles in the Simple GFC names are trivial
prtSGrammar :: SGrammar -> String
prtSGrammar rules = prtSHeader +++++ unlines (map (prtSRule "") rules)
prtSHeader :: String
prtSHeader = prtLine ++++
"%% Simple GFC grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++
"%% \t gfcrule(Fun, Cat, c(Cat,...), LinTerm)"
prtSRule :: String -> SRule -> String
prtSRule lang (Rule (Abs cat cats (Name fun _prof)) (Cnc _ _ mterm))
= (if null lang then "" else prtQ lang ++ " : ") ++
prtFunctor "gfcrule" [plfun, plcat, plcats, plcnc] ++ "."
where plfun = prtQ fun
plcat = prtQ cat
plcats = prtFunctor "c" (map prtQ cats)
plcnc = "\n\t" ++ prtSTerm (maybe (Variants []) id mterm)
prtSTerm (Arg n c p) = prtFunctor "arg" [prtQ c, prtSPath p, prt (n+1)]
-- prtSTerm (c :^ []) = prtQ c
prtSTerm (c :^ ts) = prtOper "^" (prtQ c) (prtPList (map prtSTerm ts))
prtSTerm (Rec rec) = prtFunctor "rec" [prtPList [ prtOper "=" (prtQ l) (prtSTerm t) | (l, t) <- rec ]]
prtSTerm (Tbl tbl) = prtFunctor "tbl" [prtPList [ prtOper "=" (prtSTerm p) (prtSTerm t) | (p, t) <- tbl ]]
prtSTerm (Variants ts) = prtFunctor "variants" [prtPList (map prtSTerm ts)]
prtSTerm (t1 :++ t2) = prtOper "+" (prtSTerm t1) (prtSTerm t2)
prtSTerm (Token t) = prtFunctor "token" [prtQ t]
prtSTerm (Empty) = "empty"
prtSTerm (term :. lbl) = prtOper "*" (prtSTerm term) (prtQ lbl)
prtSTerm (term :! sel) = prtOper "/" (prtSTerm term) (prtSTerm sel)
-- prtSTerm (Wildcard) = "wildcard"
-- prtSTerm (Var var) = prtFunctor "var" [prtQ var]
prtSPath (Path path) = prtPList (map (either prtQ prtSTerm) path)
----------------------------------------------------------------------
-- | MCFG to Prolog
prtMGrammar :: MGrammar -> String
prtMGrammar rules = prtMHeader +++++ unlines (map (prtMRule "") rules)
prtMHeader :: String
prtMHeader = prtLine ++++
"%% Multiple context-free grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++
"%% \t mcfgrule(Fun, p(Profile,...), Cat, c(Cat,...), [Lbl=Symbols,...])"
prtMRule :: String -> MRule -> String
prtMRule lang (Rule (Abs cat cats (Name fun profiles)) (Cnc _lcat _lcats lins))
= (if null lang then "" else prtQ lang ++ " : ") ++
prtFunctor "mcfgrule" [plfun, plprof, plcat, plcats, pllins] ++ "."
where plfun = prtQ fun
plprof = prtFunctor "p" (map prtProfile profiles)
plcat = prtQ cat
plcats = prtFunctor "c" (map prtQ cats)
pllins = "\n\t[ " ++ prtSep "\n\t, " (map prtMLin lins) ++ " ]"
prtMLin (Lin lbl lin) = prtOper "=" (prtQ lbl) (prtPList (map prtMSymbol lin))
prtMSymbol (Cat (cat, lbl, nr)) = prtFunctor "cat" [prtQ cat, prtQ lbl, show (nr+1)]
prtMSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
----------------------------------------------------------------------
-- | CFG to Prolog
prtCGrammar :: CGrammar -> String
prtCGrammar rules = prtCHeader +++++ unlines (map (prtCRule "") rules)
prtCHeader :: String
prtCHeader = prtLine ++++
"%% Context-free grammar in Prolog-readable format" ++++
"%% Autogenerated from the Grammatical Framework" +++++
"%% The following predicate is defined:" ++++
"%% \t cfgrule(Fun, p(Profile,...), Cat, [Symbol,...])"
prtCRule :: String -> CRule -> String
prtCRule lang (CFRule cat syms (Name fun profiles))
= (if null lang then "" else prtQ lang ++ " : ") ++
prtFunctor "cfgrule" [plfun, plprof, plcat, plsyms] ++ "."
where plfun = prtQ fun
plprof = prtFunctor "p" (map prtProfile profiles)
plcat = prtQ cat
plsyms = prtPList (map prtCSymbol syms)
prtCSymbol (Cat cat) = prtFunctor "cat" [prtQ cat]
prtCSymbol (Tok tok) = prtFunctor "tok" [prtQ tok]
----------------------------------------------------------------------
-- profiles, quoted strings and more
prtFunctor f xs = f ++ if null xs then "" else "(" ++ prtSep ", " xs ++ ")"
prtPList xs = "[" ++ prtSep ", " xs ++ "]"
prtOper f x y = "(" ++ x ++ " " ++ f ++ " " ++ y ++ ")"
prtProfile (Unify [arg]) = show (succ arg)
prtProfile (Unify args) = show (map succ args)
prtProfile (Constant forest) = prtForest forest
prtForest (FMeta) = "fmeta"
prtForest (FNode fun fss) = prtFunctor "fnode" [prtQ fun, prtFss fss]
where prtFss fss = prtPList (map prtFs fss)
prtFs fs = prtPList (map prtForest fs)
prtQ x = "'" ++ concatMap esc (prt x) ++ "'"
where esc '\'' = "\\'"
esc '\n' = "\\n"
esc '\t' = "\\t"
esc c = [c]
prtLine = replicate 70 '%'
|
