mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-24 10:22:50 -06:00
lookup modules
This commit is contained in:
@@ -3,6 +3,8 @@ module GF.Devel.Modules where
|
|||||||
import GF.Grammar.Grammar
|
import GF.Grammar.Grammar
|
||||||
import GF.Infra.Ident
|
import GF.Infra.Ident
|
||||||
|
|
||||||
|
import GF.Data.Operations
|
||||||
|
|
||||||
import Data.Map
|
import Data.Map
|
||||||
|
|
||||||
|
|
||||||
@@ -13,25 +15,42 @@ data GF = GF {
|
|||||||
gfmodules :: Map Ident Module
|
gfmodules :: Map Ident Module
|
||||||
}
|
}
|
||||||
|
|
||||||
|
emptyGF :: GF
|
||||||
|
emptyGF = GF Nothing [] empty empty
|
||||||
|
|
||||||
data Module = Module {
|
data Module = Module {
|
||||||
mtype :: ModuleType,
|
mtype :: ModuleType,
|
||||||
|
mof :: Ident, -- other for concrete, same for rest
|
||||||
minterfaces :: [(Ident,Ident)], -- non-empty for functors
|
minterfaces :: [(Ident,Ident)], -- non-empty for functors
|
||||||
mextends :: [(Ident,MInclude)],
|
mextends :: [(Ident,MInclude)],
|
||||||
|
minstances :: [(Ident,Ident)], -- non-empty for instantiations
|
||||||
mopens :: [(Ident,Ident)], -- used name, original name
|
mopens :: [(Ident,Ident)], -- used name, original name
|
||||||
mflags :: Map Ident String,
|
mflags :: Map Ident String,
|
||||||
mjments :: Map Ident (Either Judgement Ident) -- def or indirection
|
mjments :: Map Ident (Either Judgement Ident) -- def or indirection
|
||||||
}
|
}
|
||||||
|
|
||||||
|
emptyModule :: Ident -> Module
|
||||||
|
emptyModule m = Module MGrammar m [] [] [] [] empty empty
|
||||||
|
|
||||||
|
listJudgements :: Module -> [(Ident,Either Judgement Ident)]
|
||||||
|
listJudgements = assocs . mjments
|
||||||
|
|
||||||
data ModuleType =
|
data ModuleType =
|
||||||
MAbstract
|
MAbstract
|
||||||
| MConcrete Ident
|
| MConcrete
|
||||||
| MGrammar
|
| MGrammar
|
||||||
|
|
||||||
|
data MInclude =
|
||||||
|
MIAll
|
||||||
|
| MIExcept [Ident]
|
||||||
|
| MIOnly [Ident]
|
||||||
|
|
||||||
data Judgement = Judgement {
|
data Judgement = Judgement {
|
||||||
jform :: JudgementForm,
|
jform :: JudgementForm, -- cat fun oper param
|
||||||
jtype :: Type,
|
jtype :: Type, -- context type type type
|
||||||
jdef :: Term,
|
jdef :: Term, -- lindef def - values
|
||||||
jprintname :: Term
|
jlin :: Term, -- lincat lin def constructors
|
||||||
|
jprintname :: Term -- printname printname - -
|
||||||
}
|
}
|
||||||
|
|
||||||
data JudgementForm =
|
data JudgementForm =
|
||||||
@@ -40,3 +59,15 @@ data JudgementForm =
|
|||||||
| JOper
|
| JOper
|
||||||
| JParam
|
| JParam
|
||||||
|
|
||||||
|
lookupIdent :: GF -> Ident -> Ident -> Err (Either Judgement Ident)
|
||||||
|
lookupIdent gf m c = do
|
||||||
|
mo <- maybe (Bad "module not found") return $ mlookup m (gfmodules gf)
|
||||||
|
maybe (Bad "constant not found") return $ mlookup c (mjments mo)
|
||||||
|
|
||||||
|
lookupJudgement :: GF -> Ident -> Ident -> Err Judgement
|
||||||
|
lookupJudgement gf m c = do
|
||||||
|
eji <- lookupIdent gf m c
|
||||||
|
either return (\n -> lookupJudgement gf n c) eji
|
||||||
|
|
||||||
|
mlookup = Data.Map.lookup
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user