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

(Ara) Fixes in pattern matching root and pattern

Browse Source
This commit is contained in:
Inari Listenmaa
2018-10-17 17:18:26 +02:00
parent e051829637
commit 6cd6ddd020
1 changed files with 24 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
src/arabic/ResAra.gf
View File

@@ -41,26 +41,19 @@ resource ResAra = PatternsAra ** open Prelude, Predef, OrthoAra, ParamX in {
-- AR 7/12/2009 changed this to avoid duplication of consonants -- AR 7/12/2009 changed this to avoid duplication of consonants
mkRoot3 : Str -> Root3 = \fcl -> case fcl of { mkRoot3 : Str -> Root3 = \fcl -> case fcl of {
f@? + c@? + l => {f = f ; c = c ; l = l} f@? + c@? + l => {f = f ; c = c ; l = l} ;
_ => error ("mkRoot3: too short root" ++ fcl)
} ; } ;
{-
mkRoot3 : Str -> Root3 = \fcl ->
let { cl = drop 2 fcl; --drop 1 fcl
l' = dp 2 fcl; --last fcl
c' = take 2 cl} in --take 1 cl
{f = take 2 fcl; c = c'; --take 1 fcl
l = case l' of {
"ّ" => c';
_ => l'
}
};
-}
--for roots with 2 consonants (works also for assimilated strs, like fc~, --for roots with 2 consonants (works also for assimilated strs, like fc~,
--because the function discards anything after the first two characters --because the function discards anything after the first two characters
mkRoot2 : Str -> Root2 = \fcl -> mkRoot2 : Str -> Root2 = \fcl ->
let { cl = drop 2 fcl} in --drop 1 fcl -- let { cl = drop 2 fcl} in --drop 1 fcl
{f = take 2 fcl; c = take 2 cl}; --take 1 -- {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)
};
--opers to interdigitize (make words out of roots and patterns: --opers to interdigitize (make words out of roots and patterns:
@@ -93,15 +86,23 @@ resource ResAra = PatternsAra ** open Prelude, Predef, OrthoAra, ParamX in {
--takes a pattern string and root string and makes a word --takes a pattern string and root string and makes a word
mkWord : Str -> Str -> Str =\pS, rS -> mkWord : Str -> Str -> Str =\pS, rS ->
case pS of { case pS of {
w@_ + "ف" + x@_ + "ع" + y@_ + "ل" + z@_ => w + "ف" + x + "ع" + y + "ل" + z =>
mkStrong { h = w ; m1 = x; m2 = y; t = z} (mkRoot3 rS); let pat = { h = w ; m1 = x; m2 = y; t = z} in
w@_ + "ف" + x@_ + "ع" + y@_ => case rS of {
x@? + y@? + "ّ" => mkStrong pat (mkRoot3 (x+y+y)) ; -- In principle, shadda shouldn't be in the root, but if someone puts one, this should fix it. /IL
_ => mkStrong pat (mkRoot3 rS) } ;
w + "ف" + x + "ع" + y =>
let pat = { h = w ; m1 = x; m2 = ""; t = y} in let pat = { h = w ; m1 = x; m2 = ""; t = y} in
case <length rS : Ints 100> of { case rS of {
-- 6 | 5 => mkWeak pat (mkRoot3 rS) ; --3=> x + "ّ" => mkBilit pat (mkRoot2 x) ; -- fc~
6 | 5 => mkHollow pat (mkRoot3 rS) ; --3=> x@? + y@? + ("و"|"ي")
4 | 3 => mkBilit pat (mkRoot2 rS) ; --2=> => mkDefective pat (mkRoot3 rS) ;
_ => rS ---- AR error "expected 3--6" x@? + ("و"|"ي") + z@?
=> mkHollow pat (mkRoot3 rS) ;
("و"|"ي") + y@? + z@?
=> mkAssimilated pat (mkRoot3 rS) ;
? + ? + _ => mkBilit pat (mkRoot2 rS) ; --2=>
_=> error rS ---- AR error "expected 3--6"
} }
}; };