1
0
forked from GitHub/gf-core

library adjustments, error message clean-up

This commit is contained in:
aarne
2005-04-28 15:42:47 +00:00
parent 8b7e450f1c
commit 830f7c14bc
14 changed files with 354 additions and 339 deletions

View File

@@ -1,10 +1,10 @@
#! /bin/sh
# 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
GF=$GFHOME/gf
JGUILIB=$GFHOME/src/JavaGUI
GF=$GFHOME/bin/gf
JGUI=GFEditor2
java -cp $JGUILIB $JGUI "$GF -java $*"

View File

@@ -1,4 +1,4 @@
--# -path=.:../prelude
--# -path=.:../../lib/prelude
concrete ImperC of Imper = open ResImper in {
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 {
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,
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:
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.

View File

@@ -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,",

View File

@@ -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

View File

@@ -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'

View File

@@ -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

View File

@@ -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

View File

@@ -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

View File

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

View File

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

View File

@@ -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