1
0
forked from GitHub/gf-core

extending proto resource API

This commit is contained in:
aarne
2005-11-23 21:38:11 +00:00
parent f0e40a923d
commit b29877c590
22 changed files with 362 additions and 102 deletions

View File

@@ -2,12 +2,35 @@ abstract Cat = {
cat
S ;
Cl ;
QS ;
QCl ;
Slash ;
VP ;
NP ;
AP ;
Comp ;
V ;
V2 ;
V3 ;
VV ;
VS ;
VQ ;
Adv ;
CN ;
N ;
N2 ;
N3 ;
NP ;
PN ;
Pron ;
Det ;
Predet ;
Quant ;
Num ;
}

View File

@@ -1,16 +1,31 @@
concrete CatEng of Cat = open ResEng in {
lincat
S = {s : Str} ;
Cl = {s : Tense => Anteriority => Ord => Pol => Str} ;
S = {s : Str} ;
Cl = {s : Tense => Anteriority => Polarity => Ord => Str} ;
Slash = {s : Tense => Anteriority => Polarity => Ord => Str} ** {c2 : Str} ;
VP = {
s : Tense => Anteriority => Ord => Pol => Agr => {fin, inf : Str} ;
s : Tense => Anteriority => Polarity => Ord => Agr => {fin, inf : Str} ;
s2 : Agr => Str
} ;
NP = {s : Case => Str ; a : Agr} ;
AP = {s : Str} ;
Comp = {s : Agr => Str} ;
V = Verb ; -- = {s : VForm => Str} ;
V2 = Verb ** {s2 : Str} ;
VV = Verb ** {s2 : Str} ;
V, VS, VQ = Verb ; -- = {s : VForm => Str} ;
V2, VV = Verb ** {c2 : Str} ;
V3 = Verb ** {c2, c3 : Str} ;
Adv = {s : Str} ;
}
Det, Quant = {s : Str ; n : Number} ;
Predet, Num = {s : Str} ;
CN,N = {s : Number => Case => Str} ;
PN = {s : Case => Str} ;
Pron, NP = {s : Case => Str ; a : Agr} ;
N2 = {s : Number => Case => Str} ** {c2 : Str} ;
N3 = {s : Number => Case => Str} ** {c2,c3 : Str} ;
}

View File

@@ -1,32 +0,0 @@
concrete FunEng of Fun = CatEng ** open ResEng in {
flags optimize=all_subs ;
lin
Pred np vp = {
s = \\t,a,o,b =>
let
agr = np.a ;
verb = vp.s ! t ! a ! o ! b ! 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
}
} ;
UseV = predV ;
ComplV2 v np = insertObj (\\_ => v.s2 ++ np.s ! Acc) (predV v) ;
ComplVV v vp = insertObj (\\a => v.s2 ++ infVP vp a) (predV v) ;
UseComp comp = insertObj comp.s (predAux auxBe) ;
AdvVP vp adv = insertObj (\\_ => adv.s) vp ;
UseVV vv = {s = vv.s ; s2 = []} ; -- no "to"
CompAP ap = {s = \\_ => ap.s} ;
CompNP np = {s = \\_ => np.s ! Acc} ;
CompAdv a = {s = \\_ => a.s} ;
}

View File

@@ -2,11 +2,17 @@ abstract Lex = Cat ** {
fun
walk_V : V ;
kill_V2 : V2 ;
show_V3 : V3 ;
want_VV : VV ;
claim_VS : VS ;
ask_VQ : VQ ;
big_AP : AP ;
dog_N : N ;
son_N2 : N2 ;
way_N3 : N3 ;
i_NP, he_NP, we_NP : NP ;
i_Pron, he_Pron, we_Pron : Pron ;
here_Adv : Adv ;
}

View File

