1
0
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:
hallgren
2011-08-30 14:53:11 +00:00
parent a0c785d5d0
commit fe2fad8f8d

View File

@@ -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