forked from GitHub/gf-core
library adjustments, error message clean-up
This commit is contained in:
6
bin/jgf
6
bin/jgf
@@ -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 $*"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
--# -path=.:../prelude
|
||||
--# -path=.:../../lib/prelude
|
||||
concrete ImperC of Imper = open ResImper in {
|
||||
flags lexer=codevars ; unlexer=code ; startcat=Program ;
|
||||
|
||||
|
||||
@@ -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
@@ -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.
|
||||
|
||||
|
||||
12
src/GF.hs
12
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,",
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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'
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -81,7 +81,7 @@ ghci-nofud:
|
||||
$(GHCI) $(GHCFLAGS)
|
||||
|
||||
today:
|
||||
tools/mktoday.sh
|
||||
tools/mktoday.sh $(PACKAGE_VERSION)
|
||||
|
||||
javac:
|
||||
$(JAVAC) $(JAVAFLAGS) JavaGUI/*.java
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user