@@ -1,14 +1,24 @@
concrete LexEng of Lex = CatEng ** open ResEng in {
lin
walk_V = regV "walk" ;
kill_V2 = regV "kill" ** {s2 = []} ;
want_VV = regV "want" ** {s2 = "to"} ;
kill_V2 = regV "kill" ** {c2 = []} ;
show_V3 = regV "show" ** {c2 = [] ; c3 = "to"} ;
want_VV = regV "want" ** {c2 = "to"} ;
claim_VS = regV "claim" ;
ask_VQ = regV "ask" ;
big_AP = {s = "big"} ;
i_NP = mkNP "I" "me" "my" Sg P1 ;
he_NP = mkNP "he" "him" "his" Sg P3 ;
we_NP = mkNP "we" "us" "our" Pl P1 ;
big_AP = {s = "big"} ;
dog_N = regN "dog" ;
son_N2 = regN "son" ** {c2 = "of"} ;
way_N3 = regN "way" ** {c2 = "from" ; c3 = "to"} ;
here_Adv = {s = "here"} ;
-- structural
i_Pron = mkNP "I" "me" "my" Sg P1 ;
he_Pron = mkNP "he" "him" "his" Sg P3 ;
we_Pron = mkNP "we" "us" "our" Pl P1 ;
}

View File

@@ -0,0 +1,38 @@
abstract Noun = Cat ** {
fun
DetCN : Det -> CN -> NP ;
UsePN : PN -> NP ;
UsePron : Pron -> NP ;
MkDet : Predet -> Quant -> Num -> Det ;
PossPronSg, PossPronPl : Pron -> Quant ; --- PossNP not in romance
NoNum : Num ;
NumInt : Int -> Num ;
NoPredet : Predet ;
DefSg, DefPl : Quant ;
IndefSg, IndefPl : Quant ;
-- Num_Pl ::= Ordinal ;
-- Num_Pl ::= Numeral ;
ComplN2 : N2 -> NP -> CN ;
ComplN3 : N3 -> NP -> N2 ;
AdjCN : AP -> CN -> CN ;
SentCN : CN -> S -> CN ;
QuestCN : CN -> QS -> CN ;
UseN : N -> CN ;
-- structural
only_Predet : Predet ;
this_Quant : Quant ;
} ;

View File

@@ -0,0 +1,36 @@
concrete NounEng of Noun = CatEng ** open ResEng 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 ;
UsePron p = p ; --- causes mcfg error, even if expanded
MkDet pred quant num = {
s = pred.s ++ quant.s ++ num.s ;
n = quant.n
} ;
PossPronSg p = {s = p.s ! Gen ; n = Sg} ;
PossPronPl p = {s = p.s ! Gen ; n = Pl} ;
NoNum, NoPredet = {s = []} ;
NumInt n = n ;
DefSg = {s = "the" ; n = Sg} ;
DefPl = {s = "the" ; n = Pl} ;
IndefSg = {s = "a" ; n = Sg} ;
IndefPl = {s = [] ; n = Pl} ;
UseN n = n ;
ComplN2 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c} ;
ComplN3 f x = {s = \\n,c => f.s ! n ! Nom ++ f.c2 ++ x.s ! c ; c2 = f.c3} ;
-- structural
only_Predet = {s = "only"} ;
}

View File

@@ -0,0 +1,13 @@
resource ParamX = {
param
Number = Sg | Pl ;
Person = P1 | P2 | P3 ;
Anteriority = Simul | Anter ;
Tense = Pres | Past | Fut | Cond ;
Polarity = Pos | Neg ;
QForm = QDir | QIndir ;
}

View File

