finalizing experiments with Finnish nouns

examples/uusisuomi/Makefile

@@ -1,10 +1,14 @@
-#LEX=Duodecim
+LEX=Omat
-#LEX=Aino
-#LEX=Omat
-#LEX=NSSK
-LEX=Swadesh
 
-all: tests
+all: 
+	export LEX=NSSK ; make -e tests
+	export LEX=Omat ; make -e tests
+	export LEX=Swadesh ; make -e tests
+	export LEX=Dictionary ; make -e tests
+	export LEX=Duodecim ; make -e tests
+	export LEX=Aino ; make -e tests
+	cat all-diff-* >all-differences
+	cat all-differences
 
 gf-files:
 	runghc MkLex.hs 0 $(LEX) > $(LEX)Abs.gf

examples/uusisuomi/Nominal.gf

@@ -31,10 +31,17 @@ resource Nominal = ResFin ** open MorphoFin,Declensions,CatFin,Prelude in {
       _ + "is" => dKaunis ukko ;
       _ + ("i" | "u") + "n" => dLiitin ukko (renka + "men") ;
       _ + ("ton" | "tön") => dOnneton ukko ;
+      _ + "e" => dRae ukko (rake + "en") ;
       _ + ("ut" | "yt") => dRae ukko (ukk + "en") ;
       _ + ("as" | "äs") => dRae ukko (renka + last renka + "n") ;
-      _ + "e" => dRae ukko (rake + "en") ;
+      _ + ("uus" | "yys") => dLujuus ukko ;
       _ + "s" => dJalas ukko ; 
+      _ + ("a" | "e" | "i") + C_ + _ + "aja" =>  -- opettaja correct autom. 
+          dSilakka ukko (ukko + "n") (ukk + "ia") ;
+      _ + ("a" | "e" | "i" | "o" | "u") + C_ + _ + "ija" =>  
+          dSilakka ukko (ukko + "n") (ukk + "oita") ;
+      _ + ("e" | "i" | "y" | "ä" | "ö") + C_ + _ + "ijä" =>  
+          dSilakka ukko (ukko + "n") (ukk + "öitä") ;
       _ + "i" +o@("o"|"ö") => dSilakka ukko (ukko+"n") (ukko+"it"+getHarmony o);
       _ + "i" + "a" => dSilakka ukko (ukko + "n") (ukk + "oita") ;
       _ + "i" + "ä" => dSilakka ukko (ukko + "n") (ukk + "öitä") ;
@@ -52,7 +59,7 @@ resource Nominal = ResFin ** open MorphoFin,Declensions,CatFin,Prelude in {
       case <ukko,ukon> of {
         <_ + ("aa" | "ee" | "ii" | "oo" | "uu" | "yy" | "ää" | "öö" | 
               "ie" | "uo" | "yö" | "ea" | "eä" | 
-              "ia" | "iä" | "io" | "iö"), _ + "n"> => 
+              "ia" | "iä" | "io" | "iö" | "ja" | "jä"), _ + "n"> => 
            nForms1 ukko ; --- to protect
         <_ + ("a" | "o" | "u" | "y" | "ä" | "ö"), _ + "n"> => 
           dUkko ukko ukon ;  -- auto,auton

examples/uusisuomi/correct-Duodecim.txt

@@ -52,7 +52,7 @@ hyperkalsemia hyperkalsemian hyperkalsemiaa hyperkalsemiana hyperkalsemiaan hype
 
 seerumi seerumin seerumia seerumina seerumiin seerumien seerumeja seerumeina seerumeissa seerumeihin
 
-pitoisuus pitoisuuksen pitoisuusta pitoisuuksena pitoisuukseen pitoisuusten pitoisuuksia pitoisuuksina pitoisuuksissa pitoisuuksiin
+pitoisuus pitoisuuden pitoisuutta pitoisuutena pitoisuuteen pitoisuuksien pitoisuuksia pitoisuuksina pitoisuuksissa pitoisuuksiin
 
 viitealue viitealueen viitealuetta viitealueena viitealueeseen viitealueiden viitealueita viitealueina viitealueissa viitealueisiin
 

src/GF/Compile/CheckGrammar.hs

@@ -613,6 +613,7 @@ inferLType gr trm = case trm of
      PString _ -> True
      PInt _ -> True
      PFloat _ -> True
+     PChar -> True
      PSeq p q -> isConstPatt p && isConstPatt q
      PAlt p q -> isConstPatt p && isConstPatt q
      PRep p -> isConstPatt p
@@ -626,6 +627,7 @@ inferLType gr trm = case trm of
      PNeg p   -> inferPatt p
      PAlt p q -> checks [inferPatt p, inferPatt q]
      PSeq _ _ -> return $ typeStr
+     PChar    -> return $ typeStr
      PRep _   -> return $ typeStr
      _ -> infer (patt2term p) >>= return . snd
 

src/GF/Devel/CheckGrammar.hs

@@ -613,6 +613,7 @@ inferLType gr trm = case trm of
      PString _ -> True
      PInt _ -> True
      PFloat _ -> True
+     PChar -> True
      PSeq p q -> isConstPatt p && isConstPatt q
      PAlt p q -> isConstPatt p && isConstPatt q
      PRep p -> isConstPatt p
@@ -627,6 +628,7 @@ inferLType gr trm = case trm of
      PAlt p q -> checks [inferPatt p, inferPatt q]
      PSeq _ _ -> return $ typeStr
      PRep _   -> return $ typeStr
+     PChar    -> return $ typeStr
      _ -> infer (patt2term p) >>= return . snd
 
 

src/GF/Grammar/Grammar.hs

@@ -190,6 +190,7 @@ data Patt =
  | PAlt Patt Patt         -- ^ disjunctive pattern: p1 | p2
  | PSeq Patt Patt         -- ^ sequence of token parts: p + q
  | PRep Patt              -- ^ repetition of token part: p*
+ | PChar                  -- ^ string of length one
 
   deriving (Read, Show, Eq, Ord)
 

src/GF/Grammar/Macros.hs

@@ -521,6 +521,8 @@ term2patt trm = case termForm trm of
   Ok ([], Cn (IC "*"), [a]) -> do
     a' <- term2patt a
     return (PRep a')
+  Ok ([], Cn (IC "?"), []) -> do
+    return PChar
   Ok ([], Cn (IC "+"), [a,b]) -> do
     a' <- term2patt a
     b' <- term2patt b
@@ -547,6 +549,7 @@ patt2term pt = case pt of
   PString s -> K s 
 
   PAs x p   -> appc "@" [Vr x, patt2term p]            --- an encoding
+  PChar     -> appc "?" []                             --- an encoding
   PSeq a b  -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
   PAlt a b  -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
   PRep a    -> appc "*" [(patt2term a)]                --- an encoding

src/GF/Grammar/PatternMatch.hs

@@ -111,6 +111,8 @@ tryMatch (p,t) = do
          matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
          return (concat matches)
 
+      (PChar, ([],K [_],[])) -> return []
+
       (PRep p1, ([],K s, [])) -> checks [
          trym (foldr (const (PSeq p1)) (PString "") 
            [1..n]) t' | n <- [0 .. length s]

src/GF/Source/GrammarToSource.hs

@@ -219,6 +219,7 @@ trp p = case p of
     PSeq p q -> P.PSeq (trp p) (trp q)
     PRep p   -> P.PRep (trp p)
     PNeg p   -> P.PNeg (trp p)
+    PChar    -> P.PV (IC "C_") ---- temporary encoding
 
 
 trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty

src/GF/Source/SourceToGrammar.hs

@@ -539,7 +539,7 @@ trLabel :: Label -> Err G.Label
 trLabel x = case x of
 
   -- this case is for bward compatibiity and should be removed
-  LIdent (IC ('v':ds)) | all isDigit ds -> return $ G.LVar $ readIntArg ds 
+  LIdent (IC ('v':ds@(_:_))) | all isDigit ds -> return $ G.LVar $ readIntArg ds 
   
   LIdent (IC s) -> return $ G.LIdent s
   LVar x   -> return $ G.LVar $ fromInteger x
@@ -572,6 +572,7 @@ transPatts p = case p of
 transPatt :: Patt -> Err G.Patt
 transPatt x = case x of
   PW  -> return G.wildPatt
+  PV (IC "C_") -> return G.PChar ---- temporary encoding
   PV id  -> liftM G.PV $ transIdent id
   PC id patts  -> liftM2 G.PC (transIdent id) (mapM transPatt patts)
   PCon id  -> liftM2 G.PC (transIdent id) (return [])