mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
tidy up res; bug fix in ShellState.addTransfer
This commit is contained in:
@@ -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} ;
|
||||
|
||||
}
|
||||
|
||||
@@ -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} ;
|
||||
|
||||
}
|
||||
38
lib/resource-1.0/abstract/SeqConjunction.gf
Normal file
38
lib/resource-1.0/abstract/SeqConjunction.gf
Normal file
@@ -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 ;
|
||||
|
||||
}
|
||||
@@ -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"} ;
|
||||
|
||||
|
||||
@@ -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} ;
|
||||
|
||||
}
|
||||
|
||||
@@ -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 ->
|
||||
|
||||
@@ -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}} ;
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 ;
|
||||
|
||||
@@ -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 = []} ;
|
||||
|
||||
@@ -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 =>
|
||||
|
||||
@@ -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 = {
|
||||
|
||||
@@ -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} =
|
||||
|
||||
@@ -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 ;
|
||||
|
||||
@@ -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} ;
|
||||
|
||||
}
|
||||
@@ -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
|
||||
|
||||
}
|
||||
|
||||
@@ -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)}
|
||||
|
||||
Reference in New Issue
Block a user