@@ -1,20 +1,32 @@
resource ResEng = {
resource ResEng = ParamX ** {
param
Number = Sg | Pl ;
Person = P1 | P2 | P3 ;
Case = Nom | Acc | Gen ;
Anteriority = Simul | Anter ;
Tense = Pres | Past | Fut | Cond ;
Pol = PPos | PNeg ;
Ord = ODir | OQuest ;
Case = Nom | Acc | Gen ;
VForm = VInf | VPres | VPast | VPPart | VPresPart ;
Ord = ODir | OQuest ;
oper
Agr = {n : Number ; p : Person} ;
agrP3 : Number -> {a : Agr} = \n -> {a = {n = n ; p = P3}} ;
regN : Str -> {s : Number => Case => Str} = \car -> {
s = table {
Sg => table {
Gen => car + "'s" ;
_ => car
} ;
Pl => table {
Gen => car + "s'" ;
_ => car + "s"
}
}
} ;
regV : Str -> {s : VForm => Str} = \walk -> {
s = table {
VInf => walk ;
@@ -24,7 +36,7 @@ resource ResEng = {
}
} ;
mkNP : (i,me,my : Str) -> Number -> Person -> {s : Case => Str ; a : Agr} =
mkNP : (i,me,my : Str) -> Number -> Person -> {s : Case => Str ; a : Agr} =
\i,me,my,n,p -> {
s = table {
Nom => i ;
@@ -42,12 +54,12 @@ resource ResEng = {
} ;
VP : Type = {
s : Tense => Anteriority => Ord => Pol => Agr => {fin, inf : Str} ;
s : Tense => Anteriority => Polarity => Ord => Agr => {fin, inf : Str} ;
s2 : Agr => Str
} ;
predV : Verb -> VP = \verb -> {
s = \\t,ant,ord,b,agr =>
s = \\t,ant,b,ord,agr =>
let
inf = verb.s ! VInf ;
fin = presVerb verb agr ;
@@ -57,30 +69,30 @@ resource ResEng = {
{fin = x ; inf = y} ;
in
case <t,ant,b,ord> of {
<Pres,Simul,PPos,ODir> => vf fin [] ;
<Pres,Simul,PPos,OQuest> => vf (does agr) inf ;
<Pres,Simul,PNeg,_> => vf (doesnt agr) inf ;
<Pres,Anter,PPos,_> => vf (have agr) part ;
<Pres,Anter,PNeg,_> => vf (havent agr) part ;
<Past,Simul,PPos,ODir> => vf past [] ;
<Past,Simul,PPos,OQuest> => vf "did" inf ;
<Past,Simul,PNeg,_> => vf "didn't" inf ;
<Past,Anter,PPos,_> => vf "had" part ;
<Past,Anter,PNeg,_> => vf "hadn't" part ;
<Fut, Simul,PPos,_> => vf "will" inf ;
<Fut, Simul,PNeg,_> => vf "won't" inf ;
<Fut, Anter,PPos,_> => vf "will" ("have" ++ part) ;
<Fut, Anter,PNeg,_> => vf "won't" ("have" ++ part) ;
<Cond,Simul,PPos,_> => vf "would" inf ;
<Cond,Simul,PNeg,_> => vf "wouldn't" inf ;
<Cond,Anter,PPos,_> => vf "would" ("have" ++ part) ;
<Cond,Anter,PNeg,_> => vf "wouldn't" ("have" ++ part)
<Pres,Simul,Pos,ODir> => vf fin [] ;
<Pres,Simul,Pos,OQuest> => vf (does agr) inf ;
<Pres,Simul,Neg,_> => vf (doesnt agr) inf ;
<Pres,Anter,Pos,_> => vf (have agr) part ;
<Pres,Anter,Neg,_> => vf (havent agr) part ;
<Past,Simul,Pos,ODir> => vf past [] ;
<Past,Simul,Pos,OQuest> => vf "did" inf ;
<Past,Simul,Neg,_> => vf "didn't" inf ;
<Past,Anter,Pos,_> => vf "had" part ;
<Past,Anter,Neg,_> => vf "hadn't" part ;
<Fut, Simul,Pos,_> => vf "will" inf ;
<Fut, Simul,Neg,_> => vf "won't" inf ;
<Fut, Anter,Pos,_> => vf "will" ("have" ++ part) ;
<Fut, Anter,Neg,_> => vf "won't" ("have" ++ part) ;
<Cond,Simul,Pos,_> => vf "would" inf ;
<Cond,Simul,Neg,_> => vf "wouldn't" inf ;
<Cond,Anter,Pos,_> => vf "would" ("have" ++ part) ;
<Cond,Anter,Neg,_> => vf "wouldn't" ("have" ++ part)
} ;
s2 = \\_ => []
} ;
predAux : Aux -> VP = \verb -> {
s = \\t,ant,ord,b,agr =>
s = \\t,ant,b,ord,agr =>
let
inf = verb.inf ;
fin = verb.pres ! b ! agr ;
@@ -91,19 +103,19 @@ resource ResEng = {
in
case <t,ant,b,ord> of {
<Pres,Simul,_, _> => vf fin [] ;
<Pres,Anter,PPos,_> => vf (have agr) part ;
<Pres,Anter,PNeg,_> => vf (havent agr) part ;
<Pres,Anter,Pos,_> => vf (have agr) part ;
<Pres,Anter,Neg,_> => vf (havent agr) part ;
<Past,Simul,_, _> => vf fin [] ;
<Past,Anter,PPos,_> => vf "had" part ;
<Past,Anter,PNeg,_> => vf "hadn't" part ;
<Fut, Simul,PPos,_> => vf "will" inf ;
<Fut, Simul,PNeg,_> => vf "won't" inf ;
<Fut, Anter,PPos,_> => vf "will" ("have" ++ part) ;
<Fut, Anter,PNeg,_> => vf "won't" ("have" ++ part) ;
<Cond,Simul,PPos,_> => vf "would" inf ;
<Cond,Simul,PNeg,_> => vf "wouldn't" inf ;
<Cond,Anter,PPos,_> => vf "would" ("have" ++ part) ;
<Cond,Anter,PNeg,_> => vf "wouldn't" ("have" ++ part)
<Past,Anter,Pos,_> => vf "had" part ;
<Past,Anter,Neg,_> => vf "hadn't" part ;
<Fut, Simul,Pos,_> => vf "will" inf ;
<Fut, Simul,Neg,_> => vf "won't" inf ;
<Fut, Anter,Pos,_> => vf "will" ("have" ++ part) ;
<Fut, Anter,Neg,_> => vf "won't" ("have" ++ part) ;
<Cond,Simul,Pos,_> => vf "would" inf ;
<Cond,Simul,Neg,_> => vf "wouldn't" inf ;
<Cond,Anter,Pos,_> => vf "would" ("have" ++ part) ;
<Cond,Anter,Neg,_> => vf "wouldn't" ("have" ++ part)
} ;
s2 = \\_ => []
} ;
@@ -117,7 +129,7 @@ resource ResEng = {
agrVerb (verb.s ! VPres) (verb.s ! VInf) ;
infVP : VP -> Agr -> Str = \vp,a ->
(vp.s ! Fut ! Simul ! ODir ! PNeg ! a).inf ++ vp.s2 ! a ;
(vp.s ! Fut ! Simul ! Neg ! ODir ! a).inf ++ vp.s2 ! a ;
agrVerb : Str -> Str -> Agr -> Str = \has,have,agr ->
case agr of {
@@ -130,7 +142,7 @@ resource ResEng = {
does = agrVerb "does" "do" ;
doesnt = agrVerb "doesn't" "don't" ;
Aux = {pres,past : Pol => Agr => Str ; inf,ppart : Str} ;
Aux = {pres,past : Polarity => Agr => Str ; inf,ppart : Str} ;
auxBe : Aux = {
pres = \\b,a => agrVerb (posneg b "is") (posneg b "are") a ;
@@ -139,9 +151,11 @@ resource ResEng = {
ppart = "been"
} ;
posneg : Pol -> Str -> Str = \p,s -> case p of {
PPos => s ;
PNeg => s + "n't"
posneg : Polarity -> Str -> Str = \p,s -> case p of {
Pos => s ;
Neg => s + "n't"
} ;
conjThat : Str = "that" ;
}

View File

@@ -0,0 +1,10 @@
abstract Sentence = Cat ** {
fun
PredVP : NP -> VP -> Cl ;
SlashV2 : NP -> V2 -> Slash ;
}

View File

@@ -0,0 +1,20 @@
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
}
} ;
}

View File

@@ -0,0 +1,13 @@
abstract Tense = {
cat
Pol ;
Tense ;
Ant ;
fun
PPos, PNeg : Pol ;
TPres, TPast, TFut, TCond : Tense ;
ASimul, AAnter : Ant ;
}

View File

@@ -0,0 +1,22 @@
concrete TenseX of Tense = open (R = ParamX) in {
lincat
Tense = {s : Str ; t : R.Tense} ;
Ant = {s : Str ; a : R.Anteriority} ;
Pol = {s : Str ; p : R.Polarity} ;
lin
PPos = {s = []} ** {p = R.Pos} ;
PNeg = {s = []} ** {p = R.Neg} ;
TPres = {s = []} ** {t = R.Pres} ;
TPast = {s = []} ** {t = R.Past} ;
TFut = {s = []} ** {t = R.Fut} ;
TCond = {s = []} ** {t = R.Cond} ;
ASimul = {s = []} ** {a = R.Simul} ;
AAnter = {s = []} ** {a = R.Anter} ;
}

View File

@@ -0,0 +1,5 @@
abstract Tensed = Cat, Tense ** {
fun
UseCl : Tense -> Ant -> Pol -> Cl -> S ;
}

View File

@@ -0,0 +1,8 @@
concrete TensedEng of Tensed = CatEng, TenseX ** open ResEng in {
flags optimize=all_subs ;
lin
UseCl t a p cl = {s = t.s ++ a.s ++ p.s ++ cl.s ! t.t ! a.a ! p.p ! ODir} ;
}

View File

@@ -1 +1,8 @@
abstract Test = Fun, Lex ** {} ;
abstract Test =
Noun,
Verb,
Sentence,
Untensed,
-- Tensed,
Lex
** {} ;

View File

@@ -1 +1,8 @@
concrete TestEng of Test = FunEng, LexEng ** {} ;
concrete TestEng of Test =
NounEng,
VerbEng,
SentenceEng,
UntensedEng,
-- TensedEng,
LexEng
** {} ;

View File

@@ -0,0 +1,6 @@
abstract Untensed = Cat ** {
fun
PosCl, NegCl : Cl -> S ;
}

View File

@@ -0,0 +1,9 @@
concrete UntensedEng of Untensed = CatEng ** open ResEng in {
flags optimize=all_subs ;
lin
PosCl cl = {s = cl.s ! Pres ! Simul ! Pos ! ODir} ;
NegCl cl = {s = cl.s ! Pres ! Simul ! Neg ! ODir} ;
}

View File

@@ -1,14 +1,18 @@
abstract Fun = Cat ** {
abstract Verb = Cat ** {
fun
Pred : NP -> VP -> Cl ;
UseV : V -> VP ;
ComplV2 : V2 -> NP -> VP ;
ComplV3 : V3 -> NP -> NP -> VP ;
ComplVV : VV -> VP -> VP ;
ComplVS : VS -> S -> VP ;
ComplVQ : VQ -> QS -> VP ;
UseComp : Comp -> VP ;
AdvVP : VP -> Adv -> VP ;
UseVV : VV -> V2 ;
UseVQ : VQ -> V2 ;
UseVS : VS -> V2 ;
CompAP : AP -> Comp ;
CompNP : NP -> Comp ;

View File

@@ -0,0 +1,23 @@
concrete VerbEng of Verb = CatEng ** open ResEng in {
flags optimize=all_subs ;
lin
UseV = predV ;
ComplV2 v np = insertObj (\\_ => v.c2 ++ np.s ! Acc) (predV v) ;
ComplV2 v np = insertObj (\\_ => v.c2 ++ np.s ! Acc) (predV v) ;
ComplV3 v np np2 =
insertObj (\\_ => v.c2 ++ np.s ! Acc ++ v.c3 ++ np2.s ! Acc) (predV v) ;
ComplVV v vp = insertObj (\\a => v.c2 ++ infVP vp a) (predV v) ;
ComplVS v s = insertObj (\\_ => conjThat ++ s.s) (predV v) ;
ComplVQ v q = insertObj (\\_ => q.s) (predV v) ;
UseComp comp = insertObj comp.s (predAux auxBe) ;
AdvVP vp adv = insertObj (\\_ => adv.s) vp ;
UseVV, UseVS, UseVQ = \vv -> {s = vv.s ; c2 = []} ; -- no "to"
CompAP ap = {s = \\_ => ap.s} ;
CompNP np = {s = \\_ => np.s ! Acc} ;
CompAdv a = {s = \\_ => a.s} ;
}

View File

@@ -179,13 +179,16 @@ Path path ++. lbl = Path (Left lbl : path)
(++!) :: Path c t -> Term c t -> Path c t
Path path ++! sel = Path (Right sel : path)
lintypeFollowPath :: Path c t -> LinType c t -> LinType c t
lintypeFollowPath :: (Show c,Show t) => Path c t -> LinType c t -> LinType c t
lintypeFollowPath (Path path) = follow path
where follow [] ctype = ctype
follow (Right pat : path) (TblT _ ctype) = follow path ctype
follow (Left lbl : path) (RecT rec)
= maybe err (follow path) $ lookup lbl rec
where err = error $ "lintypeFollowPath: label not in record type"
++ "\n" ++ show lbl
++ "\n" ++ show rec
--- by AR for debugging 23/11/2005
termFollowPath :: (Eq c, Eq t) => Path c t -> Term c t -> Term c t
termFollowPath (Path path) = follow (reverse path)