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
|
----------------------------------------------------------------------
-- |
-- Module : GFC
-- Maintainer : AR
-- Stability : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/02/18 19:21:06 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.6 $
--
-- canonical GF. AR 10\/9\/2002 -- 9\/5\/2003 -- 21\/9
-----------------------------------------------------------------------------
module GFC (Context,
CanonGrammar,
CanonModInfo,
CanonModule,
CanonAbs,
Info(..),
Printname,
mapInfoTerms,
setFlag
) where
import AbsGFC
import PrintGFC
import qualified Abstract as A
import Ident
import Option
import Zipper
import Operations
import qualified Modules as M
import Char
type Context = [(Ident,Exp)]
type CanonGrammar = M.MGrammar Ident Flag Info
type CanonModInfo = M.ModInfo Ident Flag Info
type CanonModule = (Ident, CanonModInfo)
type CanonAbs = M.Module Ident Option Info
data Info =
AbsCat A.Context [A.Fun]
| AbsFun A.Type A.Term
| AbsTrans A.Term
| ResPar [ParDef]
| ResOper CType Term -- ^ global constant
| CncCat CType Term Printname
| CncFun CIdent [ArgVar] Term Printname
| AnyInd Bool Ident
deriving (Show)
type Printname = Term
-- some printing ----
{-
prCanonModInfo :: (Ident,CanonModInfo) -> String
prCanonModInfo = printTree . info2mod
prGrammar :: CanonGrammar -> String
prGrammar = printTree . grammar2canon
-}
{-
-- apply a function to all concrete terms in a grammar
mapConcreteTerms :: (Term -> Term) -> CanonGrammar -> CanonGrammar
mapConcreteTerms f (M.MGrammar xs) = M.MGrammar $ map (onSnd (onModule f)) xs
where
onModule :: (Term -> Term) -> M.ModInfo i f Info -> M.ModInfo i f Info
onModule f m = case m of
M.ModMod (m@M.Module{M.jments=js}) ->
M.ModMod (m{ M.jments = mapTree (onSnd (onInfo f)) js })
_ -> m
-- if -utf8 was given, convert from language specific coding
encode = if oElem useUTF8 opts then setUTF8Flag . canonUTF8 else id
canonUTF8 = mapConcreteTerms (onTokens (anyCodingToUTF8 opts))
setUTF8Flag = setFlag "coding" "utf8"
moduleToUTF8 :: Module Ident Flag Info -> Module Ident Flag Info
moduleToUTF8 m = m{ jments = mapTree (onSnd }
where
code = anyCodingToUTF8 (moduleOpts m)
moduleOpts = okError . mapM redFlag . flags
data MGrammar i f a = MGrammar {modules :: [(i,ModInfo i f a)]}
deriving Show
data ModInfo i f a =
ModMainGrammar (MainGrammar i)
| ModMod (Module i f a)
| ModWith (ModuleType i) ModuleStatus i [OpenSpec i]
deriving Show
data Module i f a = Module {
mtype :: ModuleType i ,
mstatus :: ModuleStatus ,
flags :: [f] ,
extends :: Maybe i ,
opens :: [OpenSpec i] ,
jments :: BinTree (i,a)
}
deriving Show
-- Set a flag in all modules in a grammar
setFlag :: String -> String -> CanonGrammar -> CanonGrammar
setFlag n v (M.MGrammar ms) = M.MGrammar $ map (onSnd setFlagMod) ms
where
setFlagMod m = case m of
M.ModMod (m@M.Module{M.flags=fs}) -> M.ModMod $ m{ M.flags = fs' }
where fs' = Flg (IC n) (IC v):[f | f@(Flg (IC n') _) <- fs, n' /= n]
_ -> m
-}
mapInfoTerms :: (Term -> Term) -> Info -> Info
mapInfoTerms f i = case i of
ResOper x a -> ResOper x (f a)
CncCat x a y -> CncCat x (f a) y
CncFun x y a z -> CncFun x y (f a) z
_ -> i
setFlag :: String -> String -> [Flag] -> [Flag]
setFlag n v fs = Flg (IC n) (IC v):[f | f@(Flg (IC n') _) <- fs, n' /= n]
|
