msyds/gf-rgl
1
0
Fork 0
forked from GitHub/gf-rgl
Code Pull Requests Activity

Merge remote-tracking branch 'upstream/master' into extendlins

Browse Source
This commit is contained in:
odanoburu
2018-10-29 17:47:18 +00:00
parent ebe411c654 999cdb8e36
commit 3581176f6c
20 changed files with 145 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
src/arabic/NounAra.gf
View File

@@ -5,26 +5,28 @@ flags optimize=noexpand ;
lin
DetCN det cn = let {
number = sizeToNumber det.n;
state = possState det.d;
cas : Case -> Case = if_then_else Case det.is1sg Bare ;
number = sizeToNumber det.n ;
determiner : Case -> Str = \c ->
det.s ! cn.h ! (detGender cn.g det.n) ! c;
noun : Case -> NTable -> Str = \c,nt ->
let cas = if_then_else Case det.is1sg Bare c -- no case vowel with 1sg poss. suff.
in nt ! number
! nounState det.d number
! nounCase cas det.n det.d
det.s ! cn.h ! (detGender cn.g det.n) ! c ;
noun : Case -> Str = \c ->
cn.s ! number
! nounState det.d number
! nounCase c det.n det.d ;
adj : Case -> Str = \c ->
cn.adj ! number
! (definite ! det.d) -- Indef remains Indef, rest become Def
! c
} in {
s = \\c =>
case cnB4det det.isPron det.isNum det.n det.d of {
False => determiner c
++ noun c cn.s -- deal with poss. suffix
++ cn.adj ! number ! state ! c -- normal case+state
++ cn.np ! c ;
True => noun c cn.s -- deal with poss. suffix
-- ++ determiner c -- or this?
++ det.s ! cn.h ! cn.g ! c
++ cn.adj ! number ! state ! c -- normal case+state
++ noun c
++ adj c
++ cn.np ! c ;
True => noun (cas c) -- deal with possessive suffix
++ determiner c
++ adj c
++ cn.np ! c
};
a = { pgn = agrP3 cn.h cn.g number;
@@ -45,23 +47,20 @@ lin
};
a = np.a
} ;
{-
--should compile.. not working :( wierd error message.. bug?
{-
PPartNP np v2 =
let x = case np.a.pgn of {
Per3 g n => ( positAdj (v2.s ! VPPart) ) ! g ! n ! Indef ;
_ => \\_ => [] -- not occuring anyway
} in {
s = \\c => np.s ! c ++ x ! c ;
a = np.a
};
-}
Per3 g n => positAdj (v2.s ! VPPart) ) ! g ! n ! Indef ; -- doesn't work because trying to glue runtime tokens
Per2 g n => \\_ => [] ;
_ => \\_ => []
} in np ** {
s = \\c => np.s ! c ++ v2.s ! VPPart ---- TODO: agreement
};
-}
-- FIXME try parsing something like "this house now" and you'll get
-- an internal compiler error, but it still works.. wierd..
AdvNP np adv = {
s = \\c => np.s ! c ++ adv.s;
a = np.a
AdvNP np adv = np ** {
s = \\c => np.s ! c ++ adv.s
};
{-
DetSg quant ord = {
@@ -104,7 +103,7 @@ lin
PossPron p = {
s = \\_,_,_,_ => p.s ! Gen;
d = Poss;
is1sg = case p.a.pgn of { Per1 _ => True ; _ => False } ;
is1sg = case p.a.pgn of { Per1 Sing => True ; _ => False } ;
isPron = True;
isNum = False } ;

4
src/arabic/ParadigmsAra.gf
View File

@@ -435,8 +435,8 @@ resource ParadigmsAra = open
mkPron : (_,_,_ : Str) -> PerGenNum -> NP = \ana,nI,I,pgn ->
{ s =
table {
Acc => nI;
Gen => I;
Acc => BIND ++ nI; -- object suffix
Gen => BIND ++ I; -- possessive suffix
_ => ana
};
a = {pgn = pgn; isPron = True };

16
src/arabic/ResAra.gf
View File

@@ -48,8 +48,6 @@ resource ResAra = PatternsAra ** open Prelude, Predef, OrthoAra, ParamX in {
--for roots with 2 consonants (works also for assimilated strs, like fc~,
--because the function discards anything after the first two characters
mkRoot2 : Str -> Root2 = \fcl ->
-- let { cl = drop 2 fcl} in --drop 1 fcl
-- {f = take 2 fcl; c = take 2 cl}; --take 1
case fcl of {
f@? + c@? + _ => { f = f ; c = c } ;
_ => error ("mkRoot2: too short root" ++ fcl)
@@ -138,7 +136,7 @@ resource ResAra = PatternsAra ** open Prelude, Predef, OrthoAra, ParamX in {
VPerf Voice PerGenNum
| VImpf Mood Voice PerGenNum
| VImp Gender Number
| VPPart ;
| VPPart ; -- TODO: add gender and number (or check if easy to use BIND)
PerGenNum =
Per3 Gender Number
@@ -956,7 +954,7 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
--dual suffixes
dl : State => Case => Str =
table {
Const =>
(Const|Poss) =>
table {
Nom => "َا";
_ => "َيْ"
@@ -972,7 +970,7 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
--sound masculine plural suffixes
m_pl : State => Case => Str =
table {
Const =>
(Const|Poss) =>
table {
Nom => "ُو";
_ => "ِي"
@@ -1045,9 +1043,6 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
_ => Def --Lkitaabu
};
possState : State -> State = \s ->
case s of { Poss => Def ;
x => x } ;
--FIXME needs testing
nounCase : Case -> Size -> State -> Case =
\c,size,s ->
@@ -1271,7 +1266,10 @@ patHollowImp : (_,_ :Str) -> Gender => Number => Str =\xaf,xAf ->
mkNum : Str -> Str -> Str ->
{s : DForm => CardOrd => Gender => State => Case => Str} =
\wAhid,awwal,Ula ->
let { wAhida = wAhid + "َة"} in
let wAhida : Str = case wAhid of {
x + "ة" => mkAt wAhid ;
_ => wAhid + "َة" }
in
{ s= table {
unit => table {
NCard => table {

4
src/arabic/StructuralAra.gf
View File

@@ -43,9 +43,9 @@ concrete StructuralAra of Structural = CatAra **
-- how8many_IDet = mkDet "كَمْ" Pl Const ; -- IL: check (was ["هْو مَني"]) ;
-- if_Subj = ss "ِف" ;
in8front_Prep = ss "مُقَابِلَ" ;
i_Pron = mkPron "أَنَا" "نِي" "ِي" (Per1 Sing);
i_Pron = mkPron "أَنَا" "نِي" "ي" (Per1 Sing);
in_Prep = ss "فِي" ;
it_Pron = mkPron "ِت" "ِت" "ِتس" (Per3 Masc Sg); -- IL: check
it_Pron = he_Pron ; -- was: it_Pron = mkPron "ِت" "ِت" "ِتس" (Per3 Masc Sg);
-- less_CAdv = ss "لسّ" ;
many_Det = mkDet "جَمِيع" Pl Const ;
-- more_CAdv = ss "مْري" ;

10
src/english/CatEng.gf
View File

@@ -92,9 +92,9 @@ concrete CatEng of Cat = CommonX - [Pol,SC,CAdv] ** open ResEng, Prelude in {
-- Open lexical classes, e.g. Lexicon
V, VS, VQ, VA = Verb ; -- = {s : VForm => Str} ;
V2, V2A, V2Q, V2S = Verb ** {c2 : Str} ;
V3 = Verb ** {c2, c3 : Str} ;
V, VS, VQ, VA = Verb ;
V2, V2Q, V2S = Verb ** {c2 : Str} ;
V2A,V3 = Verb ** {c2, c3 : Str} ;
VV = {s : VVForm => Str ; p : Str ; typ : VVType} ;
V2V = Verb ** {c2,c3 : Str ; typ : VVType} ;
@@ -114,8 +114,8 @@ concrete CatEng of Cat = CommonX - [Pol,SC,CAdv] ** open ResEng, Prelude in {
VPSlash = \s -> predV {s = \\_ => s; p = ""; isRefl = False} ** {c2 = ""; gapInMiddle = False; missingAdv = False } ;
V, VS, VQ, VA = \s -> {s = \\_ => s; p = ""; isRefl = False} ;
V2, V2A, V2Q, V2S = \s -> {s = \\_ => s; p = ""; isRefl = False; c2=""} ;
V3 = \s -> {s = \\_ => s; p = ""; isRefl = False; c2,c3=""} ;
V2, V2Q, V2S = \s -> {s = \\_ => s; p = ""; isRefl = False; c2=""} ;
V3, V2A = \s -> {s = \\_ => s; p = ""; isRefl = False; c2,c3=""} ;
VV = \s -> {s = \\_ => s; p = ""; isRefl = False; typ = VVInf} ;
V2V = \s -> {s = \\_ => s; p = ""; isRefl = False; c2,c3="" ; typ = VVInf} ;

2
src/english/LexiconEng.gf
View File

@@ -132,7 +132,7 @@ lin
oil_N = regN "oil" ;
old_A = regADeg "old" ;
open_V2 = dirV2 (mkV "open" "opens" "opened" "opened" "opening") ;
paint_V2A = mkV2A (regV "paint") noPrep ;
paint_V2A = mkV2A (regV "paint") ;
paper_N = regN "paper" ;
paris_PN = mkPN (mkN nonhuman (mkN "Paris")) ;
peace_N = regN "peace" ;

12
src/english/ParadigmsEng.gf
View File

@@ -321,7 +321,11 @@ oper
} ;
ingV2V : V -> Prep -> Prep -> V2V ; -- e.g. prevent (noPrep NP) (from VP-ing)
mkVA : V -> VA ; -- e.g. become (AP)
mkV2A : V -> Prep -> V2A ; -- e.g. paint (NP) (AP)
mkV2A : overload {
mkV2A : V -> V2A ; -- e.g. paint (NP) (AP)
mkV2A : V -> Prep -> V2A ; -- backwards compatibility
mkV2A : V -> Prep -> Prep -> V2A ; -- e.g. strike (NP) as (AP)
} ;
mkVQ : V -> VQ ; -- e.g. wonder (QS)
mkV2Q : V -> Prep -> V2Q ; -- e.g. ask (NP) (QS)
@@ -601,7 +605,11 @@ mkInterj : Str -> Interj
ingV2V v p t = lin V2V (prepV2 v p ** {c3 = t.s ; typ = VVPresPart}) ;
mkVA v = lin VA v ;
mkV2A v p = lin V2A (prepV2 v p) ;
mkV2A = overload {
mkV2A : V -> V2A = \v -> lin V2A (dirdirV3 v) ;
mkV2A : V -> Prep -> V2A = \v,p -> lin V2A (dirV3 v p) ;
mkV2A : V -> Prep -> Prep -> V2A = \v,p1,p2 -> lin V2A (prepPrepV3 v p1 p2) ;
} ;
mkV2Q v p = lin V2Q (prepV2 v p) ;
mkAS v = v ;

2
src/english/VerbEng.gf
View File

@@ -21,7 +21,7 @@ concrete VerbEng of Verb = CatEng ** open ResEng, Prelude in {
SlashV2S v s = insertExtrac (conjThat ++ s.s) (predVc v) ; ---- insertExtra?
--- SlashV2S v s = insertObjc (variants {\\_ => conjThat ++ s.s; \\_ => s.s}) (predVc v) ;
SlashV2Q v q = insertExtrac (q.s ! QIndir) (predVc v) ;
SlashV2A v ap = insertObjc (\\a => ap.s ! a) (predVc v) ; ----
SlashV2A v ap = insertObjc (\\a => v.c3 ++ ap.s ! a) (predVc v) ; ----
ComplSlash vp np =
let vp' = case vp.gapInMiddle of {