forked from GitHub/gf-core
lookup module separated
This commit is contained in:
58
src/GF/Devel/Lookup.hs
Normal file
58
src/GF/Devel/Lookup.hs
Normal file
@@ -0,0 +1,58 @@
|
||||
module GF.Devel.Lookup where
|
||||
|
||||
import GF.Devel.Modules
|
||||
import GF.Devel.Judgements
|
||||
import GF.Devel.Terms
|
||||
import GF.Infra.Ident
|
||||
|
||||
import GF.Data.Operations
|
||||
|
||||
import Data.Map
|
||||
|
||||
-- look up fields for a constant in a grammar
|
||||
|
||||
lookupJField :: (Judgement -> a) -> GF -> Ident -> Ident -> Err a
|
||||
lookupJField field gf m c = do
|
||||
j <- lookupJudgement gf m c
|
||||
return $ field j
|
||||
|
||||
lookupJForm :: GF -> Ident -> Ident -> Err JudgementForm
|
||||
lookupJForm = lookupJField jform
|
||||
|
||||
-- the following don't (need to) check that the jment form is adequate
|
||||
|
||||
lookupCatContext :: GF -> Ident -> Ident -> Err Context
|
||||
lookupCatContext gf m c = do
|
||||
ty <- lookupJField jtype gf m c
|
||||
return [] ---- context of ty
|
||||
|
||||
lookupFunType :: GF -> Ident -> Ident -> Err Term
|
||||
lookupFunType = lookupJField jtype
|
||||
|
||||
lookupLin :: GF -> Ident -> Ident -> Err Term
|
||||
lookupLin = lookupJField jlin
|
||||
|
||||
lookupLincat :: GF -> Ident -> Ident -> Err Term
|
||||
lookupLincat = lookupJField jlin
|
||||
|
||||
lookupParamValues :: GF -> Ident -> Ident -> Err [Term]
|
||||
lookupParamValues gf m c = do
|
||||
j <- lookupJudgement gf m c
|
||||
case jdef j of
|
||||
V _ ts -> return ts
|
||||
_ -> raise "no parameter values"
|
||||
|
||||
-- infrastructure for lookup
|
||||
|
||||
lookupIdent :: GF -> Ident -> Ident -> Err (Either Judgement Ident)
|
||||
lookupIdent gf m c = do
|
||||
mo <- maybe (raise "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
|
||||
|
||||
@@ -48,50 +48,3 @@ data MInclude =
|
||||
| MIOnly [Ident]
|
||||
|
||||
|
||||
-- look up fields for a constant in a grammar
|
||||
|
||||
lookupJField :: (Judgement -> a) -> GF -> Ident -> Ident -> Err a
|
||||
lookupJField field gf m c = do
|
||||
j <- lookupJudgement gf m c
|
||||
return $ field j
|
||||
|
||||
lookupJForm :: GF -> Ident -> Ident -> Err JudgementForm
|
||||
lookupJForm = lookupJField jform
|
||||
|
||||
-- the following don't (need to) check that the jment form is adequate
|
||||
|
||||
lookupCatContext :: GF -> Ident -> Ident -> Err Context
|
||||
lookupCatContext gf m c = do
|
||||
ty <- lookupJField jtype gf m c
|
||||
return [] ---- context of ty
|
||||
|
||||
lookupFunType :: GF -> Ident -> Ident -> Err Term
|
||||
lookupFunType = lookupJField jtype
|
||||
|
||||
lookupLin :: GF -> Ident -> Ident -> Err Term
|
||||
lookupLin = lookupJField jlin
|
||||
|
||||
lookupLincat :: GF -> Ident -> Ident -> Err Term
|
||||
lookupLincat = lookupJField jlin
|
||||
|
||||
lookupParamValues :: GF -> Ident -> Ident -> Err [Term]
|
||||
lookupParamValues gf m c = do
|
||||
j <- lookupJudgement gf m c
|
||||
case jdef j of
|
||||
V _ ts -> return ts
|
||||
_ -> raise "no parameter values"
|
||||
|
||||
-- infrastructure for lookup
|
||||
|
||||
lookupIdent :: GF -> Ident -> Ident -> Err (Either Judgement Ident)
|
||||
lookupIdent gf m c = do
|
||||
mo <- maybe (raise "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