GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' of https://github.com/GrammaticalFramework/gf-core

Browse Source
This commit is contained in:
krangelov
2019-05-27 09:06:11 +02:00
parent 8b9719bd2d b7249adf63
commit 8df2121650
14 changed files with 600 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
bin/template.html
View File

@@ -80,7 +80,11 @@ $body$
<ul class="list-unstyled">
<li><a href="https://www.youtube.com/watch?v=x1LFbDQhbso">Google Tech Talk</a></li>
<li><a href="http://cloud.grammaticalframework.org/">GF Cloud</a></li>
<li><a href="$rel-root$/doc/tutorial/gf-tutorial.html">Tutorial</a></li>
<li>
<a href="$rel-root$/doc/tutorial/gf-tutorial.html">Tutorial</a>
/
<a href="$rel-root$/lib/doc/rgl-tutorial/index.html">RGL Tutorial</a>
</li>
<li><a href="$rel-root$/download"><strong>Download GF</strong></a></li>
</ul>
</div>

10
bin/update_html
View File

@@ -87,7 +87,7 @@ function render_t2t_html {
# Render markdown into html file
# Arguments:
# 1. markdown source file, e.g. download/index.md
# 2. html target filen, e.g. download/index.html
# 2. html target file, e.g. download/index.html
function render_md_html {
md="$1"
html="$2"
@@ -113,11 +113,17 @@ function render_md_html {
# Final post-processing
if [ -f "$html" ] ; then
sed -i.bak "s/<table/<table class=\"table\"/" "$html" && rm "$html.bak"
# add "table" class to tables
sed -i.bak "s/<table/<table class=\"table\"/" "$html"
# rewrite anchors that Pandoc 1.16 ignores: [content]{#anchor} -> <span id="anchor">content</span>
sed -i.bak -E "s/\[(.*)\]\{#(.+)\}/<span id=\"\2\">\1<\/span>/" "$html"
rm -f "$html.bak"
echo "$html"
fi
}
# Main entry point
# Script can be run in one of two modes:
if [ $# -gt 0 ] ; then
# Render specific file(s) from args, ignoring dates
for file in "$@" ; do

551
doc/error-messages.txt Normal file
View File

@@ -0,0 +1,551 @@
Compiler.hs
mainGFC :: Options -> [FilePath] -> IO ()
_ | null fs -> fail $ "No input files."
_ | all (extensionIs ".pgf") fs -> unionPGFFiles opts fs
_ -> fail $ "Don't know what to do with these input files: " ++ unwords fs)
----------------------------------------
Compile.hs
compileModule
case length file1s of
0 -> raise (render ("Unable to find: " $$ nest 2 candidates))
1 -> do return $ head file1s
_ -> do putIfVerb opts1 ("matched multiple candidates: " +++ show file1s)
return $ head file1s
else raise (render ("File" <+> file <+> "does not exist"))
---------------------------------------
Grammar.Lexer.x
token :: P Token
AlexError (AI pos _ _) -> PFailed pos "lexical error"
---------------------------------------
Grammar.Parser.y
happyError = fail "syntax error"
tryLoc (c,mty,Just e) = return (c,(mty,e))
tryLoc (c,_ ,_ ) = fail ("local definition of" +++ showIdent c +++ "without value")
mkR [] = return $ RecType [] --- empty record always interpreted as record type
mkR fs@(f:_) =
case f of
(lab,Just ty,Nothing) -> mapM tryRT fs >>= return . RecType
_ -> mapM tryR fs >>= return . R
where
tryRT (lab,Just ty,Nothing) = return (ident2label lab,ty)
tryRT (lab,_ ,_ ) = fail $ "illegal record type field" +++ showIdent lab --- manifest fields ?!
tryR (lab,mty,Just t) = return (ident2label lab,(mty,t))
tryR (lab,_ ,_ ) = fail $ "illegal record field" +++ showIdent lab
---------------------------------------
ModDeps.hs
mkSourceGrammar :: [SourceModule] -> Err SourceGrammar
deplist <- either
return
(\ms -> Bad $ "circular modules" +++ unwords (map show ms)) $
checkUniqueImportNames :: [Ident] -> SourceModInfo -> Err ()
test ms = testErr (all (`notElem` ns) ms)
("import names clashing with module names among" +++ unwords (map prt ms))
moduleDeps :: [SourceModule] -> Err Dependencies
deps (c,m) = errIn ("checking dependencies of module" +++ prt c) $ case mtype m of
MTConcrete a -> do
am <- lookupModuleType gr a
testErr (mtype am == MTAbstract) "the of-module is not an abstract syntax"
testErr (all (compatMType ety . mtype) ests) "inappropriate extension module type"
---------------------------------------
Update.hs
buildAnyTree
Just i -> case unifyAnyInfo m i j of
Ok k -> go (Map.insert c k map) is
Bad _ -> fail $ render ("conflicting information in module"<+>m $$
nest 4 (ppJudgement Qualified (c,i)) $$
"and" $+$
nest 4 (ppJudgement Qualified (c,j)))
extendModule
unless (sameMType (mtype m) (mtype mo))
(checkError ("illegal extension type to module" <+> name))
rebuildModule
unless (null is || mstatus mi == MSIncomplete)
(checkError ("module" <+> i <+>
"has open interfaces and must therefore be declared incomplete"))
unless (isModRes m1)
(checkError ("interface expected instead of" <+> i0))
js' <- extendMod gr False ((i0,m1), isInherited mincl) i (jments mi)
unless (stat' == MSComplete || stat == MSIncomplete)
(checkError ("module" <+> i <+> "remains incomplete"))
extendMod
checkError ("cannot unify the information" $$
nest 4 (ppJudgement Qualified (c,i)) $$
"in module" <+> name <+> "with" $$
nest 4 (ppJudgement Qualified (c,j)) $$
"in module" <+> base)
unifyAnyInfo
(ResValue (L l1 t1), ResValue (L l2 t2))
| t1==t2 -> return (ResValue (L l1 t1))
| otherwise -> fail ""
(AnyInd b1 m1, AnyInd b2 m2) -> do
testErr (b1 == b2) $ "indirection status"
testErr (m1 == m2) $ "different sources of indirection"
unifAbsDefs _ _ = fail ""
----------------------------------
Rename.hs
renameIdentTerm'
_ -> case lookupTreeManyAll showIdent opens c of
[f] -> return (f c)
[] -> alt c ("constant not found:" <+> c $$
"given" <+> fsep (punctuate ',' (map fst qualifs)))
ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
"conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
"given" <+> fsep (punctuate ',' (map fst qualifs)))
return t
renameInfo
renLoc ren (L loc x) =
checkInModule cwd mi loc ("Happened in the renaming of" <+> i) $ do
renameTerm
| otherwise -> checks [ renid' (Q (MN r,label2ident l)) -- .. and qualified expression second.
, renid' t >>= \t -> return (P t l) -- try as a constant at the end
, checkError ("unknown qualified constant" <+> trm)
]
renamePattern env patt =
do r@(p',vs) <- renp patt
let dupl = vs \\ nub vs
unless (null dupl) $ checkError (hang ("[C.4.13] Pattern is not linear:") 4
patt)
return r
case c' of
Q d -> renp $ PM d
_ -> checkError ("unresolved pattern" <+> patt)
Q _ -> checkError ("data constructor expected but" <+> ppTerm Qualified 0 c' <+> "is found instead")
_ -> checkError ("unresolved data constructor" <+> ppTerm Qualified 0 c')
PM c -> do
x <- renid (Q c)
c' <- case x of
(Q c') -> return c'
_ -> checkError ("not a pattern macro" <+> ppPatt Qualified 0 patt)
PV x -> checks [ renid' (Vr x) >>= \t' -> case t' of
QC c -> return (PP c [],[])
_ -> checkError (pp "not a constructor")
, return (patt, [x])
-----------------------------------
CheckGrammar.hs
checkRestrictedInheritance :: FilePath -> SourceGrammar -> SourceModule -> Check ()
let illegals = [(f,is) |
(f,cs) <- allDeps, incld f, let is = filter illegal cs, not (null is)]
case illegals of
[] -> return ()
cs -> checkWarn ("In inherited module" <+> i <> ", dependence of excluded constants:" $$
nest 2 (vcat [f <+> "on" <+> fsep is | (f,is) <- cs]))
checkCompleteGrammar :: Options -> FilePath -> Grammar -> Module -> Module -> Check Module
case info of
CncCat (Just (L loc (RecType []))) _ _ _ _ -> return (foldr (\_ -> Abs Explicit identW) (R []) cxt)
_ -> Bad "no def lin"
where noLinOf c = checkWarn ("no linearization of" <+> c)
Ok (CncCat Nothing md mr mp mpmcfg) -> do
checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
return $ updateTree (c,CncCat (Just (L NoLoc defLinType)) md mr mp mpmcfg) js
_ -> do
checkWarn ("no linearization type for" <+> c <> ", inserting default {s : Str}")
_ -> do checkWarn ("function" <+> c <+> "is not in abstract")
Ok (_,AbsFun {}) ->
checkError ("lincat:"<+>c<+>"is a fun, not a cat")
-}
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
checkInfo :: Options -> FilePath -> SourceGrammar -> SourceModule -> Ident -> Info -> Check Info
(Just (L loct ty), Nothing) -> do
chIn loct "operation" $
checkError (pp "No definition given to the operation")
ResOverload os tysts -> chIn NoLoc "overloading" $ do
checkUniq xss = case xss of
x:y:xs
| x == y -> checkError $ "ambiguous for type" <+>
ppType (mkFunType (tail x) (head x))
compAbsTyp g t = case t of
Vr x -> maybe (checkError ("no value given to variable" <+> x)) return $ lookup x g
checkReservedId x =
when (isReservedWord x) $
checkWarn ("reserved word used as identifier:" <+> x)
--------------------------------
TypeCheck/Abstract.hs
grammar2theory :: SourceGrammar -> Theory
Bad s -> case lookupCatContext gr m f of
Ok cont -> return $ cont2val cont
_ -> Bad s
--------------------------------
TypeCheck/ConcreteNew.hs
-- Concrete.hs has all its code commented out
--------------------------------
TypeCheck/RConcrete.hs
-- seems to be used more than ConcreteNew
computeLType :: SourceGrammar -> Context -> Type -> Check Type
AdHocOverload ts -> do
over <- getOverload gr g (Just typeType) t
case over of
Just (tr,_) -> return tr
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 t)
inferLType :: SourceGrammar -> Context -> Term -> Check (Term, Type)
Q (m,ident) | isPredef m -> termWith trm $ case typPredefined ident of
Nothing -> checkError ("unknown in Predef:" <+> ident)
Q ident -> checks [
checkError ("cannot infer type of constant" <+> ppTerm Unqualified 0 trm)
]
QC ident -> checks [
checkError ("cannot infer type of canonical constant" <+> ppTerm Unqualified 0 trm)
]
Vr ident -> termWith trm $ checkLookup ident g
AdHocOverload ts -> do
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
App f a -> do
case fty' of
Prod bt z arg val -> do
_ -> checkError ("A function type is expected for" <+> ppTerm Unqualified 0 f <+> "instead of type" <+> ppType fty)
S f x -> do
_ -> checkError ("table lintype expected for the table in" $$ nest 2 (ppTerm Unqualified 0 trm))
P t i -> do
Nothing -> checkError ("unknown label" <+> i <+> "in" $$ nest 2 (ppTerm Unqualified 0 ty'))
_ -> checkError ("record type expected for:" <+> ppTerm Unqualified 0 t $$
" instead of the inferred:" <+> ppTerm Unqualified 0 ty')
R r -> do
checkCond ("cannot infer type of record" $$ nest 2 (ppTerm Unqualified 0 trm)) (length ts == length fsts)
T ti pts -> do -- tries to guess: good in oper type inference
[] -> checkError ("cannot infer table type of" <+> ppTerm Unqualified 0 trm)
---- hack from Rename.identRenameTerm, to live with files with naming conflicts 18/6/2007
Strs (Cn c : ts) | c == cConflict -> do
checkWarn ("unresolved constant, could be any of" <+> hcat (map (ppTerm Unqualified 0) ts))
ExtR r s -> do
case (rT', sT') of
(RecType rs, RecType ss) -> do
_ -> checkError ("records or record types expected in" <+> ppTerm Unqualified 0 trm)
_ -> checkError ("cannot infer lintype of" <+> ppTerm Unqualified 0 trm)
getOverload :: SourceGrammar -> Context -> Maybe Type -> Term -> Check (Maybe (Term,Type))
matchOverload f typs ttys = do
checkWarn $ "ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot $$
"for" $$
nest 2 (showTypes tys) $$
"using" $$
nest 2 (showTypes pre)
([],[]) -> do
checkError $ "no overload instance of" <+> ppTerm Unqualified 0 f $$
"for" $$
nest 2 stysError $$
"among" $$
nest 2 (vcat stypsError) $$
maybe empty (\x -> "with value type" <+> ppType x) mt
([],[(val,fun)]) -> do
checkWarn ("ignoring lock fields in resolving" <+> ppTerm Unqualified 0 ot)
(nps1,nps2) -> do
checkWarn $ "ambiguous overloading of" <+> ppTerm Unqualified 0 f <+>
---- "with argument types" <+> hsep (map (ppTerm Qualified 0) tys) $$
"resolved by selecting the first of the alternatives" $$
nest 2 (vcat [ppTerm Qualified 0 fun | (_,ty,fun) <- vfs1 ++ if null vfs1 then vfs2 else []])
case [(mkApp fun tts,val) | (val,fun) <- nps1 ++ nps2] of
[] -> checkError $ "no alternatives left when resolving" <+> ppTerm Unqualified 0 f
checkLType :: SourceGrammar -> Context -> Term -> Type -> Check (Term, Type)
Abs bt x c -> do
case typ of
Prod bt' z a b -> do
_ -> checkError $ "function type expected instead of" <+> ppType typ
AdHocOverload ts -> do
_ -> checkError ("unresolved overloading of constants" <+> ppTerm Qualified 0 trm)
T _ [] ->
checkError ("found empty table in type" <+> ppTerm Unqualified 0 typ)
T _ cs -> case typ of
else checkWarn ("patterns never reached:" $$
nest 2 (vcat (map (ppPatt Unqualified 0) ps)))
_ -> checkError $ "table type expected for table instead of" $$ nest 2 (ppType typ)
V arg0 vs ->
if length vs1 == length vs
then return ()
else checkError $ "wrong number of values in table" <+> ppTerm Unqualified 0 trm
R r -> case typ of --- why needed? because inference may be too difficult
RecType rr -> do
_ -> checkError ("record type expected in type checking instead of" $$ nest 2 (ppTerm Unqualified 0 typ))
ExtR r s -> case typ of
case trm' of
RecType _ -> termWith trm' $ return typeType
ExtR (Vr _) (RecType _) -> termWith trm' $ return typeType
-- ext t = t ** ...
_ -> checkError ("invalid record type extension" <+> nest 2 (ppTerm Unqualified 0 trm))
case typ2 of
RecType ss -> return $ map fst ss
_ -> checkError ("cannot get labels from" $$ nest 2 (ppTerm Unqualified 0 typ2))
_ -> checkError ("record extension not meaningful for" <+> ppTerm Unqualified 0 typ)
S tab arg -> checks [ do
_ -> checkError ("table type expected for applied table instead of" <+> ppType ty')
_ -> do
(trm',ty') <- inferLType gr g trm
termWith trm' $ checkEqLType gr g typ ty' trm'
checkM rms (l,ty) = case lookup l rms of
_ -> checkError $
if isLockLabel l
then let cat = drop 5 (showIdent (label2ident l))
in ppTerm Unqualified 0 (R rms) <+> "is not in the lincat of" <+> cat <>
"; try wrapping it with lin" <+> cat
else "cannot find value for label" <+> l <+> "in" <+> ppTerm Unqualified 0 (R rms)
checkEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check Type
False -> checkError $ s <+> "type of" <+> ppTerm Unqualified 0 trm $$
"expected:" <+> ppTerm Qualified 0 t $$ -- ppqType t u $$
"inferred:" <+> ppTerm Qualified 0 u -- ppqType u t
checkIfEqLType :: SourceGrammar -> Context -> Type -> Type -> Term -> Check (Bool,Type,Type,String)
Ok lo -> do
checkWarn $ "missing lock field" <+> fsep lo
missingLock g t u = case (t,u) of
_:_ -> Bad $ render ("missing record fields:" <+> fsep (punctuate ',' (others)))
pattContext :: SourceGrammar -> Context -> Type -> Patt -> Check Context
checkCond ("wrong number of arguments for constructor in" <+> ppPatt Unqualified 0 p)
(length cont == length ps)
PR r -> do
_ -> checkError ("record type expected for pattern instead of" <+> ppTerm Unqualified 0 typ')
PAlt p' q -> do
g1 <- pattContext env g typ p'
g2 <- pattContext env g typ q
let pts = nub ([x | pt@(_,x,_) <- g1, notElem pt g2] ++ [x | pt@(_,x,_) <- g2, notElem pt g1])
checkCond
("incompatible bindings of" <+>
fsep pts <+>
"in pattern alterantives" <+> ppPatt Unqualified 0 p) (null pts)
return g1 -- must be g1 == g2
noBind typ p' = do
co <- pattContext env g typ p'
if not (null co)
then checkWarn ("no variable bound inside pattern" <+> ppPatt Unqualified 0 p)
>> return []
else return []
checkLookup :: Ident -> Context -> Check Type -- used for looking up Vr x type in context
[] -> checkError ("unknown variable" <+> x)
-------------------------------
Grammar/Lookup.hs
lookupIdent :: ErrorMonad m => Ident -> BinTree Ident b -> m b
Bad _ -> raise ("unknown identifier" +++ showIdent c)
lookupResDefLoc
_ -> raise $ render (c <+> "is not defined in resource" <+> m)
lookupResType :: ErrorMonad m => Grammar -> QIdent -> m Type
_ -> raise $ render (c <+> "has no type defined in resource" <+> m)
lookupOverloadTypes :: ErrorMonad m => Grammar -> QIdent -> m [(Term,Type)]
_ -> raise $ render (c <+> "has no types defined in resource" <+> m)
lookupOverload :: ErrorMonad m => Grammar -> QIdent -> m [([Type],(Type,Term))]
_ -> raise $ render (c <+> "is not an overloaded operation")
lookupParamValues :: ErrorMonad m => Grammar -> QIdent -> m [Term]
case info of
ResParam _ (Just pvs) -> return pvs
_ -> raise $ render (ppQIdent Qualified c <+> "has no parameter values defined")
allParamValues :: ErrorMonad m => Grammar -> Type -> m [Term]
_ -> raise (render ("cannot find parameter values for" <+> ptyp))
lookupFunType :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m Type
_ -> raise (render ("cannot find type of" <+> c))
lookupCatContext :: ErrorMonad m => Grammar -> ModuleName -> Ident -> m Context
_ -> raise (render ("unknown category" <+> c))
-------------------------
PatternMatch.hs
matchPattern :: ErrorMonad m => [(Patt,rhs)] -> Term -> m (rhs, Substitution)
if not (isInConstantForm term)
then raise (render ("variables occur in" <+> pp term))
findMatch :: ErrorMonad m => [([Patt],rhs)] -> [Term] -> m (rhs, Substitution)
[] -> raise (render ("no applicable case for" <+> hsep (punctuate ',' terms)))
(patts,_):_ | length patts /= length terms ->
raise (render ("wrong number of args for patterns :" <+> hsep patts <+>
"cannot take" <+> hsep terms))
tryMatch :: (Patt, Term) -> Err [(Ident, Term)]
(PNeg p',_) -> case tryMatch (p',t) of
Bad _ -> return []
_ -> raise (render ("no match with negative pattern" <+> p))
---------------------------------------------
Compile.Optimize.hs
mkLinDefault :: SourceGrammar -> Type -> Err Term
_ -> Bad (render ("no parameter values given to type" <+> ppQIdent Qualified p))
_ -> Bad (render ("linearization type field cannot be" <+> typ))
mkLinReference :: SourceGrammar -> Type -> Err Term
[] -> Bad "no string"
---------------------------------------------
Compile.Compute.Concrete.hs
nfx env@(GE _ _ _ loc) t = do
Left i -> fail ("variable #"++show i++" is out of scope")
var :: CompleteEnv -> Ident -> Err OpenValue
var env x = maybe unbound pick' (elemIndex x (local env))
where
unbound = fail ("Unknown variable: "++showIdent x)
pick' i = return $ \ vs -> maybe (err i vs) ok (pick i vs)
err i vs = bug $ "Stack problem: "++showIdent x++": "
++unwords (map showIdent (local env))
++" => "++show (i,length vs)
resource env (m,c) =
where e = fail $ "Not found: "++render m++"."++showIdent c
extR t vv =
(VRecType rs1, VRecType rs2) ->
case intersect (map fst rs1) (map fst rs2) of
[] -> VRecType (rs1 ++ rs2)
ls -> error $ "clash"<+>show ls
(v1,v2) -> error $ "not records" $$ show v1 $$ show v2
where
error explain = ppbug $ "The term" <+> t
<+> "is not reducible" $$ explain
glue env (v1,v2) = glu v1 v2
ppL loc (hang "unsupported token gluing:" 4
(Glue (vt v1) (vt v2)))
strsFromValue :: Value -> Err [Str]
_ -> fail ("cannot get Str from value " ++ show t)
match loc cs v =
case value2term loc [] v of
Left i -> bad ("variable #"++show i++" is out of scope")
Right t -> err bad return (matchPattern cs t)
where
bad = fail . ("In pattern matching: "++)
inlinePattMacro p =
VPatt p' -> inlinePattMacro p'
_ -> ppbug $ hang "Expected pattern macro:" 4
linPattVars p =
if null dups
then return pvs
else fail.render $ hang "Pattern is not linear:" 4 (ppPatt Unqualified 0 p)
---------------------------------------------
Compile.Compute.Abstract.hs
---------------------------------------------
PGF.Linearize.hs
bracketedLinearize :: PGF -> Language -> Tree -> [BracketedString]
cnc = lookMap (error "no lang") lang (concretes pgf)
---------------------------------------------
PGF.TypeCheck.hs
ppTcError :: TcError -> Doc
ppTcError (UnknownCat cat) = text "Category" <+> ppCId cat <+> text "is not in scope"
ppTcError (UnknownFun fun) = text "Function" <+> ppCId fun <+> text "is not in scope"
ppTcError (WrongCatArgs xs ty cat m n) = text "Category" <+> ppCId cat <+> text "should have" <+> int m <+> text "argument(s), but has been given" <+> int n $$
text "In the type:" <+> ppType 0 xs ty
ppTcError (TypeMismatch xs e ty1 ty2) = text "Couldn't match expected type" <+> ppType 0 xs ty1 $$
text " against inferred type" <+> ppType 0 xs ty2 $$
text "In the expression:" <+> ppExpr 0 xs e
ppTcError (NotFunType xs e ty) = text "A function type is expected for the expression" <+> ppExpr 0 xs e <+> text "instead of type" <+> ppType 0 xs ty
ppTcError (CannotInferType xs e) = text "Cannot infer the type of expression" <+> ppExpr 0 xs e
ppTcError (UnresolvedMetaVars xs e ms) = text "Meta variable(s)" <+> fsep (List.map ppMeta ms) <+> text "should be resolved" $$
text "in the expression:" <+> ppExpr 0 xs e
ppTcError (UnexpectedImplArg xs e) = braces (ppExpr 0 xs e) <+> text "is implicit argument but not implicit argument is expected here"
ppTcError (UnsolvableGoal xs metaid ty)= text "The goal:" <+> ppMeta metaid <+> colon <+> ppType 0 xs ty $$
text "cannot be solved"

6
doc/gf-refman.md
View File

@@ -72,7 +72,7 @@ concrete syntax. Tree formation in abstract syntax, however, is fully
recursive.
Even though run-time GF grammars manipulate just nested tuples, at
compile time these are represented by by the more fine-grained labelled
compile time these are represented by the more fine-grained labelled
records and finite functions over algebraic datatypes. This enables the
programmer to write on a higher abstraction level, and also adds type
distinctions and hence raises the level of checking of programs.
@@ -99,7 +99,7 @@ module looks as follows:
}
Here are two concrete syntax modules, one intended for mapping the trees
to English, the other to Swedish. The mappling is defined by `lincat`
to English, the other to Swedish. The mapping is defined by `lincat`
definitions assigning a **linearization type** to each category, and
`lin` definitions assigning a **linearization** to each function.
@@ -2515,7 +2515,7 @@ The reserved words used in GF are the following:
- `transfer`
- `variants`
- `where`
- `with`
- `with`
The symbols used in GF are the following:

1
doc/index.md
View File

@@ -6,6 +6,7 @@ Perhaps you're looking for one of the following:
- [Tutorial](tutorial/gf-tutorial.html). This is a hands-on introduction to grammar writing in GF.
- [Reference Manual](gf-refman.html). A full-scale reference manual of the GF language.
- [RGL Tutorial](../lib/doc/rgl-tutorial/index.html)
- [RGL Synopsis](../lib/doc/synopsis/index.html). Documentation of the Resource Grammar Library, including the syntax API and lexical paradigms for each language.
- [Shell Reference](gf-shell-reference.html). Describes the commands available in the interactive GF shell.
Also summarizes how to run GF as a batch compiler.

4
doc/tutorial/gf-tutorial.t2t
View File

@@ -4963,12 +4963,12 @@ syntax name. This file contains the multilingual grammar as a JavaScript object.
===Using the JavaScript grammar===
To perform parsing and linearization, the run-time library
``gflib.js`` is used. It is included in ``GF/lib/javascript/``, together with
``gflib.js`` is used. It is included in ``/src/runtime/javascript/``, together with
some other JavaScript and HTML files; these files can be used
as templates for building applications.
An example of usage is
[``translator.html`` http://grammaticalframework.org:41296],
[``translator.html`` ../../src/runtime/javascript/translator.html],
which is in fact initialized with
a pointer to the Food grammar, so that it provides translation between the English
and Italian grammars:

2
gf.cabal
View File

@@ -142,7 +142,7 @@ Library
---- GF compiler as a library:
build-depends: filepath, directory, time, time-compat,
build-depends: filepath, directory>=1.2, time,
process, haskeline, parallel>=3, json
hs-source-dirs: src/compiler

8
index.html
View File

@@ -34,7 +34,11 @@
<img src="http://www.grammaticalframework.org/src/www/P/gf-cloud.png" style="height:30px" class="ml-2" alt="Cloud logo">
</a>
</li>
<li><a href="doc/tutorial/gf-tutorial.html">Tutorial</a></li>
<li>
<a href="doc/tutorial/gf-tutorial.html">Tutorial</a>
/
<a href="lib/doc/rgl-tutorial/index.html">RGL Tutorial</a>
</li>
</ul>
<a href="download/index.html" class="btn btn-primary ml-3">
@@ -363,7 +367,7 @@ least one, it may help you to get a first idea of what GF is.
<p>
Adding a language to the resource library takes 3 to 9
months - contributions
are welcome! You can start with the <a href="doc/gf-lrec-2010.pdf">resource grammarian's tutorial</a>.
are welcome! You can start with the <a href="lib/doc/rgl-tutorial/index.html">resource grammarian's tutorial</a>.
</p>
</div><!-- .col-6 -->

16
src/compiler/GF/Compile/CheckGrammar.hs
View File

@@ -147,11 +147,17 @@ checkCompleteGrammar opts cwd gr (am,abs) (cm,cnc) = checkInModule cwd cnc NoLoc
return $ updateTree (c,CncFun (Just linty) d mn mf) js
_ -> do checkWarn ("function" <+> c <+> "is not in abstract")
return js
CncCat _ _ _ _ _ -> case lookupOrigInfo gr (am,c) of
Ok _ -> return $ updateTree i js
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
return js
_ -> return $ updateTree i js
CncCat {} ->
case lookupOrigInfo gr (am,c) of
Ok (_,AbsCat _) -> return $ updateTree i js
{- -- This might be too pedantic:
Ok (_,AbsFun {}) ->
checkError ("lincat:"<+>c<+>"is a fun, not a cat")
-}
_ -> do checkWarn ("category" <+> c <+> "is not in abstract")
return js
_ -> return $ updateTree i js
-- | General Principle: only Just-values are checked.

11
src/compiler/GF/Compile/TypeCheck/RConcrete.hs
View File

@@ -360,12 +360,13 @@ getOverload gr g mt ot = case appForm ot of
nest 2 (showTypes pre)
return (mkApp fun tts, val)
([],[]) -> do
checkError $ "no overload instance of" <+> ppTerm Unqualified 0 f $$
"for" $$
checkError $ "no overload instance of" <+> ppTerm Qualified 0 f $$
maybe empty (\x -> "with value type" <+> ppType x) mt $$
"for argument list" $$
nest 2 stysError $$
"among" $$
nest 2 (vcat stypsError) $$
maybe empty (\x -> "with value type" <+> ppType x) mt
"among alternatives" $$
nest 2 (vcat stypsError)
(vfs1,vfs2) -> case (noProds vfs1,noProds vfs2) of
([(val,fun)],_) -> do

4
src/compiler/GF/System/Directory.hs
View File

@@ -8,13 +8,13 @@ import System.Directory as D
doesDirectoryExist,doesFileExist,getModificationTime,
getCurrentDirectory,getDirectoryContents,getPermissions,
removeFile,renameFile)
import Data.Time.Compat
--import Data.Time.Compat
canonicalizePath path = liftIO $ D.canonicalizePath path
createDirectoryIfMissing b = liftIO . D.createDirectoryIfMissing b
doesDirectoryExist path = liftIO $ D.doesDirectoryExist path
doesFileExist path = liftIO $ D.doesFileExist path
getModificationTime path = liftIO $ fmap toUTCTime (D.getModificationTime path)
getModificationTime path = liftIO $ {-fmap toUTCTime-} (D.getModificationTime path)
getDirectoryContents path = liftIO $ D.getDirectoryContents path
getCurrentDirectory :: MonadIO io => io FilePath

2
src/runtime/javascript/grammar.js
View File

File diff suppressed because one or more lines are too long

2
src/runtime/javascript/translator.html
View File

@@ -32,7 +32,7 @@
</script>
<title>Web-based GF Translator</title>
</head>
<body onload="populateLangs(Food, 'fromLang', 'toLang')">
<body onload="populateLangs(grammar, 'fromLang', 'toLang')">
<form id="translate">
<p>
<input type="text" name="inputText" id="inputText" value="this cheese is warm" size="50" />

4
src/server/Cache.hs
View File

@@ -9,7 +9,7 @@ import Data.Maybe(mapMaybe)
import System.Directory (getModificationTime)
import System.Mem(performGC)
import Data.Time (UTCTime,getCurrentTime,diffUTCTime)
import Data.Time.Compat (toUTCTime)
--import Data.Time.Compat (toUTCTime)
data Cache a = Cache {
cacheLoad :: FilePath -> IO a,
@@ -63,7 +63,7 @@ readCache' c file =
Nothing -> do v <- newMVar Nothing
return (Map.insert file v objs, v)
-- Check time stamp, and reload if different than the cache entry
readObject m = do t' <- toUTCTime `fmap` getModificationTime file
readObject m = do t' <- {-toUTCTime `fmap`-} getModificationTime file
now <- getCurrentTime
x' <- case m of
Just (t,_,x) | t' == t -> return x