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
|
module PrLBNF (prLBNF,prBNF) where
import CF
import CFIdent
import AbsGFC
import Ident
import PrGrammar
import Operations
import Char
-- Printing CF grammars generated from GF as LBNF grammar for BNFC.
-- AR 26/1/2000 -- 9/6/2003 (PPrCF) -- 8/11/2003
-- With primitive error messaging, by rules and rule tails commented out
prLBNF :: CF -> String
prLBNF cf = unlines $ (map (prCFRule cs)) $ rulesOfCF cf --- no literal recogn function
where
cs = map IC ["Int","String"] ++ [catId c | (_,(c,_)) <- rulesOfCF cf]
-- a hack to hide the LBNF details
prBNF :: CF -> String
prBNF = unlines . (map (unwords . unLBNF . drop 1 . words)) . lines . prLBNF
where
unLBNF r = case r of
"---":ts -> ts
";":"---":ts -> ts
c:ts -> c : unLBNF ts
_ -> r
catId ((CFCat ((CIQ _ c),l))) = c
prCFRule :: [Ident] -> CFRule -> String
prCFRule cs (fun,(cat,its)) =
prCFFun cat fun ++ "." +++ prCFCat True cat +++ "::=" +++ --- err in cat -> in syntax
unwords (map (prCFItem cs) its) +++ ";"
prCFFun :: CFCat -> CFFun -> String
prCFFun (CFCat (_,l)) (CFFun (t, p)) = case t of
AC (CIQ _ x) -> let f = prId True x in (f ++ lab +++ f2 f +++ prP p)
AD (CIQ _ x) -> let f = prId True x in (f ++ lab +++ f2 f +++ prP p)
_ -> prErr True $ prt t
where
lab = prLab l
f2 f = if null lab then "" else f
prP = concatMap show
prId b i = case i of
IC "Int" -> "Integer"
IC "#Var" -> "Ident"
IC "Var" -> "Ident"
IC "id_" -> "_"
IC s@(c:_) | isUpper c -> s ++ if isDigit (last s) then "_" else ""
_ -> prErr b $ prt i
prLab i = case i of
L (IC "s") -> "" ---
L (IC "_") -> "" ---
_ -> let x = prt i in "_" ++ x ++ if isDigit (last x) then "_" else ""
-- just comment out the rest if you cannot interpret the function name in LBNF
-- two versions, depending on whether in the beginning of a rule or elsewhere;
-- in the latter case, error just terminates the rule
prErr :: Bool -> String -> String
prErr b s = (if b then "" else " ;") +++ "---" +++ s
prCFCat :: Bool -> CFCat -> String
prCFCat b (CFCat ((CIQ _ c),l)) = prId b c ++ prLab l ----
-- if a category does not have a production of its own, we replace it by Ident
prCFItem cs (CFNonterm c) = if elem (catId c) cs then prCFCat False c else "Ident"
prCFItem _ (CFTerm a) = prRegExp a
prRegExp (RegAlts tt) = case tt of
[t] -> prQuotedString t
_ -> prErr False $ prParenth (prTList " | " (map prQuotedString tt))
|
