summaryrefslogtreecommitdiff
path: root/src/GF/Grammar
diff options
context:
space:
mode:
authoraarne <unknown>2005-04-28 15:42:47 +0000
committeraarne <unknown>2005-04-28 15:42:47 +0000
commit830f7c14bc0a7c9a22ec73759e315087a658f8ee (patch)
tree9ebbbc2fe852c4a93dcf3b93e0ef5486a64b38e3 /src/GF/Grammar
parent8b7e450f1cf8d88909b8ce78218c44b9b102e928 (diff)
library adjustments, error message clean-up
Diffstat (limited to 'src/GF/Grammar')
-rw-r--r--src/GF/Grammar/LookAbs.hs18
-rw-r--r--src/GF/Grammar/Lookup.hs18
-rw-r--r--src/GF/Grammar/Macros.hs9
-rw-r--r--src/GF/Grammar/PrGrammar.hs19
4 files changed, 39 insertions, 25 deletions
diff --git a/src/GF/Grammar/LookAbs.hs b/src/GF/Grammar/LookAbs.hs
index 2904a8b4b..f0681934c 100644
--- a/src/GF/Grammar/LookAbs.hs
+++ b/src/GF/Grammar/LookAbs.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:22:22 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.13 $
+-- > CVS $Date: 2005/04/28 16:42:48 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.14 $
--
-- (Description of the module)
-----------------------------------------------------------------------------
@@ -48,7 +48,7 @@ lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
C.AbsFun _ t -> return $ return t
C.AnyInd _ n -> lookupAbsDef gr n c
@@ -60,7 +60,7 @@ lookupFunType gr m c = errIn ("looking up funtype of" +++ prt c +++ "in module"
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
C.AbsFun t _ -> return t
C.AnyInd _ n -> lookupFunType gr n c
@@ -72,7 +72,7 @@ lookupCatContext gr m c = errIn ("looking up context of cat" +++ prt c) $ do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
C.AbsCat co _ -> return co
C.AnyInd _ n -> lookupCatContext gr n c
@@ -85,7 +85,7 @@ lookupTransfer gr m c = errIn ("looking up transfer of cat" +++ prt c) $ do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
C.AbsTrans t -> return t
C.AnyInd _ n -> lookupTransfer gr n c
@@ -168,7 +168,7 @@ lookupFunTypeSrc gr m c = do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
AbsFun (Yes t) _ -> return t
AnyInd _ n -> lookupFunTypeSrc gr n c
@@ -181,7 +181,7 @@ lookupCatContextSrc gr m c = do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
AbsCat (Yes co) _ -> return co
AnyInd _ n -> lookupCatContextSrc gr n c
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index 96a716e11..a634bdfc6 100644
--- a/src/GF/Grammar/Lookup.hs
+++ b/src/GF/Grammar/Lookup.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:22:23 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.13 $
+-- > CVS $Date: 2005/04/28 16:42:48 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.14 $
--
-- Lookup in source (concrete and resource) when compiling.
--
@@ -39,7 +39,7 @@ lookupResDef gr = look True where
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
ResOper _ (Yes t) -> return $ qualifAnnot m t
ResOper _ Nope -> return (Q m c) ---- if isTop then lookExt m c
@@ -62,7 +62,7 @@ lookupResType gr m c = do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
ResOper (Yes t) _ -> return $ qualifAnnot m t
ResOper (May n) _ -> lookupResType gr n c
@@ -75,7 +75,7 @@ lookupResType gr m c = do
CncFun _ _ _ -> do
a <- abstractOfConcrete gr m
mu <- lookupModMod gr a
- info <- lookupInfo mu c
+ info <- lookupIdentInfo mu c
case info of
AbsFun (Yes ty) _ -> return $ redirectTerm m ty
AbsCat _ _ -> return typeType
@@ -92,7 +92,7 @@ lookupParams gr = look True where
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
ResParam (Yes ps) -> return ps
---- ResParam Nope -> if isTop then lookExt m c
@@ -149,7 +149,7 @@ lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
AbsFun _ (Yes t) -> return $ return t
AnyInd _ n -> lookupAbsDef gr n c
@@ -165,7 +165,7 @@ lookupLincat gr m c = do
mi <- lookupModule gr m
case mi of
ModMod mo -> do
- info <- lookupInfo mo c
+ info <- lookupIdentInfo mo c
case info of
CncCat (Yes t) _ _ -> return t
AnyInd _ n -> lookupLincat gr n c
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 234bd8394..db05f95a0 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:22:25 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.19 $
+-- > CVS $Date: 2005/04/28 16:42:49 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.20 $
--
-- Macros for constructing and analysing source code terms.
--
@@ -309,6 +309,9 @@ isPredefConstant t = case t of
Q (IC "PredefAbs") _ -> True
_ -> False
+isPredefAbsType :: Ident -> Bool
+isPredefAbsType c = elem c [zIdent "Int", zIdent "String"]
+
mkSelects :: Term -> [Term] -> Term
mkSelects t tt = foldl S t tt
diff --git a/src/GF/Grammar/PrGrammar.hs b/src/GF/Grammar/PrGrammar.hs
index 297790a76..3d1404660 100644
--- a/src/GF/Grammar/PrGrammar.hs
+++ b/src/GF/Grammar/PrGrammar.hs
@@ -5,9 +5,9 @@
-- Stability : (stable)
-- Portability : (portable)
--
--- > CVS $Date: 2005/04/21 16:22:27 $
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.13 $
+-- > CVS $Date: 2005/04/28 16:42:49 $
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.14 $
--
-- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003
--
@@ -29,7 +29,8 @@ module GF.Grammar.PrGrammar (Print(..),
tree2string, prprTree,
prConstrs, prConstraints,
prMetaSubst, prEnv, prMSubst,
- prExp, prPatt, prOperSignature
+ prExp, prPatt, prOperSignature,
+ lookupIdent, lookupIdentInfo
) where
import GF.Data.Operations
@@ -266,3 +267,13 @@ 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
+
+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 :: Module Ident f a -> Ident -> Err a
+lookupIdentInfo mo i = lookupIdent i (jments mo)