forked from GitHub/gf-core
GF.Grammar.Lookup: added function lookupQIdentInfo
+ Avoids some code duplication by combinging lookupModule and lookupIdentInfo. + Also removed lookupIdentInfo from export list, since it is not used anywhere else.
This commit is contained in:
@@ -17,7 +17,7 @@
|
|||||||
|
|
||||||
module GF.Grammar.Lookup (
|
module GF.Grammar.Lookup (
|
||||||
lookupIdent,
|
lookupIdent,
|
||||||
lookupIdentInfo,
|
-- lookupIdentInfo,
|
||||||
lookupOrigInfo,
|
lookupOrigInfo,
|
||||||
allOrigInfos,
|
allOrigInfos,
|
||||||
lookupResDef,
|
lookupResDef,
|
||||||
@@ -60,14 +60,16 @@ lookupIdent c t =
|
|||||||
lookupIdentInfo :: ModInfo a -> Ident -> Err a
|
lookupIdentInfo :: ModInfo a -> Ident -> Err a
|
||||||
lookupIdentInfo mo i = lookupIdent i (jments mo)
|
lookupIdentInfo mo i = lookupIdent i (jments mo)
|
||||||
|
|
||||||
|
lookupQIdentInfo :: MGrammar info -> QIdent -> Err info
|
||||||
|
lookupQIdentInfo gr (m,c) = flip lookupIdentInfo c =<< lookupModule gr m
|
||||||
|
|
||||||
lookupResDef :: SourceGrammar -> QIdent -> Err Term
|
lookupResDef :: SourceGrammar -> QIdent -> Err Term
|
||||||
lookupResDef gr (m,c)
|
lookupResDef gr (m,c)
|
||||||
| isPredefCat c = lock c defLinType
|
| isPredefCat c = lock c defLinType
|
||||||
| otherwise = look m c
|
| otherwise = look m c
|
||||||
where
|
where
|
||||||
look m c = do
|
look m c = do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
ResOper _ (Just (L _ t)) -> return t
|
ResOper _ (Just (L _ t)) -> return t
|
||||||
ResOper _ Nothing -> return (Q (m,c))
|
ResOper _ Nothing -> return (Q (m,c))
|
||||||
@@ -84,8 +86,7 @@ lookupResDef gr (m,c)
|
|||||||
|
|
||||||
lookupResType :: SourceGrammar -> QIdent -> Err Type
|
lookupResType :: SourceGrammar -> QIdent -> Err Type
|
||||||
lookupResType gr (m,c) = do
|
lookupResType gr (m,c) = do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
ResOper (Just (L _ t)) _ -> return t
|
ResOper (Just (L _ t)) _ -> return t
|
||||||
|
|
||||||
@@ -101,8 +102,7 @@ lookupResType gr (m,c) = do
|
|||||||
|
|
||||||
lookupOverload :: SourceGrammar -> QIdent -> Err [([Type],(Type,Term))]
|
lookupOverload :: SourceGrammar -> QIdent -> Err [([Type],(Type,Term))]
|
||||||
lookupOverload gr (m,c) = do
|
lookupOverload gr (m,c) = do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
ResOverload os tysts -> do
|
ResOverload os tysts -> do
|
||||||
tss <- mapM (\x -> lookupOverload gr (x,c)) os
|
tss <- mapM (\x -> lookupOverload gr (x,c)) os
|
||||||
@@ -116,8 +116,7 @@ lookupOverload gr (m,c) = do
|
|||||||
-- | returns the original 'Info' and the module where it was found
|
-- | returns the original 'Info' and the module where it was found
|
||||||
lookupOrigInfo :: SourceGrammar -> QIdent -> Err (Ident,Info)
|
lookupOrigInfo :: SourceGrammar -> QIdent -> Err (Ident,Info)
|
||||||
lookupOrigInfo gr (m,c) = do
|
lookupOrigInfo gr (m,c) = do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
AnyInd _ n -> lookupOrigInfo gr (n,c)
|
AnyInd _ n -> lookupOrigInfo gr (n,c)
|
||||||
i -> return (m,i)
|
i -> return (m,i)
|
||||||
@@ -155,8 +154,7 @@ allParamValues cnc ptyp =
|
|||||||
|
|
||||||
lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe Int,Maybe [Equation])
|
lookupAbsDef :: SourceGrammar -> Ident -> Ident -> Err (Maybe Int,Maybe [Equation])
|
||||||
lookupAbsDef gr m c = errIn (render (text "looking up absdef of" <+> ppIdent c)) $ do
|
lookupAbsDef gr m c = errIn (render (text "looking up absdef of" <+> ppIdent c)) $ do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
AbsFun _ a d _ -> return (a,fmap (map unLoc) d)
|
AbsFun _ a d _ -> return (a,fmap (map unLoc) d)
|
||||||
AnyInd _ n -> lookupAbsDef gr n c
|
AnyInd _ n -> lookupAbsDef gr n c
|
||||||
@@ -165,8 +163,7 @@ lookupAbsDef gr m c = errIn (render (text "looking up absdef of" <+> ppIdent c))
|
|||||||
lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type
|
lookupLincat :: SourceGrammar -> Ident -> Ident -> Err Type
|
||||||
lookupLincat gr m c | isPredefCat c = return defLinType --- ad hoc; not needed?
|
lookupLincat gr m c | isPredefCat c = return defLinType --- ad hoc; not needed?
|
||||||
lookupLincat gr m c = do
|
lookupLincat gr m c = do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
CncCat (Just (L _ t)) _ _ -> return t
|
CncCat (Just (L _ t)) _ _ -> return t
|
||||||
AnyInd _ n -> lookupLincat gr n c
|
AnyInd _ n -> lookupLincat gr n c
|
||||||
@@ -175,8 +172,7 @@ lookupLincat gr m c = do
|
|||||||
-- | this is needed at compile time
|
-- | this is needed at compile time
|
||||||
lookupFunType :: SourceGrammar -> Ident -> Ident -> Err Type
|
lookupFunType :: SourceGrammar -> Ident -> Ident -> Err Type
|
||||||
lookupFunType gr m c = do
|
lookupFunType gr m c = do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
AbsFun (Just (L _ t)) _ _ _ -> return t
|
AbsFun (Just (L _ t)) _ _ _ -> return t
|
||||||
AnyInd _ n -> lookupFunType gr n c
|
AnyInd _ n -> lookupFunType gr n c
|
||||||
@@ -185,8 +181,7 @@ lookupFunType gr m c = do
|
|||||||
-- | this is needed at compile time
|
-- | this is needed at compile time
|
||||||
lookupCatContext :: SourceGrammar -> Ident -> Ident -> Err Context
|
lookupCatContext :: SourceGrammar -> Ident -> Ident -> Err Context
|
||||||
lookupCatContext gr m c = do
|
lookupCatContext gr m c = do
|
||||||
mo <- lookupModule gr m
|
info <- lookupQIdentInfo gr (m,c)
|
||||||
info <- lookupIdentInfo mo c
|
|
||||||
case info of
|
case info of
|
||||||
AbsCat (Just (L _ co)) -> return co
|
AbsCat (Just (L _ co)) -> return co
|
||||||
AnyInd _ n -> lookupCatContext gr n c
|
AnyInd _ n -> lookupCatContext gr n c
|
||||||
@@ -225,5 +220,3 @@ allOpersTo gr ty = [op | op@(_,typ,_) <- allOpers gr, isProdTo ty typ] where
|
|||||||
eqProd f g = case (f,g) of
|
eqProd f g = case (f,g) of
|
||||||
(Prod _ _ a1 b1, Prod _ _ a2 b2) -> eqProd a1 a2 && eqProd b1 b2
|
(Prod _ _ a1 b1, Prod _ _ a2 b2) -> eqProd a1 a2 && eqProd b1 b2
|
||||||
_ -> f == g
|
_ -> f == g
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user