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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
module Custom where
import Operations
import Text
import Tokenize
import qualified Grammar as G
import qualified AbsGFC as A
import qualified GFC as C
import qualified AbsGF as GF
import qualified MMacros as MM
import AbsCompute
import TypeCheck
------import Compile
import ShellState
import Editing
import Paraphrases
import Option
import CF
import CFIdent
---- import CFtoGrammar
import PPrCF
import PrGrammar
----import Morphology
-----import GrammarToHaskell
-----import GrammarToCanon (showCanon, showCanonOpt)
-----import qualified GrammarToGFC as GFC
-- the cf parsing algorithms
import ChartParser -- or some other CF Parser
import MoreCustom -- either small/ or big/. The one in Small is empty.
import UseIO
-- minimal version also used in Hugs. AR 2/12/2002.
-- databases for customizable commands. AR 21/11/2001
-- for: grammar parsers, grammar printers, term commands, string commands
-- idea: items added here are usable throughout GF; nothing else need be edited
-- they are often usable through the API: hence API cannot be imported here!
-- Major redesign 3/4/2002: the first entry in each database is DEFAULT.
-- If no other value is given, the default is selected.
-- Because of this, two invariants have to be preserved:
-- ** no databases may be empty
-- ** additions are made to the end of the database
-- these are the databases; the comment gives the name of the flag
-- grammarFormat, "-format=x" or file suffix
customGrammarParser :: CustomData (FilePath -> IOE C.CanonGrammar)
-- grammarPrinter, "-printer=x"
customGrammarPrinter :: CustomData (StateGrammar -> String)
-- syntaxPrinter, "-printer=x"
customSyntaxPrinter :: CustomData (GF.Grammar -> String)
-- termPrinter, "-printer=x"
customTermPrinter :: CustomData (StateGrammar -> A.Exp -> String)
-- termCommand, "-transform=x"
customTermCommand :: CustomData (StateGrammar -> A.Exp -> [A.Exp])
-- editCommand, "-edit=x"
customEditCommand :: CustomData (StateGrammar -> Action)
-- filterString, "-filter=x"
customStringCommand :: CustomData (StateGrammar -> String -> String)
-- useParser, "-parser=x"
customParser :: CustomData (StateGrammar -> CFCat -> CFParser)
-- useTokenizer, "-lexer=x"
customTokenizer :: CustomData (StateGrammar -> String -> [CFTok])
-- useUntokenizer, "-unlexer=x" --- should be from token list to string
customUntokenizer :: CustomData (StateGrammar -> String -> String)
-- this is the way of selecting an item
customOrDefault :: Options -> OptFun -> CustomData a -> a
customOrDefault opts optfun db = maybe (defaultCustomVal db) id $
customAsOptVal opts optfun db
-- to produce menus of custom operations
customInfo :: CustomData a -> (String, [String])
customInfo c = (titleCustomData c, map (ciStr . fst) (dbCustomData c))
-------------------------------
type CommandId = String
strCI :: String -> CommandId
strCI = id
ciStr :: CommandId -> String
ciStr = id
ciOpt :: CommandId -> Option
ciOpt = iOpt
newtype CustomData a = CustomData (String, [(CommandId,a)])
customData title db = CustomData (title,db)
dbCustomData (CustomData (_,db)) = db
titleCustomData (CustomData (t,_)) = t
lookupCustom :: CustomData a -> CommandId -> Maybe a
lookupCustom = flip lookup . dbCustomData
customAsOptVal :: Options -> OptFun -> CustomData a -> Maybe a
customAsOptVal opts optfun db = do
arg <- getOptVal opts optfun
lookupCustom db (strCI arg)
-- take the first entry from the database
defaultCustomVal :: CustomData a -> a
defaultCustomVal (CustomData (s,db)) =
ifNull (error ("empty database:" +++ s)) (snd . head) db
-------------------------------------------------------------------------
-- and here's the customizable part:
-- grammar parsers: the ID is also used as file name suffix
customGrammarParser =
customData "Grammar parsers, selected by file name suffix" $
[
------ (strCI "gf", compileModule noOptions) -- DEFAULT
-- add your own grammar parsers here
]
++ moreCustomGrammarParser
customGrammarPrinter =
customData "Grammar printers, selected by option -printer=x" $
[
---- (strCI "gf", prt) -- DEFAULT
(strCI "cf", prCF . stateCF)
{- ----
(strCI "gf", prt . st2grammar . stateGrammarST) -- DEFAULT
,(strCI "canon", showCanon "Lang" . stateGrammarST)
,(strCI "gfc", GFC.showGFC . stateGrammarST)
,(strCI "canonOpt",showCanonOpt "Lang" . stateGrammarST)
,(strCI "morpho", prMorpho . stateMorpho)
,(strCI "opts", prOpts . stateOptions)
-}
-- add your own grammar printers here
--- also include printing via grammar2syntax!
]
++ moreCustomGrammarPrinter
customSyntaxPrinter =
customData "Syntax printers, selected by option -printer=x" $
[
-- add your own grammar printers here
]
++ moreCustomSyntaxPrinter
customTermPrinter =
customData "Term printers, selected by option -printer=x" $
[
(strCI "gf", const prt) -- DEFAULT
-- add your own term printers here
]
++ moreCustomTermPrinter
customTermCommand =
customData "Term transformers, selected by option -transform=x" $
[
(strCI "identity", \_ t -> [t]) -- DEFAULT
{- ----
,(strCI "compute", \g t -> err (const [t]) return (computeAbsTerm g t))
,(strCI "paraphrase", \g t -> mkParaphrases g t)
,(strCI "typecheck", \g t -> err (const []) return (checkIfValidExp g t))
,(strCI "solve", \g t -> editAsTermCommand g
(uniqueRefinements g) t)
,(strCI "context", \g t -> editAsTermCommand g
(contextRefinements g) t)
-}
--- ,(strCI "delete", \g t -> [MM.mExp0])
-- add your own term commands here
]
++ moreCustomTermCommand
customEditCommand =
customData "Editor state transformers, selected by option -edit=x" $
[
(strCI "identity", const return) -- DEFAULT
,(strCI "transfer", const return) --- done ad hoc on top level
{- ----
,(strCI "typecheck", reCheckState)
,(strCI "solve", solveAll)
,(strCI "context", contextRefinements)
,(strCI "compute", computeSubTree)
-}
,(strCI "paraphrase", const return) --- done ad hoc on top level
-- add your own edit commands here
]
++ moreCustomEditCommand
customStringCommand =
customData "String filters, selected by option -filter=x" $
[
(strCI "identity", const $ id) -- DEFAULT
,(strCI "erase", const $ const "")
,(strCI "take100", const $ take 100)
,(strCI "text", const $ formatAsText)
,(strCI "code", const $ formatAsCode)
---- ,(strCI "latexfile", const $ mkLatexFile)
,(strCI "length", const $ show . length)
-- add your own string commands here
]
++ moreCustomStringCommand
customParser =
customData "Parsers, selected by option -parser=x" $
[
(strCI "chart", chartParser . stateCF)
-- add your own parsers here
]
++ moreCustomParser
customTokenizer =
customData "Tokenizers, selected by option -lexer=x" $
[
(strCI "words", const $ tokWords)
,(strCI "literals", const $ tokLits)
,(strCI "vars", const $ tokVars)
,(strCI "chars", const $ map (tS . singleton))
,(strCI "code", const $ lexHaskell)
,(strCI "text", const $ lexText)
---- ,(strCI "codelit", lexHaskellLiteral . stateIsWord)
---- ,(strCI "textlit", lexTextLiteral . stateIsWord)
,(strCI "codeC", const $ lexC2M)
,(strCI "codeCHigh", const $ lexC2M' True)
-- add your own tokenizers here
]
++ moreCustomTokenizer
customUntokenizer =
customData "Untokenizers, selected by option -unlexer=x" $
[
(strCI "unwords", const $ id) -- DEFAULT
,(strCI "text", const $ formatAsText)
,(strCI "code", const $ formatAsCode)
,(strCI "textlit", const $ formatAsTextLit)
,(strCI "codelit", const $ formatAsCodeLit)
,(strCI "concat", const $ concat . words)
,(strCI "bind", const $ performBinds)
-- add your own untokenizers here
]
++ moreCustomUntokenizer
|
