From 6cd6ddd020045093e08a5eae96371fb1cb0451cd Mon Sep 17 00:00:00 2001
From: Inari Listenmaa <inari.listenmaa@gmail.com>
Date: Wed, 17 Oct 2018 17:18:26 +0200
Subject: [PATCH] (Ara) Fixes in pattern matching root and pattern

---
 src/arabic/ResAra.gf | 47 ++++++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 23 deletions(-)

diff --git a/src/arabic/ResAra.gf b/src/arabic/ResAra.gf
index 3031f0062..bb2fbf0be 100644
--- a/src/arabic/ResAra.gf
+++ b/src/arabic/ResAra.gf
@@ -41,26 +41,19 @@ resource ResAra = PatternsAra ** open  Prelude, Predef, OrthoAra, ParamX  in {
 
 -- AR 7/12/2009 changed this to avoid duplication of consonants
     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~,
     --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
+      -- 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)
+      };
 
     --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
     mkWord : Str -> Str -> Str  =\pS, rS ->
       case pS of {
-        w@_ + "ف" + x@_ + "ع" + y@_ + "ل" + z@_ =>
-          mkStrong { h = w ; m1 = x; m2 = y; t = z} (mkRoot3 rS);
-        w@_ + "ف" + x@_ + "ع" + y@_ =>
+        w + "ف" + x + "ع" + y + "ل" + z =>
+          let pat = { h = w ; m1 = x; m2 = y; t = z} in
+          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
-          case <length rS : Ints 100> of {
---            6 | 5 => mkWeak pat (mkRoot3 rS) ; --3=>
-            6 | 5 => mkHollow pat (mkRoot3 rS) ; --3=>
-            4 | 3 => mkBilit pat (mkRoot2 rS) ; --2=>
-            _ => rS ---- AR error "expected 3--6"
+          case rS of {
+               x + "ّ" => mkBilit pat (mkRoot2 x) ; -- fc~
+               x@? + y@? + ("و"|"ي")
+                       => mkDefective pat (mkRoot3 rS) ;
+               x@? + ("و"|"ي") + z@?
+                       => mkHollow pat (mkRoot3 rS) ;
+              ("و"|"ي") + y@? + z@? 
+                      => mkAssimilated pat (mkRoot3 rS) ;
+              ? + ? + _ => mkBilit pat (mkRoot2 rS) ; --2=>
+              _=> error rS ---- AR error "expected 3--6"
           }
       };