diff --git a/bin/template.html b/bin/template.html index 881f3f2e3..15306e1d9 100644 --- a/bin/template.html +++ b/bin/template.html @@ -80,7 +80,11 @@ $body$ diff --git a/bin/update_html b/bin/update_html index 587ed6179..912ff1fa0 100755 --- a/bin/update_html +++ b/bin/update_html @@ -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/content + sed -i.bak -E "s/\[(.*)\]\{#(.+)\}/\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 diff --git a/doc/error-messages.txt b/doc/error-messages.txt new file mode 100644 index 000000000..2936ea4af --- /dev/null +++ b/doc/error-messages.txt @@ -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" + diff --git a/doc/gf-refman.md b/doc/gf-refman.md index 3ae3eb866..2a53041d9 100644 --- a/doc/gf-refman.md +++ b/doc/gf-refman.md @@ -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: diff --git a/doc/index.md b/doc/index.md index 18c4979c1..39d2c3036 100644 --- a/doc/index.md +++ b/doc/index.md @@ -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. diff --git a/doc/tutorial/gf-tutorial.t2t b/doc/tutorial/gf-tutorial.t2t index 4a6ce47ca..1af346a17 100644 --- a/doc/tutorial/gf-tutorial.t2t +++ b/doc/tutorial/gf-tutorial.t2t @@ -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: diff --git a/gf.cabal b/gf.cabal index f350b2ca1..ec889a335 100644 --- a/gf.cabal +++ b/gf.cabal @@ -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 diff --git a/index.html b/index.html index 5084c92a6..decea87d6 100644 --- a/index.html +++ b/index.html @@ -34,7 +34,11 @@ Cloud logo -
  • Tutorial
    • +
  • + Tutorial + / + RGL Tutorial +
    • @@ -363,7 +367,7 @@ least one, it may help you to get a first idea of what GF is.

    Adding a language to the resource library takes 3 to 9 months - contributions - are welcome! You can start with the resource grammarian's tutorial. + are welcome! You can start with the resource grammarian's tutorial.

    diff --git a/src/compiler/GF/Compile/CheckGrammar.hs b/src/compiler/GF/Compile/CheckGrammar.hs index 1348d8e41..5d6922704 100644 --- a/src/compiler/GF/Compile/CheckGrammar.hs +++ b/src/compiler/GF/Compile/CheckGrammar.hs @@ -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. diff --git a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs index 88e324ff3..134e71559 100644 --- a/src/compiler/GF/Compile/TypeCheck/RConcrete.hs +++ b/src/compiler/GF/Compile/TypeCheck/RConcrete.hs @@ -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 diff --git a/src/compiler/GF/System/Directory.hs b/src/compiler/GF/System/Directory.hs index 898646063..be91e758e 100644 --- a/src/compiler/GF/System/Directory.hs +++ b/src/compiler/GF/System/Directory.hs @@ -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 diff --git a/src/runtime/javascript/grammar.js b/src/runtime/javascript/grammar.js index 9e246db50..c6b2bb989 100644 --- a/src/runtime/javascript/grammar.js +++ b/src/runtime/javascript/grammar.js @@ -1 +1 @@ -var Foods = new GFGrammar(new GFAbstract("Phrase",{Boring: new Type([], "Quality"), Cheese: new Type([], "Kind"), Delicious: new Type([], "Quality"), Expensive: new Type([], "Quality"), Fish: new Type([], "Kind"), Fresh: new Type([], "Quality"), Is: new Type(["Item", "Quality"], "Phrase"), Italian: new Type([], "Quality"), Pizza: new Type([], "Kind"), QKind: new Type(["Quality", "Kind"], "Kind"), That: new Type(["Kind"], "Item"), These: new Type(["Kind"], "Item"), This: new Type(["Kind"], "Item"), Those: new Type(["Kind"], "Item"), Very: new Type(["Quality"], "Quality"), Warm: new Type([], "Quality"), Wine: new Type([], "Kind")}),{FoodsEng: new GFConcrete({},{0:[new Apply(15,[new PArg(2)]), new Apply(17,[new PArg(2)])], 1:[new Apply(16,[new PArg(2)]), new Apply(18,[new PArg(2)])], 2:[new Apply(5,[]), new Apply(8,[]), new Apply(13,[]), new Apply(14,[new PArg(4), new PArg(2)]), new Apply(21,[])], 3:[new Apply(10,[new PArg(0), new PArg(4)]), new Apply(11,[new PArg(1), new PArg(4)])], 4:[new Apply(4,[]), new Apply(6,[]), new Apply(7,[]), new Apply(9,[]), new Apply(12,[]), new Apply(19,[new PArg(4)]), new Apply(20,[])]},[new CncFun("lindef Item",[0]), new CncFun("lindef Kind",[0, 0]), new CncFun("lindef Phrase",[0]), new CncFun("lindef Quality",[0]), new CncFun("Boring",[1]), new CncFun("Cheese",[2, 3]), new CncFun("Delicious",[4]), new CncFun("Expensive",[5]), new CncFun("Fish",[6, 6]), new CncFun("Fresh",[7]), new CncFun("Is",[8]), new CncFun("Is",[9]), new CncFun("Italian",[10]), new CncFun("Pizza",[11, 12]), new CncFun("QKind",[13, 14]), new CncFun("That",[15]), new CncFun("These",[16]), new CncFun("This",[17]), new CncFun("Those",[18]), new CncFun("Very",[19]), new CncFun("Warm",[20]), new CncFun("Wine",[21, 22])],[[new SymLit(0, 0)],[new SymKS("boring")],[new SymKS("cheese")],[new SymKS("cheeses")],[new SymKS("delicious")],[new SymKS("expensive")],[new SymKS("fish")],[new SymKS("fresh")],[new SymCat(0, 0), new SymKS("is"), new SymCat(1, 0)],[new SymCat(0, 0), new SymKS("are"), new SymCat(1, 0)],[new SymKS("Italian")],[new SymKS("pizza")],[new SymKS("pizzas")],[new SymCat(0, 0), new SymCat(1, 0)],[new SymCat(0, 0), new SymCat(1, 1)],[new SymKS("that"), new SymCat(0, 0)],[new SymKS("these"), new SymCat(0, 1)],[new SymKS("this"), new SymCat(0, 0)],[new SymKS("those"), new SymCat(0, 1)],[new SymKS("very"), new SymCat(0, 0)],[new SymKS("warm")],[new SymKS("wine")],[new SymKS("wines")]],{Float:{s: -3, e: -3}, Int:{s: -2, e: -2}, Item:{s: 0, e: 1}, Kind:{s: 2, e: 2}, Phrase:{s: 3, e: 3}, Quality:{s: 4, e: 4}, String:{s: -1, e: -1}, __gfVar:{s: -4, e: -4}}, 6)}); +var Foods = new GFGrammar(new GFAbstract("Phrase",{Boring: new Type([], "Quality"), Cheese: new Type([], "Kind"), Delicious: new Type([], "Quality"), Expensive: new Type([], "Quality"), Fish: new Type([], "Kind"), Fresh: new Type([], "Quality"), Is: new Type(["Item", "Quality"], "Phrase"), Italian: new Type([], "Quality"), Pizza: new Type([], "Kind"), QKind: new Type(["Quality", "Kind"], "Kind"), That: new Type(["Kind"], "Item"), These: new Type(["Kind"], "Item"), This: new Type(["Kind"], "Item"), Those: new Type(["Kind"], "Item"), Very: new Type(["Quality"], "Quality"), Warm: new Type([], "Quality"), Wine: new Type([], "Kind")}),{FoodsEng: new GFConcrete({},{0:[new Apply(19,[new PArg(2)]), new Apply(21,[new PArg(2)])], 1:[new Apply(20,[new PArg(2)]), new Apply(22,[new PArg(2)])], 2:[new Apply(9,[]), new Apply(12,[]), new Apply(17,[]), new Apply(18,[new PArg(4), new PArg(2)]), new Apply(25,[])], 3:[new Apply(14,[new PArg(0), new PArg(4)]), new Apply(15,[new PArg(1), new PArg(4)])], 4:[new Apply(8,[]), new Apply(10,[]), new Apply(11,[]), new Apply(13,[]), new Apply(16,[]), new Apply(23,[new PArg(4)]), new Apply(24,[])]},[new CncFun("'lindef Item'",[5]), new CncFun("'lindef Item'",[0]), new CncFun("'lindef Kind'",[5, 5]), new CncFun("'lindef Kind'",[0]), new CncFun("'lindef Phrase'",[5]), new CncFun("'lindef Phrase'",[0]), new CncFun("'lindef Quality'",[5]), new CncFun("'lindef Quality'",[0]), new CncFun("Boring",[7]), new CncFun("Cheese",[8, 9]), new CncFun("Delicious",[10]), new CncFun("Expensive",[11]), new CncFun("Fish",[12, 12]), new CncFun("Fresh",[13]), new CncFun("Is",[4]), new CncFun("Is",[3]), new CncFun("Italian",[6]), new CncFun("Pizza",[14, 15]), new CncFun("QKind",[1, 2]), new CncFun("That",[16]), new CncFun("These",[17]), new CncFun("This",[18]), new CncFun("Those",[19]), new CncFun("Very",[20]), new CncFun("Warm",[21]), new CncFun("Wine",[22, 23])],[[new SymCat(0, 0)],[new SymCat(0, 0), new SymCat(1, 0)],[new SymCat(0, 0), new SymCat(1, 1)],[new SymCat(0, 0), new SymKS("are"), new SymCat(1, 0)],[new SymCat(0, 0), new SymKS("is"), new SymCat(1, 0)],[new SymLit(0, 0)],[new SymKS("Italian")],[new SymKS("boring")],[new SymKS("cheese")],[new SymKS("cheeses")],[new SymKS("delicious")],[new SymKS("expensive")],[new SymKS("fish")],[new SymKS("fresh")],[new SymKS("pizza")],[new SymKS("pizzas")],[new SymKS("that"), new SymCat(0, 0)],[new SymKS("these"), new SymCat(0, 1)],[new SymKS("this"), new SymCat(0, 0)],[new SymKS("those"), new SymCat(0, 1)],[new SymKS("very"), new SymCat(0, 0)],[new SymKS("warm")],[new SymKS("wine")],[new SymKS("wines")]],{Float:{s: -3, e: -3}, Int:{s: -2, e: -2}, Item:{s: 0, e: 1}, Kind:{s: 2, e: 2}, Phrase:{s: 3, e: 3}, Quality:{s: 4, e: 4}, String:{s: -1, e: -1}}, 5), FoodsIta: new GFConcrete({},{0:[new Apply(22,[new PArg(4)]), new Apply(26,[new PArg(4)])], 1:[new Apply(23,[new PArg(5)]), new Apply(27,[new PArg(5)])], 2:[new Apply(24,[new PArg(4)]), new Apply(28,[new PArg(4)])], 3:[new Apply(25,[new PArg(5)]), new Apply(29,[new PArg(5)])], 4:[new Apply(9,[]), new Apply(12,[]), new Apply(20,[new PArg(7), new PArg(4)]), new Apply(32,[])], 5:[new Apply(19,[]), new Apply(21,[new PArg(7), new PArg(5)])], 6:[new Apply(14,[new PArg(0), new PArg(7)]), new Apply(15,[new PArg(1), new PArg(7)]), new Apply(16,[new PArg(2), new PArg(7)]), new Apply(17,[new PArg(3), new PArg(7)])], 7:[new Apply(8,[]), new Apply(10,[]), new Apply(11,[]), new Apply(13,[]), new Apply(18,[]), new Apply(30,[new PArg(7)]), new Apply(31,[])]},[new CncFun("'lindef Item'",[9]), new CncFun("'lindef Item'",[0]), new CncFun("'lindef Kind'",[9, 9]), new CncFun("'lindef Kind'",[0]), new CncFun("'lindef Phrase'",[9]), new CncFun("'lindef Phrase'",[0]), new CncFun("'lindef Quality'",[9, 9, 9, 9]), new CncFun("'lindef Quality'",[0]), new CncFun("Boring",[39, 38, 36, 37]), new CncFun("Cheese",[23, 22]), new CncFun("Delicious",[21, 20, 18, 19]), new CncFun("Expensive",[17, 16, 14, 15]), new CncFun("Fish",[40, 41]), new CncFun("Fresh",[27, 26, 24, 25]), new CncFun("Is",[3]), new CncFun("Is",[4]), new CncFun("Is",[1]), new CncFun("Is",[2]), new CncFun("Italian",[31, 30, 28, 29]), new CncFun("Pizza",[42, 43]), new CncFun("QKind",[5, 7]), new CncFun("QKind",[6, 8]), new CncFun("That",[45]), new CncFun("That",[46]), new CncFun("These",[50]), new CncFun("These",[49]), new CncFun("This",[51]), new CncFun("This",[48]), new CncFun("Those",[44]), new CncFun("Those",[47]), new CncFun("Very",[32, 33, 34, 35]), new CncFun("Warm",[13, 12, 10, 11]), new CncFun("Wine",[53, 52])],[[new SymCat(0, 0)],[new SymCat(0, 0), new SymKS("sono"), new SymCat(1, 1)],[new SymCat(0, 0), new SymKS("sono"), new SymCat(1, 3)],[new SymCat(0, 0), new SymKS("è"), new SymCat(1, 0)],[new SymCat(0, 0), new SymKS("è"), new SymCat(1, 2)],[new SymCat(1, 0), new SymCat(0, 0)],[new SymCat(1, 0), new SymCat(0, 2)],[new SymCat(1, 1), new SymCat(0, 1)],[new SymCat(1, 1), new SymCat(0, 3)],[new SymLit(0, 0)],[new SymKS("calda")],[new SymKS("calde")],[new SymKS("caldi")],[new SymKS("caldo")],[new SymKS("cara")],[new SymKS("care")],[new SymKS("cari")],[new SymKS("caro")],[new SymKS("deliziosa")],[new SymKS("deliziose")],[new SymKS("deliziosi")],[new SymKS("delizioso")],[new SymKS("formaggi")],[new SymKS("formaggio")],[new SymKS("fresca")],[new SymKS("fresche")],[new SymKS("freschi")],[new SymKS("fresco")],[new SymKS("italiana")],[new SymKS("italiane")],[new SymKS("italiani")],[new SymKS("italiano")],[new SymKS("molto"), new SymCat(0, 0)],[new SymKS("molto"), new SymCat(0, 1)],[new SymKS("molto"), new SymCat(0, 2)],[new SymKS("molto"), new SymCat(0, 3)],[new SymKS("noiosa")],[new SymKS("noiose")],[new SymKS("noiosi")],[new SymKS("noioso")],[new SymKS("pesce")],[new SymKS("pesci")],[new SymKS("pizza")],[new SymKS("pizze")],[new SymKS("quei"), new SymCat(0, 1)],[new SymKS("quel"), new SymCat(0, 0)],[new SymKS("quella"), new SymCat(0, 0)],[new SymKS("quelle"), new SymCat(0, 1)],[new SymKS("questa"), new SymCat(0, 0)],[new SymKS("queste"), new SymCat(0, 1)],[new SymKS("questi"), new SymCat(0, 1)],[new SymKS("questo"), new SymCat(0, 0)],[new SymKS("vini")],[new SymKS("vino")]],{Float:{s: -3, e: -3}, Int:{s: -2, e: -2}, Item:{s: 0, e: 3}, Kind:{s: 4, e: 5}, Phrase:{s: 6, e: 6}, Quality:{s: 7, e: 7}, String:{s: -1, e: -1}}, 8)}); diff --git a/src/runtime/javascript/translator.html b/src/runtime/javascript/translator.html index d6b4ee3c1..b2c926550 100644 --- a/src/runtime/javascript/translator.html +++ b/src/runtime/javascript/translator.html @@ -32,7 +32,7 @@ Web-based GF Translator - +

    diff --git a/src/server/Cache.hs b/src/server/Cache.hs index d05ee2557..dc1eebdba 100644 --- a/src/server/Cache.hs +++ b/src/server/Cache.hs @@ -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