GF.Grammar.Lookup: new function lookupResDefLoc

It's like lookupResDef but it includes a source location in the output.

3 files changed, 16 insertions, 14 deletions

diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs
index fcd262a19..375564b32 100644
--- a/src/compiler/GF/Compile/Compute/AppPredefined.hs
+++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs
@@ -88,8 +88,6 @@ primitives = Map.fromList
     fun from to = oper (mkFunType from to)
     oper ty     = ResOper (Just (noLoc ty)) Nothing
 
-    noLoc = L NoLoc
-
     varL :: Ident
     varL = identC (BS.pack "L")
 
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index 3a6d4c25f..218a2bd0b 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -36,7 +36,7 @@ module GF.Grammar.Grammar (
         PMCFG(..), Production(..), FId, FunId, SeqId, LIndex, Sequence,
         
         Info(..),
-        Location(..), L(..), unLoc,
+        Location(..), L(..), unLoc, noLoc,
         Type,
         Cat,
         Fun,
@@ -372,6 +372,8 @@ instance Functor L where
 unLoc :: L a -> a
 unLoc (L _ x) = x
 
+noLoc = L NoLoc
+
 type Type = Term
 type Cat  = QIdent
 type Fun  = QIdent
diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs
index 9148104fd..6b9b4d869 100644
--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -19,7 +19,7 @@ module GF.Grammar.Lookup (
            lookupIdent,
            lookupOrigInfo,
            allOrigInfos,
-           lookupResDef,
+           lookupResDef, lookupResDefLoc,
            lookupResType, 
            lookupOverload,
            lookupParamValues, 
@@ -62,24 +62,26 @@ lookupQIdentInfo :: SourceGrammar -> QIdent -> Err Info
 lookupQIdentInfo gr (m,c) = flip lookupIdentInfo c =<< lookupModule gr m
 
 lookupResDef :: SourceGrammar -> QIdent -> Err Term
-lookupResDef gr (m,c)
-  | isPredefCat c = lock c defLinType 
+lookupResDef gr x = fmap unLoc (lookupResDefLoc gr x)
+
+lookupResDefLoc gr (m,c)
+  | isPredefCat c = fmap noLoc (lock c defLinType)
   | otherwise     = look m c
   where 
     look m c = do
       info <- lookupQIdentInfo gr (m,c)
       case info of
-        ResOper _ (Just (L _ t)) -> return t
-        ResOper _ Nothing  -> return (Q (m,c))
-        CncCat (Just (L _ ty)) _ _ _ -> lock c ty
-        CncCat _ _ _ _         -> lock c defLinType
+        ResOper _ (Just lt) -> return lt
+        ResOper _ Nothing  -> return (noLoc (Q (m,c)))
+        CncCat (Just (L l ty)) _ _ _ -> fmap (L l) (lock c ty)
+        CncCat _ _ _ _         -> fmap noLoc (lock c defLinType)
       
-        CncFun (Just (cat,_,_)) (Just (L _ tr)) _ _ -> unlock cat tr
-        CncFun _                (Just (L _ tr)) _ _ -> return tr
+        CncFun (Just (cat,_,_)) (Just (L l tr)) _ _ -> fmap (L l) (unlock cat tr)
+        CncFun _                (Just ltr) _ _ -> return ltr
 
         AnyInd _ n        -> look n c
-        ResParam _ _      -> return (QC (m,c))
-        ResValue _        -> return (QC (m,c))
+        ResParam _ _      -> return (noLoc (QC (m,c)))
+        ResValue _        -> return (noLoc (QC (m,c)))
         _   -> Bad $ render (ppIdent c <+> text "is not defined in resource" <+> ppIdent m)
 
 lookupResType :: SourceGrammar -> QIdent -> Err Type