merge Lookup and LookAbs and move some lookup functions from PrGrammar to Lookup

6 files changed, 40 insertions, 66 deletions

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)]