diff --git a/GF.cabal b/GF.cabal index a7d76da6c..c7db0c18a 100644 --- a/GF.cabal +++ b/GF.cabal @@ -656,7 +656,6 @@ executable gf GF.Grammar.MMacros GF.Grammar.Abstract GF.Grammar.Lookup - GF.Grammar.LookAbs GF.Grammar.Unify GF.Grammar.AppPredefined GF.Grammar.PatternMatch diff --git a/src/GF/Compile/AbsCompute.hs b/src/GF/Compile/AbsCompute.hs index f8a484ac8..8546dc3bc 100644 --- a/src/GF/Compile/AbsCompute.hs +++ b/src/GF/Compile/AbsCompute.hs @@ -24,7 +24,6 @@ module GF.Compile.AbsCompute (LookDef, import GF.Data.Operations import GF.Grammar.Abstract -import GF.Grammar.PrGrammar import GF.Grammar.Lookup import GF.Compile.Compute diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 2d93394e3..43b186a7c 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -33,7 +33,6 @@ import GF.Compile.Refresh import GF.Grammar.Grammar import GF.Grammar.PrGrammar import GF.Grammar.Lookup -import GF.Grammar.LookAbs import GF.Grammar.Predef import GF.Grammar.Macros import GF.Grammar.ReservedWords diff --git a/src/GF/Compile/TypeCheck.hs b/src/GF/Compile/TypeCheck.hs index ae2c9abde..1e124f60e 100644 --- a/src/GF/Compile/TypeCheck.hs +++ b/src/GF/Compile/TypeCheck.hs @@ -25,7 +25,7 @@ import GF.Data.Operations import GF.Grammar.Abstract import GF.Compile.Refresh import GF.Compile.AbsCompute -import GF.Grammar.LookAbs +import GF.Grammar.Lookup import qualified GF.Grammar.Lookup as Lookup --- import GF.Grammar.Unify --- diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs deleted file mode 100644 index 137e602aa..000000000 --- a/src/GF/Grammar/LookAbs.hs +++ /dev/null @@ -1,47 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : LookAbs --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/28 16:42:48 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.14 $ --- --- (Description of the module) ------------------------------------------------------------------------------ - -module GF.Grammar.LookAbs ( - lookupFunType, - lookupCatContext - ) where - -import GF.Data.Operations -import GF.Grammar.Abstract -import GF.Infra.Ident - -import GF.Infra.Modules - -import Data.List (nub) -import Control.Monad - --- | this is needed at compile time -lookupFunType :: Grammar -> Ident -> Ident -> Err Type -lookupFunType gr m c = do - mo <- lookupModule gr m - info <- lookupIdentInfo mo c - case info of - AbsFun (Yes t) _ -> return t - AnyInd _ n -> lookupFunType gr n c - _ -> prtBad "cannot find type of" c - --- | this is needed at compile time -lookupCatContext :: Grammar -> Ident -> Ident -> Err Context -lookupCatContext gr m c = do - mo <- lookupModule gr m - info <- lookupIdentInfo mo c - case info of - AbsCat (Yes co) _ -> return co - AnyInd _ n -> lookupCatContext gr n c - _ -> prtBad "unknown category" c diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs index 1dcb47a21..2f5826752 100644 --- a/src/GF/Grammar/Lookup.hs +++ b/src/GF/Grammar/Lookup.hs @@ -16,6 +16,9 @@ ----------------------------------------------------------------------------- module GF.Grammar.Lookup ( + lookupIdent, + lookupIdentInfo, + lookupIdentInfoIn, lookupResDef, lookupResDefKind, lookupResType, @@ -29,6 +32,8 @@ module GF.Grammar.Lookup ( allParamValues, lookupAbsDef, lookupLincat, + lookupFunType, + lookupCatContext, opersForType ) where @@ -45,6 +50,20 @@ import Control.Monad lock c = lockRecType c -- return unlock c = unlockRecord c -- return +-- to look up a constant etc in a search tree --- why here? AR 29/5/2008 +lookupIdent :: Ident -> BinTree Ident b -> Err b +lookupIdent c t = + case lookupTree prIdent c t of + Ok v -> return v + Bad _ -> Bad ("unknown identifier" +++ prIdent c) + +lookupIdentInfo :: ModInfo Ident a -> Ident -> Err a +lookupIdentInfo mo i = lookupIdent i (jments mo) + +lookupIdentInfoIn :: ModInfo Ident a -> Ident -> Ident -> Err a +lookupIdentInfoIn mo m i = + err (\s -> Bad (s +++ "in module" +++ prIdent m)) return $ lookupIdentInfo mo i + lookupResDef :: SourceGrammar -> Ident -> Ident -> Err Term lookupResDef gr m c = liftM fst $ lookupResDefKind gr m c @@ -226,6 +245,26 @@ lookupLincat gr m c = do AnyInd _ n -> lookupLincat gr n c _ -> Bad $ prt c +++ "has no linearization type in" +++ prt m +-- | this is needed at compile time +lookupFunType :: SourceGrammar -> Ident -> Ident -> Err Type +lookupFunType gr m c = do + mo <- lookupModule gr m + info <- lookupIdentInfo mo c + case info of + AbsFun (Yes t) _ -> return t + AnyInd _ n -> lookupFunType gr n c + _ -> prtBad "cannot find type of" c + +-- | this is needed at compile time +lookupCatContext :: SourceGrammar -> Ident -> Ident -> Err Context +lookupCatContext gr m c = do + mo <- lookupModule gr m + info <- lookupIdentInfo mo c + case info of + AbsCat (Yes co) _ -> return co + AnyInd _ n -> lookupCatContext gr n c + _ -> prtBad "unknown category" c + -- The first type argument is uncomputed, usually a category symbol. -- This is a hack to find implicit (= reused) opers. diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs index c4be21472..a4a9d9256 100644 --- a/src/GF/Grammar/PrGrammar.hs +++ b/src/GF/Grammar/PrGrammar.hs @@ -30,7 +30,6 @@ module GF.Grammar.PrGrammar (Print(..), prConstrs, prConstraints, -- prMetaSubst, prEnv, prMSubst, prExp, prOperSignature, - lookupIdent, lookupIdentInfo, lookupIdentInfoIn, prTermTabular ) where @@ -246,21 +245,6 @@ prRefinement t = case t of prOperSignature :: (QIdent,Type) -> String prOperSignature (f, t) = prQIdent f +++ ":" +++ prt t --- to look up a constant etc in a search tree --- why here? AR 29/5/2008 - -lookupIdent :: Ident -> BinTree Ident b -> Err b -lookupIdent c t = case lookupTree prt c t of - Ok v -> return v - _ -> prtBad "unknown identifier" c - -lookupIdentInfo :: ModInfo Ident a -> Ident -> Err a -lookupIdentInfo mo i = lookupIdent i (jments mo) - -lookupIdentInfoIn :: ModInfo Ident a -> Ident -> Ident -> Err a -lookupIdentInfoIn mo m i = - err (\s -> Bad (s +++ "in module" +++ prt m)) return $ lookupIdentInfo mo i - - --- printing cc command output AR 26/5/2008 prTermTabular :: Term -> [(String,String)]