GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 11:42:49 -06:00
Code Issues Packages Projects Releases Wiki Activity

GF.Grammar.Lookup: new function lookupResDefLoc

Browse Source 
It's like lookupResDef but it includes a source location in the output.
This commit is contained in:
hallgren
2012-12-19 23:08:56 +00:00
parent 75696808a7
commit b4207d1b00
3 changed files with 16 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/compiler/GF/Compile/Compute/AppPredefined.hs
View File

@@ -88,8 +88,6 @@ primitives = Map.fromList
fun from to = oper (mkFunType from to) fun from to = oper (mkFunType from to)
oper ty = ResOper (Just (noLoc ty)) Nothing oper ty = ResOper (Just (noLoc ty)) Nothing
noLoc = L NoLoc
varL :: Ident varL :: Ident
varL = identC (BS.pack "L") varL = identC (BS.pack "L")

4
src/compiler/GF/Grammar/Grammar.hs
View File

@@ -36,7 +36,7 @@ module GF.Grammar.Grammar (
PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence, PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence,
Info(..), Info(..),
Location(..), L(..), unLoc, Location(..), L(..), unLoc, noLoc,
Type, Type,
Cat, Cat,
Fun, Fun,
@@ -372,6 +372,8 @@ instance Functor L where
unLoc :: L a -> a unLoc :: L a -> a
unLoc (L _ x) = x unLoc (L _ x) = x
noLoc = L NoLoc
type Type = Term type Type = Term
type Cat = QIdent type Cat = QIdent
type Fun = QIdent type Fun = QIdent

24
src/compiler/GF/Grammar/Lookup.hs
View File

@@ -19,7 +19,7 @@ module GF.Grammar.Lookup (
lookupIdent, lookupIdent,
lookupOrigInfo, lookupOrigInfo,
allOrigInfos, allOrigInfos,
lookupResDef, lookupResDef, lookupResDefLoc,
lookupResType, lookupResType,
lookupOverload, lookupOverload,
lookupParamValues, lookupParamValues,
@@ -62,24 +62,26 @@ lookupQIdentInfo :: SourceGrammar -> QIdent -> Err Info
lookupQIdentInfo gr (m,c) = flip lookupIdentInfo c =<< lookupModule gr m 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 x = fmap unLoc (lookupResDefLoc gr x)
| isPredefCat c = lock c defLinType
lookupResDefLoc gr (m,c)
| isPredefCat c = fmap noLoc (lock c defLinType)
| otherwise = look m c | otherwise = look m c
where where
look m c = do look m c = do
info <- lookupQIdentInfo gr (m,c) info <- lookupQIdentInfo gr (m,c)
case info of case info of
ResOper _ (Just (L _ t)) -> return t ResOper _ (Just lt) -> return lt
ResOper _ Nothing -> return (Q (m,c)) ResOper _ Nothing -> return (noLoc (Q (m,c)))
CncCat (Just (L _ ty)) _ _ _ -> lock c ty CncCat (Just (L l ty)) _ _ _ -> fmap (L l) (lock c ty)
CncCat _ _ _ _ -> lock c defLinType CncCat _ _ _ _ -> fmap noLoc (lock c defLinType)
CncFun (Just (cat,_,_)) (Just (L _ tr)) _ _ -> unlock cat tr CncFun (Just (cat,_,_)) (Just (L l tr)) _ _ -> fmap (L l) (unlock cat tr)
CncFun _ (Just (L _ tr)) _ _ -> return tr CncFun _ (Just ltr) _ _ -> return ltr
AnyInd _ n -> look n c AnyInd _ n -> look n c
ResParam _ _ -> return (QC (m,c)) ResParam _ _ -> return (noLoc (QC (m,c)))
ResValue _ -> return (QC (m,c)) ResValue _ -> return (noLoc (QC (m,c)))
_ -> Bad $ render (ppIdent c <+> text "is not defined in resource" <+> ppIdent m) _ -> Bad $ render (ppIdent c <+> text "is not defined in resource" <+> ppIdent m)
lookupResType :: SourceGrammar -> QIdent -> Err Type lookupResType :: SourceGrammar -> QIdent -> Err Type