diff --git a/lib/resource-1.0/Makefile b/lib/resource-1.0/Makefile index 8527b2d8a..44839d8ba 100644 --- a/lib/resource-1.0/Makefile +++ b/lib/resource-1.0/Makefile @@ -6,6 +6,13 @@ stat: gfdoc: gfdoc -txthtml abstract/*.gf gfdoc -txthtml */Paradigms*.gf + gfdoc -txthtml mathematical/Mathematical.gf + gfdoc -txthtml mathematical/Symbol.gf + gfdoc -txthtml mathematical/Predication.gf + gfdoc -txthtml multimodal/Demonstrative.gf + gfdoc -txthtml multimodal/Multimodal.gf mv abstract/*.html doc/gfdoc + mv mathematical/*.html doc/gfdoc + mv multimodal/*.html doc/gfdoc mv */Paradigms*.html doc/gfdoc cp */Irreg???.gf doc/gfdoc diff --git a/lib/resource-1.0/doc/index.txt b/lib/resource-1.0/doc/index.txt index 1919e8d0d..f9c0a8e99 100644 --- a/lib/resource-1.0/doc/index.txt +++ b/lib/resource-1.0/doc/index.txt @@ -59,3 +59,7 @@ The documentation of the individual modules: % - [IrregGer gfdoc/IrregGer.gf]: German irregular verbs - [IrregNor gfdoc/IrregNor.gf]: Norwegian irregular verbs - [IrregSwe gfdoc/IrregSwe.gf]: Swedish irregular verbs + + +==Special-purpose APIs== + diff --git a/lib/resource-1.0/german/ResGer.gf b/lib/resource-1.0/german/ResGer.gf index bb9e060c4..f52e7803a 100644 --- a/lib/resource-1.0/german/ResGer.gf +++ b/lib/resource-1.0/german/ResGer.gf @@ -374,7 +374,7 @@ resource ResGer = ParamGer ** open Prelude in { verb = vp.s ! agr ! VPFinite t a ; neg = vp.a1 ! b ; obj = vp.n2 ! agr ++ vp.a2 ; - compl = neg ++ obj ; + compl = obj ++ neg ; inf = vp.inf ++ verb.inf ; extra = vp.ext ; inffin = case of { diff --git a/lib/resource-1.0/mathematical/Mathematical.gf b/lib/resource-1.0/mathematical/Mathematical.gf new file mode 100644 index 000000000..093d192af --- /dev/null +++ b/lib/resource-1.0/mathematical/Mathematical.gf @@ -0,0 +1,29 @@ +--1 The Mathematics API to the Resource Grammar + +-- This grammar is a collection of the different modules. +-- It differs from $Lang$ in two main ways: +-- - the combinations in Noun, Verb, Adjective, Adverb, Sentence are not included +-- - instead, Symbol and Predication are used +-- +-- +-- In practice, the most important difference is that only present-tense sentences +-- are included, and that symbolic expressions are recognized as NPs. + +abstract Mathematical = + Noun - [ComplN2], --- to avoid ambiguity +-- Verb, +-- Adjective, +-- Adverb, + Numeral, +-- Sentence, + Question, + Relative, + Conjunction, + Phrase, + Structural, + + Symbol, + Predication, + + Lexicon + ** {} ; diff --git a/lib/resource-1.0/mathematical/MathematicalEng.gf b/lib/resource-1.0/mathematical/MathematicalEng.gf new file mode 100644 index 000000000..d4d855b3b --- /dev/null +++ b/lib/resource-1.0/mathematical/MathematicalEng.gf @@ -0,0 +1,24 @@ +--# -path=.:../english:../abstract:../common:prelude + +concrete MathematicalEng of Mathematical = + NounEng - [ComplN2], --- to avoid ambiguity +-- VerbEng, +-- AdjectiveEng, +-- AdverbEng, + NumeralEng, +-- SentenceEng, + QuestionEng, + RelativeEng, + ConjunctionEng, + PhraseEng, + StructuralEng, + + SymbolEng, + PredicationEng, + + LexiconEng + ** { + +flags startcat = Phr ; + +} ; diff --git a/lib/resource-1.0/mathematical/MathematicalFre.gf b/lib/resource-1.0/mathematical/MathematicalFre.gf new file mode 100644 index 000000000..2bb1bb203 --- /dev/null +++ b/lib/resource-1.0/mathematical/MathematicalFre.gf @@ -0,0 +1,24 @@ +--# -path=.:../french:../romance:../abstract:../common:prelude + +concrete MathematicalFre of Mathematical = + NounFre - [ComplN2], --- to avoid ambiguity +-- VerbFre, +-- AdjectiveFre, +-- AdverbFre, + NumeralFre, +-- SentenceFre, + QuestionFre, + RelativeFre, + ConjunctionFre, + PhraseFre, + StructuralFre, + + SymbolFre, + PredicationFre, + + LexiconFre + ** { + +flags startcat = Phr ; + +} ; diff --git a/lib/resource-1.0/mathematical/MathematicalGer.gf b/lib/resource-1.0/mathematical/MathematicalGer.gf new file mode 100644 index 000000000..ea58cf85a --- /dev/null +++ b/lib/resource-1.0/mathematical/MathematicalGer.gf @@ -0,0 +1,24 @@ +--# -path=.:../german:../abstract:../common:prelude + +concrete MathematicalGer of Mathematical = + NounGer - [ComplN2], --- to avoid ambiguity +-- VerbGer, +-- AdjectiveGer, +-- AdverbGer, + NumeralGer, +-- SentenceGer, + QuestionGer, + RelativeGer, + ConjunctionGer, + PhraseGer, + StructuralGer, + + SymbolGer, + PredicationGer, + + LexiconGer + ** { + +flags startcat = Phr ; + +} ; diff --git a/lib/resource-1.0/mathematical/MathematicalSwe.gf b/lib/resource-1.0/mathematical/MathematicalSwe.gf new file mode 100644 index 000000000..d04f745ac --- /dev/null +++ b/lib/resource-1.0/mathematical/MathematicalSwe.gf @@ -0,0 +1,24 @@ +--# -path=.:../swedish:../scandinavian:../abstract:../common:prelude + +concrete MathematicalSwe of Mathematical = + NounSwe - [ComplN2], --- to avoid ambiguity +-- VerbSwe, +-- AdjectiveSwe, +-- AdverbSwe, + NumeralSwe, +-- SentenceSwe, + QuestionSwe, + RelativeSwe, + ConjunctionSwe, + PhraseSwe, + StructuralSwe, + + SymbolSwe, + PredicationSwe, + + LexiconSwe + ** { + +flags startcat = Phr ; + +} ; diff --git a/lib/resource-1.0/mathematical/Predication.gf b/lib/resource-1.0/mathematical/Predication.gf new file mode 100644 index 000000000..31ade0a17 --- /dev/null +++ b/lib/resource-1.0/mathematical/Predication.gf @@ -0,0 +1,57 @@ +--1 A Small Predication Library +-- +-- (c) Aarne Ranta 2003-2006 under Gnu GPL. +-- +-- This library is a derived library built on the language-independent Ground +-- API of resource grammars. + +abstract Predication = Cat ** { + +--2 The category of atomic sentences + +-- These sentences have both a positive and a negative form + +cat + AS ; + +fun + PosAS : AS -> S ; + NegAS : AS -> S ; + +--2 Predication patterns. + + predV : V -> NP -> AS ; -- one-place verb: "x converges" + predV2 : V2 -> NP -> NP -> AS ; -- two-place verb: "x intersects y" + predV3 : V3 -> NP->NP-> NP -> AS; -- three-place verb: "x intersects y at z" + predVColl : V -> NP -> NP -> AS ; -- collective verb: "x and y intersect" + predA : A -> NP -> AS ; -- one-place adjective: "x is even" + predA2 : A2 -> NP -> NP -> AS ; -- two-place adj: "x is divisible by y" + predAComp : A -> NP -> NP -> AS; -- comparative adj: "x is greater than y" + predAColl : A -> NP -> NP -> AS ; -- collective adj: "x and y are parallel" + predN : N -> NP -> AS ; -- one-place noun: "x is a point" + predN2 : N2 -> NP -> NP -> AS ; -- two-place noun: "x is a divisor of y" + predNColl : N -> NP -> NP -> AS ; -- collective noun: "x and y are duals" + predAdv : Adv -> NP -> AS ; -- adverb: "x is inside" + predPrep : Prep -> NP -> NP -> AS ; -- preposition: "x is outside y" + +--2 Individual-valued function applications + + appN2 : N2 -> NP -> NP ; -- one-place function: "the successor of x" + appN3 : N3 -> NP -> NP -> NP ; -- two-place function: "the distance from x to y" + appColl : N2 -> NP -> NP -> NP ; -- collective function: "the sum of x and y" + +--2 Families of types + +-- These are expressed by relational nouns applied to arguments. + + famN2 : N2 -> NP -> CN ; -- one-place family: "divisor of x" + famN3 : N3 -> NP -> NP -> CN ; -- two-place family: "path from x to y" + famColl : N2 -> NP -> NP -> CN ; -- collective family: "path between x and y" + +--2 Type constructor + +-- This is similar to a family except that the argument is a type. + + typN2 : N2 -> CN -> CN ; -- constructed type: "list of integers" + +} diff --git a/lib/resource-1.0/mathematical/PredicationEng.gf b/lib/resource-1.0/mathematical/PredicationEng.gf new file mode 100644 index 000000000..5a691365e --- /dev/null +++ b/lib/resource-1.0/mathematical/PredicationEng.gf @@ -0,0 +1,3 @@ +concrete PredicationEng of Predication = CatEng ** PredicationI with + (Lang = LangEng) ; + diff --git a/lib/resource-1.0/mathematical/PredicationFre.gf b/lib/resource-1.0/mathematical/PredicationFre.gf new file mode 100644 index 000000000..3c4b9a4d8 --- /dev/null +++ b/lib/resource-1.0/mathematical/PredicationFre.gf @@ -0,0 +1,3 @@ +concrete PredicationFre of Predication = CatFre ** PredicationI with + (Lang = LangFre) ; + diff --git a/lib/resource-1.0/mathematical/PredicationGer.gf b/lib/resource-1.0/mathematical/PredicationGer.gf new file mode 100644 index 000000000..742f2640e --- /dev/null +++ b/lib/resource-1.0/mathematical/PredicationGer.gf @@ -0,0 +1,3 @@ +concrete PredicationGer of Predication = CatGer ** PredicationI with + (Lang = LangGer) ; + diff --git a/lib/resource-1.0/mathematical/PredicationI.gf b/lib/resource-1.0/mathematical/PredicationI.gf new file mode 100644 index 000000000..cb969e7c9 --- /dev/null +++ b/lib/resource-1.0/mathematical/PredicationI.gf @@ -0,0 +1,56 @@ +incomplete concrete PredicationI of Predication = Cat ** open ParamX, Lang in { + +lincat + AS = {s : Polarity => S} ; + +lin + PosAS as = as.s ! Pos ; + NegAS as = as.s ! Neg ; + +--2 Predication patterns. + + predV v x = mkAS x (UseV v) ; + predV2 v x y = mkAS x (ComplV2 v y) ; + predV3 v x y z = mkAS x (ComplV3 v y z) ; + predVColl v x y = mkAS (ConjNP and_Conj (BaseNP x y)) (UseV v) ; + predA a x = mkAS x (UseComp (CompAP (PositA a))) ; + predA2 a x y = mkAS x (UseComp (CompAP (ComplA2 a y))) ; + predAComp a x y = mkAS x (UseComp (CompAP (ComparA a y))) ; + predAColl a x y = mkAS (ConjNP and_Conj (BaseNP x y)) (UseComp (CompAP (PositA a))) ; + predN n x = mkAS x (UseComp (CompNP (DetCN (DetSg IndefSg NoOrd) (UseN n)))) ; + predN2 n x y = mkAS x (UseComp (CompNP (DetCN (DetSg IndefSg NoOrd) (ComplN2 n y)))) ; + predNColl n x y = mkAS (ConjNP and_Conj (BaseNP x y)) + (UseComp (CompNP (DetCN (DetPl IndefPl NoNum NoOrd) (UseN n)))) ; + predAdv a x = mkAS x (UseComp (CompAdv a)) ; + predPrep p x y = mkAS x (UseComp (CompAdv (PrepNP p y))) ; + +--2 Individual-valued function applications + + appN2 n x = DetCN (DetSg DefSg NoOrd) (ComplN2 n x) ; + appN3 n x y = DetCN (DetSg DefSg NoOrd) (ComplN2 (ComplN3 n x) y) ; + appColl n x y = DetCN (DetSg DefSg NoOrd) (ComplN2 n (ConjNP and_Conj (BaseNP x y))) ; + +--2 Families of types + +-- These are expressed by relational nouns applied to arguments. + + famN2 n x = ComplN2 n x ; + famN3 n x y = ComplN2 (ComplN3 n x) y ; + famColl n x y = ComplN2 n (ConjNP and_Conj (BaseNP x y)) ; + +--2 Type constructor + +-- This is similar to a family except that the argument is a type. + + typN2 f n = ComplN2 f (DetCN (DetPl IndefPl NoNum NoOrd) n) ; + + +oper + mkAS : NP -> VP -> {s : Polarity => S} = \x,vp -> { + s = table { + Pos => UseCl TPres ASimul PPos (PredVP x vp) ; + Neg => UseCl TPres ASimul PNeg (PredVP x vp) + } + } ; + +} diff --git a/lib/resource-1.0/mathematical/PredicationSwe.gf b/lib/resource-1.0/mathematical/PredicationSwe.gf new file mode 100644 index 000000000..53397b72f --- /dev/null +++ b/lib/resource-1.0/mathematical/PredicationSwe.gf @@ -0,0 +1,3 @@ +concrete PredicationSwe of Predication = CatSwe ** PredicationI with + (Lang = LangSwe) ; + diff --git a/src/GF/CF/CanonToCF.hs b/src/GF/CF/CanonToCF.hs index 882860b2c..80ce2e79d 100644 --- a/src/GF/CF/CanonToCF.hs +++ b/src/GF/CF/CanonToCF.hs @@ -128,6 +128,8 @@ term2CFItems m t = errIn "forming cf items" $ case t of its <- mapM t2c ts tryMkCFTerm (concat its) + P (S c _) _ -> t2c c --- w-around for bug in Compute? AR 31/1/2006 + P arg s -> extrR arg s K (KS s) -> return [[PTerm (RegAlts [s]) | not (null s)]] diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs index 3ca7e68df..2e03b59ec 100644 --- a/src/GF/Compile/CheckGrammar.hs +++ b/src/GF/Compile/CheckGrammar.hs @@ -37,6 +37,7 @@ import GF.Grammar.Macros import GF.Grammar.ReservedWords ---- import GF.Grammar.PatternMatch import GF.Grammar.AppPredefined +import GF.Grammar.Lockfield (isLockLabel) import GF.Data.Operations import GF.Infra.CheckM @@ -757,9 +758,15 @@ checkEqLType :: LTEnv -> Type -> Type -> Term -> Check Type checkEqLType env t u trm = do t' <- comp t u' <- comp u - if alpha [] t' u' - then return t' - else raise ("type of" +++ prt trm +++ + case alpha [] t' u' of + True -> return t' + -- forgive missing lock fields by only generating a warning. + --- better: use a flag to forgive (AR 31/1/2006) + _ -> case missingLock [] t' u' of + Just lo -> do + checkWarn $ "missing lock field" +++ unwords (map prt lo) + return t' + _ -> raise ("type of" +++ prt trm +++ ": expected" +++ prt t' ++ ", inferred" +++ prt u') where @@ -772,7 +779,7 @@ checkEqLType env t u trm = do -- record subtyping (RecType rs, RecType ts) -> all (\ (l,a) -> - any (\ (k,b) -> alpha g a b && l == k) ts) rs + any (\ (k,b) -> alpha g a b && l == k) ts) rs (ExtR r s, ExtR r' s') -> alpha g r r' && alpha g s s' (ExtR r s, t) -> alpha g r t || alpha g s t @@ -780,7 +787,7 @@ checkEqLType env t u trm = do (App (Q (IC "Predef") (IC "Ints")) (EInt n), App (Q (IC "Predef") (IC "Ints")) (EInt m)) -> m >= n (App (Q (IC "Predef") (IC "Ints")) (EInt n), - Q (IC "Predef") (IC "Int")) -> True ---- should check size + Q (IC "Predef") (IC "Int")) -> True ---- check size! (Q (IC "Predef") (IC "Int"), ---- why this ???? AR 11/12/2005 App (Q (IC "Predef") (IC "Ints")) (EInt n)) -> True @@ -804,6 +811,17 @@ checkEqLType env t u trm = do || (t == typeType && u == typePType) || (u == typeType && t == typePType) + missingLock g t u = case (t,u) of + (RecType rs, RecType ts) -> + let + ls = [l | (l,a) <- rs, + not (any (\ (k,b) -> alpha g a b && l == k) ts)] + (locks,others) = partition isLockLabel ls + in case others of + _:_ -> Nothing + _ -> return locks + _ -> Nothing + sTypes = [typeStr, typeTok, typeString] comp = computeLType env @@ -827,20 +845,3 @@ linTypeOfType cnc m typ = do ,return defLinType ] -{- --- check if a type is complex in variants --- Not so useful as one might think, since variants of a complex type --- can be created indirectly: f (variants {True,False}) - -checkIfComplexVariantType :: Term -> Type -> Check () -checkIfComplexVariantType e t = case t of - Prod _ _ _ -> cs - Table _ _ -> cs - RecType (_:_:_) -> cs - _ -> return () - where - cs = case e of - FV (_:_) -> checkWarn $ "Warning:" +++ prt e +++ "has complex type" +++ prt t - _ -> return () - --}