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