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
|
module GF.Devel.Grammar.Modules where
import GF.Devel.Grammar.Judgements
import GF.Devel.Grammar.Terms
import GF.Infra.Ident
import GF.Data.Operations
import Control.Monad
import Data.Map
data GF = GF {
gfabsname :: Maybe Ident ,
gfcncnames :: [Ident] ,
gflags :: Map Ident String , -- value of a global flag
gfmodules :: Map Ident Module
}
emptyGF :: GF
emptyGF = GF Nothing [] empty empty
type SourceModule = (Ident,Module)
listModules :: GF -> [SourceModule]
listModules = assocs.gfmodules
addModule :: Ident -> Module -> GF -> GF
addModule c m gf = gf {gfmodules = insert c m (gfmodules gf)}
data Module = Module {
mtype :: ModuleType,
miscomplete :: Bool,
minterfaces :: [(Ident,Ident)], -- non-empty for functors
minstances :: [((Ident,MInclude),[(Ident,Ident)])], -- non-empty for instant'ions
mextends :: [(Ident,MInclude)],
mopens :: [(Ident,Ident)], -- used name, original name
mflags :: Map Ident String,
mjments :: MapJudgement
}
emptyModule :: Ident -> Module
emptyModule m = Module MTGrammar True [] [] [] [] empty empty
type MapJudgement = Map Ident JEntry -- def or indirection
isCompleteModule :: Module -> Bool
isCompleteModule = miscomplete ---- Prelude.null . minterfaces
isInterface :: Module -> Bool
isInterface m = case mtype m of
MTInterface -> True
MTAbstract -> True
_ -> False
interfaceName :: Module -> Maybe Ident
interfaceName mo = case mtype mo of
MTInstance i -> return i
MTConcrete i -> return i
_ -> Nothing
listJudgements :: Module -> [(Ident,JEntry)]
listJudgements = assocs . mjments
type JEntry = Either Judgement Indirection
data ModuleType =
MTAbstract
| MTConcrete Ident
| MTInterface
| MTInstance Ident
| MTGrammar
deriving Eq
data MInclude =
MIAll
| MIExcept [Ident]
| MIOnly [Ident]
type Indirection = (Ident,Bool) -- module of origin, whether canonical
isConstructorEntry :: Either Judgement Indirection -> Bool
isConstructorEntry ji = case ji of
Left j -> isConstructor j
Right i -> snd i
isConstructor :: Judgement -> Bool
isConstructor j = jdef j == EData
isInherited :: MInclude -> Ident -> Bool
isInherited mi i = case mi of
MIExcept is -> notElem i is
MIOnly is -> elem i is
_ -> True
|
