library adjustments, error message clean-up

This commit is contained in:
aarne
2005-04-28 15:42:47 +00:00
parent 299bbd966b
commit bf25f1d0db
18 changed files with 360 additions and 342 deletions

View File

@@ -1,10 +1,10 @@
#! /bin/sh #! /bin/sh
# change the value of GFHOME to the directory where you have the gf binary # change the value of GFHOME to the directory where you have the gf binary
GFHOME=/home/aarne/GF/bin GFHOME=/home/aarne/GF
JGUILIB=$GFHOME/java JGUILIB=$GFHOME/src/JavaGUI
GF=$GFHOME/gf GF=$GFHOME/bin/gf
JGUI=GFEditor2 JGUI=GFEditor2
java -cp $JGUILIB $JGUI "$GF -java $*" java -cp $JGUILIB $JGUI "$GF -java $*"

View File

@@ -1,4 +1,4 @@
--# -path=.:../prelude --# -path=.:../../lib/prelude
concrete ImperC of Imper = open ResImper in { concrete ImperC of Imper = open ResImper in {
flags lexer=codevars ; unlexer=code ; startcat=Program ; flags lexer=codevars ; unlexer=code ; startcat=Program ;

View File

@@ -1,4 +1,4 @@
--# -path=.:../prelude --# -path=.:../../lib/prelude
concrete ImperJVM of Imper = open ResImper in { concrete ImperJVM of Imper = open ResImper in {
flags lexer=codevars ; unlexer=code ; startcat=Stm ; flags lexer=codevars ; unlexer=code ; startcat=Stm ;

File diff suppressed because one or more lines are too long

View File

@@ -21,13 +21,13 @@ To precompile a multilingual numeral grammar:
To open a translation session, To open a translation session,
gf numerals.gfcm -- in the OS shell gf numerals.gfcm -- in the OS shell
trans -lang -- in the GF shell ts -lang -- in the GF shell
To create an example HTML page with translations of a numeral: To create an example HTML page with translations of a numeral:
echo "x=2341" | gft numerals.gfcm >2341.html echo "x=2341" | gft numerals.gfcm >2341.html
(Requires the gft program, produces by "make gft" in GF sources) (Requires the gft program, produced by "make gft" in GF sources)
Document last updated August 3, 2004 by Aarne Ranta. Document last updated August 3, 2004 by Aarne Ranta.

3
lib/prelude/PredefCnc.gf Normal file
View File

@@ -0,0 +1,3 @@
concrete PredefCnc of PredefAbs = {
lincat Int, String = {s : Str} ;
} ;

View File

@@ -19,7 +19,7 @@
-- one has to know how the syntactic categories are -- one has to know how the syntactic categories are
-- implemented. The parameter types are defined in $TypesEng.gf$. -- implemented. The parameter types are defined in $TypesEng.gf$.
concrete CategoriesEng of Categories = open Prelude, SyntaxEng in { concrete CategoriesEng of Categories = PredefCnc ** open Prelude, SyntaxEng in {
flags flags
startcat=Phr ; startcat=Phr ;

View File

@@ -22,7 +22,7 @@
-- $TypesFra$ and $TypesIta$. -- $TypesFra$ and $TypesIta$.
incomplete concrete CategoriesRomance of Categories = incomplete concrete CategoriesRomance of Categories =
open Prelude, SyntaxRomance in { PredefCnc ** open Prelude, SyntaxRomance in {
flags flags
startcat=Phr ; optimize=all ; startcat=Phr ; optimize=all ;

View File

@@ -1,5 +1,5 @@
incomplete concrete CategoriesScand of Categories = incomplete concrete CategoriesScand of Categories =
open Prelude, SyntaxScand in { PredefCnc ** open Prelude, SyntaxScand in {
flags flags
startcat=Phr ; startcat=Phr ;

View File

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

View File

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

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/25 18:19:32 $ -- > CVS $Date: 2005/04/28 16:42:48 $
-- > CVS $Author: aarne $ -- > 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 -- 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 foldM checkOne js fs
where where
checkOne js i@(c,info) = case info of 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 Ok _ -> return js
_ -> do _ -> do
checkWarn $ "Warning: no linearization of" +++ prt c checkWarn $ "Warning: no linearization of" +++ prt c
return js return js
AbsCat (Yes _) _ -> case lookupTree prt c js of AbsCat (Yes _) _ -> case lookupIdent c js of
Ok _ -> return js Ok _ -> return js
_ -> do _ -> do
checkWarn $ checkWarn $
@@ -259,7 +259,7 @@ computeLType gr t = do
Q m c | elem c [cPredef,cPredefAbs] -> return ty 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) ty' <- checkErr (lookupResDef gr m ident)
if ty' == ty then return ty else comp ty' --- is this necessary to test? 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 --- ?? (t',ty) <- infer t --- ??
ty' <- comp ty ty' <- comp ty
termWith (P t' i) $ checkErr $ case ty' of 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 lookup i ts
_ -> prtBad ("record type expected for" +++ prt t +++ "instead of") ty' _ -> prtBad ("record type expected for" +++ prt t +++ "instead of") ty'

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/21 16:22:22 $ -- > CVS $Date: 2005/04/28 16:42:48 $
-- > CVS $Author: bringert $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.13 $ -- > CVS $Revision: 1.14 $
-- --
-- (Description of the module) -- (Description of the module)
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
@@ -48,7 +48,7 @@ lookupAbsDef gr m c = errIn ("looking up absdef of" +++ prt c) $ do
mi <- lookupModule gr m mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
C.AbsFun _ t -> return $ return t C.AbsFun _ t -> return $ return t
C.AnyInd _ n -> lookupAbsDef gr n c 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 mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
C.AbsFun t _ -> return t C.AbsFun t _ -> return t
C.AnyInd _ n -> lookupFunType gr n c 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 mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
C.AbsCat co _ -> return co C.AbsCat co _ -> return co
C.AnyInd _ n -> lookupCatContext gr n c 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 mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
C.AbsTrans t -> return t C.AbsTrans t -> return t
C.AnyInd _ n -> lookupTransfer gr n c C.AnyInd _ n -> lookupTransfer gr n c
@@ -168,7 +168,7 @@ lookupFunTypeSrc gr m c = do
mi <- lookupModule gr m mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
AbsFun (Yes t) _ -> return t AbsFun (Yes t) _ -> return t
AnyInd _ n -> lookupFunTypeSrc gr n c AnyInd _ n -> lookupFunTypeSrc gr n c
@@ -181,7 +181,7 @@ lookupCatContextSrc gr m c = do
mi <- lookupModule gr m mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
AbsCat (Yes co) _ -> return co AbsCat (Yes co) _ -> return co
AnyInd _ n -> lookupCatContextSrc gr n c AnyInd _ n -> lookupCatContextSrc gr n c

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/21 16:22:23 $ -- > CVS $Date: 2005/04/28 16:42:48 $
-- > CVS $Author: bringert $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.13 $ -- > CVS $Revision: 1.14 $
-- --
-- Lookup in source (concrete and resource) when compiling. -- Lookup in source (concrete and resource) when compiling.
-- --
@@ -39,7 +39,7 @@ lookupResDef gr = look True where
mi <- lookupModule gr m mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
ResOper _ (Yes t) -> return $ qualifAnnot m t ResOper _ (Yes t) -> return $ qualifAnnot m t
ResOper _ Nope -> return (Q m c) ---- if isTop then lookExt m c 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 mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
ResOper (Yes t) _ -> return $ qualifAnnot m t ResOper (Yes t) _ -> return $ qualifAnnot m t
ResOper (May n) _ -> lookupResType gr n c ResOper (May n) _ -> lookupResType gr n c
@@ -75,7 +75,7 @@ lookupResType gr m c = do
CncFun _ _ _ -> do CncFun _ _ _ -> do
a <- abstractOfConcrete gr m a <- abstractOfConcrete gr m
mu <- lookupModMod gr a mu <- lookupModMod gr a
info <- lookupInfo mu c info <- lookupIdentInfo mu c
case info of case info of
AbsFun (Yes ty) _ -> return $ redirectTerm m ty AbsFun (Yes ty) _ -> return $ redirectTerm m ty
AbsCat _ _ -> return typeType AbsCat _ _ -> return typeType
@@ -92,7 +92,7 @@ lookupParams gr = look True where
mi <- lookupModule gr m mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
ResParam (Yes ps) -> return ps ResParam (Yes ps) -> return ps
---- ResParam Nope -> if isTop then lookExt m c ---- 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 mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
AbsFun _ (Yes t) -> return $ return t AbsFun _ (Yes t) -> return $ return t
AnyInd _ n -> lookupAbsDef gr n c AnyInd _ n -> lookupAbsDef gr n c
@@ -165,7 +165,7 @@ lookupLincat gr m c = do
mi <- lookupModule gr m mi <- lookupModule gr m
case mi of case mi of
ModMod mo -> do ModMod mo -> do
info <- lookupInfo mo c info <- lookupIdentInfo mo c
case info of case info of
CncCat (Yes t) _ _ -> return t CncCat (Yes t) _ _ -> return t
AnyInd _ n -> lookupLincat gr n c AnyInd _ n -> lookupLincat gr n c

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/21 16:22:25 $ -- > CVS $Date: 2005/04/28 16:42:49 $
-- > CVS $Author: bringert $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.19 $ -- > CVS $Revision: 1.20 $
-- --
-- Macros for constructing and analysing source code terms. -- Macros for constructing and analysing source code terms.
-- --
@@ -309,6 +309,9 @@ isPredefConstant t = case t of
Q (IC "PredefAbs") _ -> True Q (IC "PredefAbs") _ -> True
_ -> False _ -> False
isPredefAbsType :: Ident -> Bool
isPredefAbsType c = elem c [zIdent "Int", zIdent "String"]
mkSelects :: Term -> [Term] -> Term mkSelects :: Term -> [Term] -> Term
mkSelects t tt = foldl S t tt mkSelects t tt = foldl S t tt

View File

@@ -5,9 +5,9 @@
-- Stability : (stable) -- Stability : (stable)
-- Portability : (portable) -- Portability : (portable)
-- --
-- > CVS $Date: 2005/04/21 16:22:27 $ -- > CVS $Date: 2005/04/28 16:42:49 $
-- > CVS $Author: bringert $ -- > CVS $Author: aarne $
-- > CVS $Revision: 1.13 $ -- > CVS $Revision: 1.14 $
-- --
-- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003 -- AR 7\/12\/1999 - 1\/4\/2000 - 10\/5\/2003
-- --
@@ -29,7 +29,8 @@ module GF.Grammar.PrGrammar (Print(..),
tree2string, prprTree, tree2string, prprTree,
prConstrs, prConstraints, prConstrs, prConstraints,
prMetaSubst, prEnv, prMSubst, prMetaSubst, prEnv, prMSubst,
prExp, prPatt, prOperSignature prExp, prPatt, prOperSignature,
lookupIdent, lookupIdentInfo
) where ) where
import GF.Data.Operations import GF.Data.Operations
@@ -266,3 +267,13 @@ prRefinement t = case t of
prOperSignature :: (QIdent,Type) -> String prOperSignature :: (QIdent,Type) -> String
prOperSignature (f, t) = prQIdent f +++ ":" +++ prt t 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)

View File

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

View File

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