library adjustments, error message clean-up

src/GF.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stability)
 -- Portability : (portability)
 --
--- > CVS $Date: 2005/04/21 16:45:56 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.22 $
+-- > CVS $Date: 2005/04/28 16:42:48 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.23 $
 --
 -- The Main module of GF program.
 -----------------------------------------------------------------------------
@@ -27,12 +27,12 @@ import GF.Shell.PShell
 import GF.Shell.JGF
 import GF.Text.UTF8
 
-import GF.Today (today)
+import GF.Today (today,version)
 import GF.System.Arch
 import System (getArgs)
 import Control.Monad (foldM)
 
--- AR 19/4/2000 -- 11/11/2001
+-- AR 19/4/2000 -- 28/4/2005
 
 main :: IO ()
 main = do
@@ -89,7 +89,7 @@ welcomeMsg =
   "Welcome to " ++ authorMsg ++++ welcomeArch ++ "\n\nType 'h' for help."
 
 authorMsg = unlines [
- "Grammatical Framework, Version 2.1.2b",
+ "Grammatical Framework, Version " ++ version,
  "Compiled " ++ today,
  "Copyright (c)", 
  "Björn Bringert, Markus Forsberg, Thomas Hallgren, Harald Hammarström,",

src/GF/Canon/Look.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/21 16:21:25 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.12 $
+-- > CVS $Date: 2005/04/28 16:42:48 $ 
+-- > CVS $Author: aarne $
+-- > CVS $Revision: 1.13 $
 --
 -- lookup in GFC. AR 2003
 -----------------------------------------------------------------------------
@@ -46,7 +46,7 @@ lookupCncInfo gr f@(CIQ m c) = do
   mt <- M.lookupModule gr m
   case mt of
     M.ModMod a -> errIn ("module" +++ prt m) $ 
-                  lookupTree prt c $ M.jments a 
+                  lookupIdent c $ M.jments a 
     _ -> prtBad "not concrete module" m
 
 lookupLin :: CanonGrammar -> CIdent -> Err Term
@@ -77,7 +77,7 @@ lookupResInfo :: CanonGrammar -> CIdent -> Err Info
 lookupResInfo gr f@(CIQ m c) = do
   mt <- M.lookupModule gr m
   case mt of
-    M.ModMod a -> lookupTree prt c $ M.jments a 
+    M.ModMod a -> lookupIdent c $ M.jments a 
     _ -> prtBad "not resource module" m
 
 lookupGlobal :: CanonGrammar -> CIdent -> Err Term

src/GF/Compile/CheckGrammar.hs

@@ -5,9 +5,9 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/04/25 18:19:32 $ 
+-- > CVS $Date: 2005/04/28 16:42:48 $ 
 -- > CVS $Author: aarne $
--- > CVS $Revision: 1.24 $
+-- > CVS $Revision: 1.25 $
 --
 -- AR 4\/12\/1999 -- 1\/4\/2000 -- 8\/9\/2001 -- 15\/5\/2002 -- 27\/11\/2002 -- 18\/6\/2003
 --
@@ -125,12 +125,12 @@ checkCompleteGrammar abs cnc = do
   foldM checkOne js fs
  where
    checkOne js i@(c,info) = case info of
-     AbsFun (Yes _) _ -> case lookupTree prt c js of
+     AbsFun (Yes _) _ -> case lookupIdent c js of
        Ok _ -> return js
        _ -> do
          checkWarn $ "Warning: no linearization of" +++ prt c
          return js
-     AbsCat (Yes _) _ -> case lookupTree prt c js of
+     AbsCat (Yes _) _ -> case lookupIdent c js of
        Ok _ -> return js
        _ -> do
          checkWarn $ 
@@ -259,7 +259,7 @@ computeLType gr t = do
 
     Q m c | elem c [cPredef,cPredefAbs] -> return ty
 
-    Q m ident -> checkIn ("Q" +++ show m) $ do
+    Q m ident -> checkIn ("module" +++ prt m) $ do
       ty' <- checkErr (lookupResDef gr m ident) 
       if ty' == ty then return ty else comp ty' --- is this necessary to test?
 
@@ -359,7 +359,7 @@ inferLType gr trm = case trm of
      (t',ty) <- infer t   --- ??
      ty' <- comp ty
      termWith (P t' i) $ checkErr $ case ty' of
-       RecType ts -> maybeErr ("unknown label" +++ show i +++ "in" +++ show ty') $ 
+       RecType ts -> maybeErr ("unknown label" +++ prt i +++ "in" +++ prt ty') $ 
                      lookup i ts
        _ -> prtBad ("record type expected for" +++ prt t +++ "instead of") ty'
 

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

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

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
 

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)

src/Makefile

@@ -81,7 +81,7 @@ ghci-nofud:
 	$(GHCI) $(GHCFLAGS)
 
 today:
-	tools/mktoday.sh
+	tools/mktoday.sh $(PACKAGE_VERSION)
 
 javac:
 	$(JAVAC) $(JAVAFLAGS) JavaGUI/*.java

src/tools/mktoday.sh

@@ -1,6 +1,7 @@
 #!/bin/sh
 
-echo 'module GF.Today (today) where' > GF/Today.hs
-echo 'today :: String' >> GF/Today.hs
+echo 'module GF.Today (today,version) where' > GF/Today.hs
+echo 'today,version :: String' >> GF/Today.hs
 echo 'today = "'`date`'"' >> GF/Today.hs
+echo 'version = "'$1'"' >> GF/Today.hs