diff --git a/lib/resource-1.0/abstract/Conjunction.gf b/lib/resource-1.0/abstract/Conjunction.gf index c1e580b13..cb817559b 100644 --- a/lib/resource-1.0/abstract/Conjunction.gf +++ b/lib/resource-1.0/abstract/Conjunction.gf @@ -2,34 +2,22 @@ abstract Conjunction = Cat ** { fun - ConjS : Conj -> SeqS -> S ; -- "John walks and Mary runs" - ConjAP : Conj -> SeqAP -> AP ; -- "even and prime" - ConjNP : Conj -> SeqNP -> NP ; -- "John or Mary" - ConjAdv : Conj -> SeqAdv -> Adv ; -- "quickly or slowly" + ConjS : Conj -> [S] -> S ; -- "John walks and Mary runs" + ConjAP : Conj -> [AP] -> AP ; -- "even and prime" + ConjNP : Conj -> [NP] -> NP ; -- "John or Mary" + ConjAdv : Conj -> [Adv] -> Adv ; -- "quickly or slowly" - DConjS : DConj -> SeqS -> S ; -- "either John walks or Mary runs" - DConjAP : DConj -> SeqAP -> AP ; -- "both even and prime" - DConjNP : DConj -> SeqNP -> NP ; -- "either John or Mary" - DConjAdv : DConj -> SeqAdv -> Adv ; -- "both badly and slowly" + DConjS : DConj -> [S] -> S ; -- "either John walks or Mary runs" + DConjAP : DConj -> [AP] -> AP ; -- "both even and prime" + DConjNP : DConj -> [NP] -> NP ; -- "either John or Mary" + DConjAdv : DConj -> [Adv] -> Adv ; -- "both badly and slowly" - --- these are rather uninteresting - - TwoS : S -> S -> SeqS ; - AddS : SeqS -> S -> SeqS ; - TwoAdv : Adv -> Adv -> SeqAdv ; - AddAdv : SeqAdv -> Adv -> SeqAdv ; - TwoNP : NP -> NP -> SeqNP ; - AddNP : SeqNP -> NP -> SeqNP ; - TwoAP : AP -> AP -> SeqAP ; - AddAP : SeqAP -> AP -> SeqAP ; - --- we use right-associative lists instead of GF's built-in lists +-- These categories are internal to this module. cat - SeqS ; - SeqAdv ; - SeqNP ; - SeqAP ; + [S]{2} ; + [Adv]{2} ; + [NP]{2} ; + [AP]{2} ; } diff --git a/lib/resource-1.0/abstract/ListConjunction.gf b/lib/resource-1.0/abstract/ListConjunction.gf deleted file mode 100644 index cb817559b..000000000 --- a/lib/resource-1.0/abstract/ListConjunction.gf +++ /dev/null @@ -1,23 +0,0 @@ -abstract Conjunction = Cat ** { - - fun - - ConjS : Conj -> [S] -> S ; -- "John walks and Mary runs" - ConjAP : Conj -> [AP] -> AP ; -- "even and prime" - ConjNP : Conj -> [NP] -> NP ; -- "John or Mary" - ConjAdv : Conj -> [Adv] -> Adv ; -- "quickly or slowly" - - DConjS : DConj -> [S] -> S ; -- "either John walks or Mary runs" - DConjAP : DConj -> [AP] -> AP ; -- "both even and prime" - DConjNP : DConj -> [NP] -> NP ; -- "either John or Mary" - DConjAdv : DConj -> [Adv] -> Adv ; -- "both badly and slowly" - --- These categories are internal to this module. - - cat - [S]{2} ; - [Adv]{2} ; - [NP]{2} ; - [AP]{2} ; - -} diff --git a/lib/resource-1.0/abstract/SeqConjunction.gf b/lib/resource-1.0/abstract/SeqConjunction.gf new file mode 100644 index 000000000..57b47bbbe --- /dev/null +++ b/lib/resource-1.0/abstract/SeqConjunction.gf @@ -0,0 +1,38 @@ +abstract SeqConjunction = Cat ** { + +-- This module is for backward compatibility with API 0.9. +-- To be used instead of Conjunction. + + fun + + ConjS : Conj -> SeqS -> S ; -- "John walks and Mary runs" + ConjAP : Conj -> SeqAP -> AP ; -- "even and prime" + ConjNP : Conj -> SeqNP -> NP ; -- "John or Mary" + ConjAdv : Conj -> SeqAdv -> Adv ; -- "quickly or slowly" + + DConjS : DConj -> SeqS -> S ; -- "either John walks or Mary runs" + DConjAP : DConj -> SeqAP -> AP ; -- "both even and prime" + DConjNP : DConj -> SeqNP -> NP ; -- "either John or Mary" + DConjAdv : DConj -> SeqAdv -> Adv ; -- "both badly and slowly" + + +-- these are rather uninteresting + + TwoS : S -> S -> SeqS ; + AddS : SeqS -> S -> SeqS ; + TwoAdv : Adv -> Adv -> SeqAdv ; + AddAdv : SeqAdv -> Adv -> SeqAdv ; + TwoNP : NP -> NP -> SeqNP ; + AddNP : SeqNP -> NP -> SeqNP ; + TwoAP : AP -> AP -> SeqAP ; + AddAP : SeqAP -> AP -> SeqAP ; + +-- we use right-associative lists instead of GF's built-in lists + + cat + SeqS ; + SeqAdv ; + SeqNP ; + SeqAP ; + +} diff --git a/lib/resource-1.0/english/AdverbEng.gf b/lib/resource-1.0/english/AdverbEng.gf index ebcb3e810..5f6d01940 100644 --- a/lib/resource-1.0/english/AdverbEng.gf +++ b/lib/resource-1.0/english/AdverbEng.gf @@ -14,7 +14,7 @@ concrete AdverbEng of Adverb = CatEng ** open ResEng, Prelude in { AdAdv = cc2 ; SubjS = cc2 ; - AdvSC s = s ; + AdvSC s = s ; --- this rule give stack overflow in ordinary parsing AdnCAdv cadv = {s = cadv.s ++ "than"} ; diff --git a/lib/resource-1.0/english/ConjunctionEng.gf b/lib/resource-1.0/english/ConjunctionEng.gf index 1aaf12f2e..f34c42f16 100644 --- a/lib/resource-1.0/english/ConjunctionEng.gf +++ b/lib/resource-1.0/english/ConjunctionEng.gf @@ -23,19 +23,21 @@ concrete ConjunctionEng of Conjunction = isPre = ss.isPre } ; - TwoS = twoSS ; - AddS = consSS comma ; - TwoAdv = twoSS ; - AddAdv = consSS comma ; - TwoNP x y = twoTable Case x y ** {a = conjAgr x.a y.a} ; - AddNP xs x = consTable Case comma xs x ** {a = conjAgr xs.a x.a} ; - TwoAP x y = twoTable Agr x y ** {isPre = andB x.isPre y.isPre} ; - AddAP xs x = consTable Agr comma xs x ** {isPre = andB xs.isPre x.isPre} ; +-- These fun's are generated from the list cat's. + + BaseS = twoSS ; + ConsS = consrSS comma ; + BaseAdv = twoSS ; + ConsAdv = consrSS comma ; + BaseNP x y = twoTable Case x y ** {a = conjAgr x.a y.a} ; + ConsNP xs x = consrTable Case comma xs x ** {a = conjAgr xs.a x.a} ; + BaseAP x y = twoTable Agr x y ** {isPre = andB x.isPre y.isPre} ; + ConsAP xs x = consrTable Agr comma xs x ** {isPre = andB xs.isPre x.isPre} ; lincat - SeqS = {s1,s2 : Str} ; - SeqAdv = {s1,s2 : Str} ; - SeqNP = {s1,s2 : Case => Str ; a : Agr} ; - SeqAP = {s1,s2 : Agr => Str ; isPre : Bool} ; + [S] = {s1,s2 : Str} ; + [Adv] = {s1,s2 : Str} ; + [NP] = {s1,s2 : Case => Str ; a : Agr} ; + [AP] = {s1,s2 : Agr => Str ; isPre : Bool} ; } diff --git a/lib/resource-1.0/english/MorphoEng.gf b/lib/resource-1.0/english/MorphoEng.gf index 61a9f8128..eb3c51222 100644 --- a/lib/resource-1.0/english/MorphoEng.gf +++ b/lib/resource-1.0/english/MorphoEng.gf @@ -37,12 +37,6 @@ oper oper CommonNoun : Type = {s : Number => Case => Str} ; - mkNoun : (_,_,_,_ : Str) -> CommonNoun = - \man,men, mans, mens -> {s = table { - Sg => table {Gen => mans ; _ => man} ; - Pl => table {Gen => mens ; _ => men} - }} ; - nounGen : Str -> CommonNoun = \dog -> case last dog of { "y" => nounY "dog" ; "s" => nounS (init "dog") ; @@ -107,15 +101,6 @@ oper Adjective = {s : AForm => Str} ; - mkAdjective : (_,_,_,_ : Str) -> Adjective = \free,freer,freest,freely -> { - s = table { - AAdj Posit => free ; - AAdj Compar => freer ; - AAdj Superl => freest ; - AAdv => freely - } - } ; - -- However, most adjectives can be inflected using the final character. -- N.B. this is not correct for "shy", but $mkAdjective$ has to be used. @@ -149,23 +134,13 @@ oper -- -- The worst case needs five forms. (The verb "be" is treated separately.) - mkVerbWorst : (_,_,_,_,_: Str) -> Verb = \go,goes,went,gone,going -> - {s = table { - VInf => go ; - VPres => goes ; - VPast => went ; - VPPart => gone ; - VPresPart => going - } - } ; - mkVerb4 : (_,_,_,_: Str) -> Verb = \go,goes,went,gone -> let going = case last go of { "e" => init go + "ing" ; _ => go + "ing" } in - mkVerbWorst go goes went gone going ; + mkVerb go goes went gone going ; -- This is what we use to derive the irregular forms in almost all cases @@ -193,9 +168,6 @@ oper in mkVerb4 soak soaks soaked soaked ; - mkVerb : (_,_,_ : Str) -> Verb = \ring,rang,rung -> - mkVerb4 ring (ring + "s") rang rung ; - verbGen : Str -> Verb = \kill -> case last kill of { "y" => verbP3y (init kill) ; "e" => verbP3e (init kill) ; @@ -206,7 +178,7 @@ oper -- These are just auxiliary to $verbGen$. regVerbP3 : Str -> Verb = \walk -> - mkVerb walk (walk + "ed") (walk + "ed") ; + mkVerbIrreg walk (walk + "ed") (walk + "ed") ; verbP3s : Str -> Verb = \kiss -> mkVerb4 kiss (kiss + "es") (kiss + "ed") (kiss + "ed") ; verbP3e : Str -> Verb = \love -> diff --git a/lib/resource-1.0/english/NounEng.gf b/lib/resource-1.0/english/NounEng.gf index 08914ed7c..e8b4fcf78 100644 --- a/lib/resource-1.0/english/NounEng.gf +++ b/lib/resource-1.0/english/NounEng.gf @@ -3,8 +3,11 @@ concrete NounEng of Noun = CatEng ** open ResEng, Prelude in { flags optimize=all_subs ; lin - DetCN det cn = {s = \\c => det.s ++ cn.s ! det.n ! c} ** agrP3 det.n ; - UsePN pn = pn ** agrP3 Sg ; + DetCN det cn = { + s = \\c => det.s ++ cn.s ! det.n ! c ; + a = agrP3 det.n + } ; + UsePN pn = pn ** {a = agrP3 Sg} ; UsePron p = p ; MkDet pred quant num ord = { @@ -35,7 +38,7 @@ concrete NounEng of Noun = CatEng ** open ResEng, Prelude in { ComplN3 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c ; c2 = f.c3} ; AdjCN ap cn = { - s = \\n,c => preOrPost ap.isPre (ap.s ! (agrP3 n).a) (cn.s ! n ! c) + s = \\n,c => preOrPost ap.isPre (ap.s ! agrP3 n) (cn.s ! n ! c) } ; RelCN cn rs = {s = \\n,c => cn.s ! n ! c ++ rs.s ! {n = n ; p = P3}} ; diff --git a/lib/resource-1.0/english/ParadigmsEng.gf b/lib/resource-1.0/english/ParadigmsEng.gf index c2e95d097..21854206c 100644 --- a/lib/resource-1.0/english/ParadigmsEng.gf +++ b/lib/resource-1.0/english/ParadigmsEng.gf @@ -344,7 +344,7 @@ oper regPN n g = nameReg n g ** {lock_PN = <>} ; nounPN n = {s = n.s ! singular ; g = n.g ; lock_PN = <>} ; - mkNP x y n g = {s = table {Gen => x ; _ => y} ; a = (agrP3 n).a ; + mkNP x y n g = {s = table {Gen => x ; _ => y} ; a = agrP3 n ; lock_NP = <>} ; mkA a b = mkAdjective a a a b ** {lock_A = <>} ; @@ -388,7 +388,7 @@ oper mkPreposition p = p ; mkPrep p = ss p ** {lock_Prep = <>} ; - mkV a b c d e = mkVerbWorst a b c d e ** {s1 = [] ; lock_V = <>} ; + mkV a b c d e = mkVerb a b c d e ** {s1 = [] ; lock_V = <>} ; regV cry = let diff --git a/lib/resource-1.0/english/ParamEng.gf b/lib/resource-1.0/english/ParamEng.gf index bc6083a2d..48c8af9ba 100644 --- a/lib/resource-1.0/english/ParamEng.gf +++ b/lib/resource-1.0/english/ParamEng.gf @@ -48,8 +48,8 @@ resource ParamEng = ParamX ** { --2 Transformations between parameter types oper - agrP3 : Number -> {a : Agr} = \n -> - {a = {n = n ; p = P3}} ; + agrP3 : Number -> Agr = \n -> + {n = n ; p = P3} ; conjAgr : Agr -> Agr -> Agr = \a,b -> { n = conjNumber a.n b.n ; diff --git a/lib/resource-1.0/english/PhraseEng.gf b/lib/resource-1.0/english/PhraseEng.gf index f62492f80..c2c6a1310 100644 --- a/lib/resource-1.0/english/PhraseEng.gf +++ b/lib/resource-1.0/english/PhraseEng.gf @@ -11,7 +11,7 @@ concrete PhraseEng of Phrase = CatEng, TenseX ** open ResEng in { UttIP ip = {s = ip.s ! Nom} ; --- Acc also UttIAdv iadv = iadv ; UttNP np = {s = np.s ! Acc} ; - UttVP vp = {s = "to" ++ infVP vp (agrP3 Sg).a} ; + UttVP vp = {s = "to" ++ infVP vp (agrP3 Sg)} ; UttAdv adv = adv ; NoPConj = {s = []} ; diff --git a/lib/resource-1.0/english/QuestionEng.gf b/lib/resource-1.0/english/QuestionEng.gf index 16dbc22cc..dbe158b80 100644 --- a/lib/resource-1.0/english/QuestionEng.gf +++ b/lib/resource-1.0/english/QuestionEng.gf @@ -13,16 +13,9 @@ concrete QuestionEng of Question = CatEng ** open ResEng in { } ---- "whether" in ExtEng } ; - QuestVP qp vp = { - s = \\t,a,b,q => - let - agr = {n = qp.n ; p = P3} ; - verb = vp.s ! t ! a ! b ! ODir ! agr ; - subj = qp.s ! Nom ; - compl = vp.s2 ! agr - in - subj ++ verb.fin ++ verb.inf ++ compl - } ; + QuestVP qp vp = + let cl = mkS (qp.s ! Nom) {n = qp.n ; p = P3} vp.s vp.s2 + in {s = \\t,a,b,_ => cl.s ! t ! a ! b ! ODir} ; QuestSlash ip slash = { s = \\t,a,p => diff --git a/lib/resource-1.0/english/RelativeEng.gf b/lib/resource-1.0/english/RelativeEng.gf index d74606596..c8fce45fd 100644 --- a/lib/resource-1.0/english/RelativeEng.gf +++ b/lib/resource-1.0/english/RelativeEng.gf @@ -15,11 +15,9 @@ concrete RelativeEng of Relative = CatEng ** open ResEng in { RNoAg => ag ; RAg a => a } ; - verb = vp.s ! t ! ant ! b ! ODir ! agr ; - subj = rp.s ! Nom ; - compl = vp.s2 ! agr + cl = mkS (rp.s ! Nom) agr vp.s vp.s2 in - subj ++ verb.fin ++ verb.inf ++ compl + cl.s ! t ! ant ! b ! ODir } ; RelSlash rp slash = { diff --git a/lib/resource-1.0/english/ResEng.gf b/lib/resource-1.0/english/ResEng.gf index 37a3f71f3..064a584fc 100644 --- a/lib/resource-1.0/english/ResEng.gf +++ b/lib/resource-1.0/english/ResEng.gf @@ -13,35 +13,40 @@ resource ResEng = ParamEng ** open Prelude in { -- For $Lex$. - regN : Str -> {s : Number => Case => Str} = \car -> { +-- For each lexical category, here are the worst-case constructors. + + mkNoun : (_,_,_,_ : Str) -> {s : Number => Case => Str} = + \man,mans,men,mens -> { s = table { Sg => table { - Gen => car + "'s" ; - _ => car + Gen => mans ; + _ => man } ; Pl => table { - Gen => car + "s'" ; - _ => car + "s" + Gen => mens ; + _ => men } } } ; - regA : Str -> {s : AForm => Str} = \warm -> { + mkAdjective : (_,_,_,_ : Str) -> {s : AForm => Str} = + \good,better,best,well -> { s = table { - AAdj Posit => warm ; - AAdj Compar => warm + "er" ; - AAdj Superl => warm + "est" ; - AAdv => warm + "ly" + AAdj Posit => good ; + AAdj Compar => better ; + AAdj Superl => best ; + AAdv => well } } ; - - regV : Str -> {s : VForm => Str} = \walk -> { + mkVerb : (_,_,_,_,_ : Str) -> {s : VForm => Str} = + \go,goes,went,gone,going -> { s = table { - VInf => walk ; - VPres => walk + "s" ; - VPast | VPPart => walk + "ed" ; - VPresPart => walk + "ing" + VInf => go ; + VPres => goes ; + VPast => went ; + VPPart => gone ; + VPresPart => going } } ; @@ -61,6 +66,18 @@ resource ResEng = ParamEng ** open Prelude in { } } ; +-- These functions cover many cases; full coverage inflectional patterns are +-- in $MorphoEng$. + + regN : Str -> {s : Number => Case => Str} = \car -> + mkNoun car (car + "'s") (car + "s") (car + "s'") ; + + regA : Str -> {s : AForm => Str} = \warm -> + mkAdjective warm (warm + "er") (warm + "est") (warm + "ly") ; + + regV : Str -> {s : VForm => Str} = \walk -> + mkVerb walk (walk + "s") (walk + "ed") (walk + "ed") (walk + "ing") ; + regNP : Str -> Number -> {s : Case => Str ; a : Agr} = \that,n -> mkNP that that (that + "'s") n P3 ; @@ -81,8 +98,11 @@ resource ResEng = ParamEng ** open Prelude in { s : VForm => Str } ; + VerbForms : Type = + Tense => Anteriority => Polarity => Ord => Agr => {fin, inf : Str} ; + VP : Type = { - s : Tense => Anteriority => Polarity => Ord => Agr => {fin, inf : Str} ; + s : VerbForms ; s2 : Agr => Str } ; @@ -206,6 +226,26 @@ resource ResEng = ParamEng ** open Prelude in { {n = Pl ; p = P3} => "themselves" } ; +-- For $Sentence$. + + Clause : Type = { + s : Tense => Anteriority => Polarity => Ord => Str + } ; + + mkS : Str -> Agr -> VerbForms -> (Agr => Str) -> Clause = + \subj,agr,verb,compl0 -> { + s = \\t,a,b,o => + let + verb = verb ! t ! a ! b ! o ! agr ; + compl = compl0 ! agr + in + case o of { + ODir => subj ++ verb.fin ++ verb.inf ++ compl ; + OQuest => verb.fin ++ subj ++ verb.inf ++ compl + } + } ; + + -- For $Numeral$. mkNum : Str -> Str -> Str -> Str -> {s : DForm => CardOrd => Str} = diff --git a/lib/resource-1.0/english/SentenceEng.gf b/lib/resource-1.0/english/SentenceEng.gf index 66b197d60..c39f88cfe 100644 --- a/lib/resource-1.0/english/SentenceEng.gf +++ b/lib/resource-1.0/english/SentenceEng.gf @@ -3,33 +3,9 @@ concrete SentenceEng of Sentence = CatEng ** open ResEng in { flags optimize=all_subs ; lin - PredVP np vp = { - s = \\t,a,b,o => - let - agr = np.a ; - verb = vp.s ! t ! a ! b ! o ! agr ; - subj = np.s ! Nom ; - compl = vp.s2 ! agr - in - case o of { - ODir => subj ++ verb.fin ++ verb.inf ++ compl ; - OQuest => verb.fin ++ subj ++ verb.inf ++ compl - } - } ; + PredVP np vp = mkS (np.s ! Nom) np.a vp.s vp.s2 ; - PredSCVP sc vp = { - s = \\t,a,b,o => - let - agr = (agrP3 Sg).a ; - verb = vp.s ! t ! a ! b ! o ! agr ; - subj = sc.s ; - compl = vp.s2 ! agr - in - case o of { - ODir => subj ++ verb.fin ++ verb.inf ++ compl ; - OQuest => verb.fin ++ subj ++ verb.inf ++ compl - } - } ; + PredSCVP sc vp = mkS sc.s (agrP3 Sg) vp.s vp.s2 ; ImpVP vp = { s = \\pol,n => @@ -44,36 +20,12 @@ concrete SentenceEng of Sentence = CatEng ** open ResEng in { dont ++ verb } ; - SlashV2 np v2 = { - s = \\t,a,b,o => - let - agr = np.a ; - verb = (predV v2).s ! t ! a ! b ! o ! agr ; - subj = np.s ! Nom - in - case o of { - ODir => subj ++ verb.fin ++ verb.inf ; - OQuest => verb.fin ++ subj ++ verb.inf - } ; - c2 = v2.c2 - } ; - --- not possible: - --- PredVP (np ** {lock_NP =<>}) (UseV (v2 ** {lock_V = <>})) ** {c2 = v2.c2} ; + SlashV2 np v2 = mkS (np.s ! Nom) np.a (predV v2).s (\\_ => []) ** + {c2 = v2.c2} ; - SlashVVV2 np vv v2 = { - s = \\t,a,b,o => - let - agr = np.a ; - verb = (predV vv).s ! t ! a ! b ! o ! agr ; - inf = "to" ++ v2.s ! VInf ; - subj = np.s ! Nom - in - case o of { - ODir => subj ++ verb.fin ++ verb.inf ++ inf ; - OQuest => verb.fin ++ subj ++ verb.inf ++ inf - } ; - c2 = v2.c2 - } ; + SlashVVV2 np vv v2 = + mkS (np.s ! Nom) np.a (predV vv).s (\\_ => "to" ++ v2.s ! VInf) ** + {c2 = v2.c2} ; AdvSlash slash adv = { s = \\t,a,b,o => slash.s ! t ! a ! b ! o ++ adv.s ; diff --git a/lib/resource-1.0/english/ListConjunctionEng.gf b/lib/resource-1.0/english/SeqConjunctionEng.gf similarity index 52% rename from lib/resource-1.0/english/ListConjunctionEng.gf rename to lib/resource-1.0/english/SeqConjunctionEng.gf index f34c42f16..cd0698da8 100644 --- a/lib/resource-1.0/english/ListConjunctionEng.gf +++ b/lib/resource-1.0/english/SeqConjunctionEng.gf @@ -1,4 +1,4 @@ -concrete ConjunctionEng of Conjunction = +concrete SeqConjunctionEng of Conjunction = CatEng ** open ResEng, Coordination, Prelude in { lin @@ -23,21 +23,19 @@ concrete ConjunctionEng of Conjunction = isPre = ss.isPre } ; --- These fun's are generated from the list cat's. - - BaseS = twoSS ; - ConsS = consrSS comma ; - BaseAdv = twoSS ; - ConsAdv = consrSS comma ; - BaseNP x y = twoTable Case x y ** {a = conjAgr x.a y.a} ; - ConsNP xs x = consrTable Case comma xs x ** {a = conjAgr xs.a x.a} ; - BaseAP x y = twoTable Agr x y ** {isPre = andB x.isPre y.isPre} ; - ConsAP xs x = consrTable Agr comma xs x ** {isPre = andB xs.isPre x.isPre} ; + TwoS = twoSS ; + AddS = consSS comma ; + TwoAdv = twoSS ; + AddAdv = consSS comma ; + TwoNP x y = twoTable Case x y ** {a = conjAgr x.a y.a} ; + AddNP xs x = consTable Case comma xs x ** {a = conjAgr xs.a x.a} ; + TwoAP x y = twoTable Agr x y ** {isPre = andB x.isPre y.isPre} ; + AddAP xs x = consTable Agr comma xs x ** {isPre = andB xs.isPre x.isPre} ; lincat - [S] = {s1,s2 : Str} ; - [Adv] = {s1,s2 : Str} ; - [NP] = {s1,s2 : Case => Str ; a : Agr} ; - [AP] = {s1,s2 : Agr => Str ; isPre : Bool} ; + SeqS = {s1,s2 : Str} ; + SeqAdv = {s1,s2 : Str} ; + SeqNP = {s1,s2 : Case => Str ; a : Agr} ; + SeqAP = {s1,s2 : Agr => Str ; isPre : Bool} ; } diff --git a/lib/resource-1.0/english/VerbEng.gf b/lib/resource-1.0/english/VerbEng.gf index db7e18ca3..3e967a4f1 100644 --- a/lib/resource-1.0/english/VerbEng.gf +++ b/lib/resource-1.0/english/VerbEng.gf @@ -33,6 +33,6 @@ concrete VerbEng of Verb = CatEng ** open ResEng in { EmbedS s = {s = conjThat ++ s.s} ; EmbedQS qs = {s = qs.s ! QIndir} ; - EmbedVP vp = {s = infVP vp (agrP3 Sg).a} ; --- agr + EmbedVP vp = {s = infVP vp (agrP3 Sg)} ; --- agr } diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index bbae69efe..93b7f56ff 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -472,19 +472,6 @@ stateFirstCat sgr = where a = P.prt (absId sgr) -{- --- command-line option -cat=foo overrides the possible start cat of a grammar -stateTransferFun :: StateGrammar -> Maybe Fun -stateTransferFun sgr = getOptVal (stateOptions sgr) transferFun >>= return . zIdent - -stateConcrete = concreteOf . stateGrammarST -stateAbstract = abstractOf . stateGrammarST - -maybeStateAbstract (ShSt (ma,_,_)) = ma -hasStateAbstract = maybe False (const True) . maybeStateAbstract -abstractOfState = maybe emptyAbstractST id . maybeStateAbstract --} - stateIsWord :: StateGrammar -> String -> Bool stateIsWord sg = isKnownWord (stateMorpho sg) @@ -496,47 +483,9 @@ addProbs ip@(lang,probs) sh = do return $ sh{probss = pbs'} addTransfer :: (Ident,T.Env) -> ShellState -> ShellState -addTransfer it sh = sh {transfers = it : transfers sh} +addTransfer it@(i,_) sh = + sh {transfers = it : filter ((/= i) . fst) (transfers sh)} -{- - --- getting info on a language -existLang :: ShellState -> Language -> Bool -existLang st lang = elem lang (allLanguages st) - -stateConcreteOfLang :: ShellState -> Language -> StateConcrete -stateConcreteOfLang (ShSt (_,gs,_)) lang = - maybe emptyStateConcrete snd $ lookup lang gs - -fileOfLang :: ShellState -> Language -> FilePath -fileOfLang (ShSt (_,gs,_)) lang = - maybe nonExistingLangFile (fst .fst) $ lookup lang gs - -nonExistingLangFile = "NON-EXISTING LANGUAGE" --- - - -allLangOptions st lang = unionOptions (optionsOfLang st lang) (globalOptions st) - --- construct state - -stateGrammar st cf mo opts = StGr ((st,cf,mo),opts) - -initShellState ab fs gs opts = - ShSt (Just ab, [(getLangName f, ((f,True),g)) | (f,g) <- zip fs gs], opts) -emptyInitShellState opts = ShSt (Nothing, [], opts) - --- the second-last part of a file name is the default language name -getLangName :: String -> Language -getLangName file = language (if notElem '.' file then file else langname) where - elif = reverse file - xiferp = tail (dropWhile (/='.') elif) - langname = reverse (takeWhile (flip notElem "./") xiferp) - --- option -language=foo overrides the default language name -getLangNameOpt :: Options -> String -> Language -getLangNameOpt opts file = - maybe (getLangName file) language $ getOptVal opts useLanguage --} -- modify state type ShellStateOper = ShellState -> ShellState @@ -554,20 +503,6 @@ languageOnOff :: Bool -> Language -> ShellStateOper languageOnOff b lang sh = sh {concretes = cs'} where cs' = [if lang==l then (lc,b) else i | i@(lc@(l,c),_) <- concretes sh] -{- -updateLanguage :: FilePath -> (Language, StateConcrete) -> ShellStateOper -updateLanguage file (lang,gr) (ShSt (ab,gs,os)) = - ShSt (ab, updateAssoc (lang,((file,True),gr)) gs, os') where - os' = changeOptVal os useLanguage (prLanguage lang) -- actualizes the new lang - -initWithAbstract :: AbstractST -> ShellStateOper -initWithAbstract ab st@(ShSt (ma,cs,os)) = - maybe (ShSt (Just ab,cs,os)) (const st) ma - -removeLanguage :: Language -> ShellStateOper -removeLanguage lang (ShSt (ab,gs,os)) = ShSt (ab,removeAssoc lang gs, os) --} - changeOptions :: (Options -> Options) -> ShellStateOper --- __________ this is OBSOLETE changeOptions f sh = sh {gloptions = f (gloptions sh)}