kotus experiments; bindings in gfcc

examples/uusisuomi/Declensions.gf

@@ -142,9 +142,9 @@ resource Declensions = ResFin ** open MorphoFin,CatFin,Prelude in {
       silakoiden = case <silakoita : Str> of {
         _ + "i" + ("a" | "ä") =>                    -- asemia
           <silakka+a, silakk + "ien", silakk, silak, silakk + "iin"> ;
-        _ + O@("o" | "ö") + ("ja" | "jä") =>        -- pasuunoja
+        _ + O@("o" | "ö" | "u" | "y" | "e") + ("ja" | "jä") =>        -- pasuunoja
           <silakka+a,silakk+O+"jen",silakk+O, silak+O, silakk +O+ "ihin"> ;
-        _ + O@("o" | "ö") + ("ita" | "itä") =>      -- silakoita
+        _ + O@("o" | "ö" | "u" | "y" | "e") + ("ita" | "itä") =>      -- silakoita
           <silakkaa, silak+O+"iden",silakk+O, silak+O, silakk +O+ "ihin"> ;
         _   => Predef.error silakoita                    
         } ;

examples/uusisuomi/Kotus.gf

@@ -9,12 +9,12 @@ oper
   d01A : Str -> NForms -- 166 yökkö
     = \s -> dUkko s (weakGrade s + "n") ;
   d02 : Str -> NForms -- 1189 ääntely
-    = \s -> dSilakka s (s + "n") (s + "j" + vowelHarmony (last s)) ;
+    = \s -> dSilakka s (s + "n") (s + "j" + getHarmony (last s)) ;
   d03 : Str -> NForms -- 481 ääntiö
-    = \s -> dSilakka s (s + "n") (s + "it" + vowelHarmony (last s)) ;
+    = \s -> dSilakka s (s + "n") (s + "it" + vowelHarmony s) ;
   d04A : Str -> NForms -- 273 äpärikkö
     = \s -> let ws = weakGrade s in 
-      dSilakka s (ws + "n") (ws + "it" + vowelHarmony (last s)) ;
+      dSilakka s (ws + "n") (ws + "it" + getHarmony (last s)) ;
   d05 : Str -> NForms -- 3212 öljymaali
     = \s -> dPaatti s (s + "n") ;
   d05A : Str -> NForms -- 1959 öylätti
@@ -136,9 +136,9 @@ oper
   d40 : Str -> NForms -- 2482 öykkärimäisyys
     = dLujuus  ;
   d41 : Str -> NForms -- 127 äyräs
-    = \s -> let is = init s in dRae s (is + last is ++ "n") ;
+    = \s -> let is = init s in dRae s (is + last is + "n") ;
   d41A : Str -> NForms -- 401 öljykangas
-    = \s -> let is = init s in dRae s (strongGrade is + last is ++ "n") ;
+    = \s -> let is = init s in dRae s (strongGrade is + last is + "n") ;
   d42 : Str -> NForms -- 1 mies
     = \s -> let mieh = init s + "s" in 
       nForms10

examples/uusisuomi/Makefile

@@ -1,6 +1,8 @@
 LEX=Omat
 CAT=N
 
+.PHONY: kotus
+
 all: nouns
 
 verbs: 
@@ -21,6 +23,10 @@ nouns:
 	cat all-diff-* >all-differences
 	cat all-differences
 
+kotus: 
+	export LEX=KOTUS ; make -e tests
+	cat all-diff-KOTUS
+
 CSC: 
 	export LEX=NCSC ; make -e tests
 	cat all-diff-NCSC
@@ -33,7 +39,7 @@ gf-files:
 	runghc MkLex.hs 4 $(CAT) $(LEX) > $(LEX)4.gf
 
 experiments: gf-files
-	echo "gt -cat=Utt | l | wf exper1-$(LEX).txt" | gf -s $(LEX)1.gf
+#	echo "gt -cat=Utt | l | wf exper1-$(LEX).txt" | gf -s $(LEX)1.gf
 	echo "gt -cat=Utt | l | wf exper2-$(LEX).txt" | gf -s $(LEX)2.gf
 	echo "gt -cat=Utt | l | wf exper3-$(LEX).txt" | gf -s $(LEX)3.gf
 	echo "gt -cat=Utt | l | wf exper4-$(LEX).txt" | gf -s $(LEX)4.gf

examples/uusisuomi/MkLex.hs

@@ -37,9 +37,9 @@ initiate tgt cat i = mapM_ putStrLn [
       "lin testV = showV ;"
      ]
 
-nums = map prt [1 ..] where
+nums = map prt [10001 ..] where
 ----  prt i = (if i < 10 then "0" else "") ++ show i ++ ". "
-  prt i = let n = show i in replicate (4-length n) '0' ++ n ++ ". "
+  prt i = show i ++ ". "
 
 -- W is the flag for mixed-class word lists
 mkLex "W" 0 line = case words line of

examples/uusisuomi/kotus/Kotus.hs

@@ -5,19 +5,19 @@ kotus = "sanat.xxmmll"
 
 main = do
   ss <- readFile kotus >>= return . lines
-  let ws = map analyse ss
+  let ws = [w | Just w <- map analyse ss]
   writeFile "kotus.gf" $ unlines $ treat ws
 --  mapM putStrLn $ treat ws
 
 treat = map mkLin . entries
 
-entries = zip [10000..] . filter isNoun
+entries = zip [10001..] . filter isNoun
 
 isNoun x = ((<5) . read . take 1 . fst) x && (all isAlpha . snd) x
 
 mkLin (n,(pa,ex)) = 
   "fun n" ++ show n ++ "_" ++ ex ++ " : N ;\n" ++
-  "lin n" ++ show n ++ "_" ++ ex ++ " = d" ++ pa ++ " \"" ++ ex ++ "\" ;"
+  "lin n" ++ show n ++ "_" ++ ex ++ " = ud d" ++ pa ++ " \"" ++ ex ++ "\" ;"
 
 -- treat = map mkRule . paradigms
 
@@ -45,8 +45,11 @@ analyse s =
     lst = drop 6 $ dropWhile (/='t') end
     (num,gr) = span isDigit lst
     para = (replicate (2 - length num) '0' ++ num) ++ ['A' | isPrefixOf "av" (drop 6 gr)]
-  in  
-  (para,word)
+  in case num of
+    "" -> Nothing
+    "0" -> Nothing
+    _ | length num > 2 -> Nothing
+    _ -> if last word == 't' then Nothing else Just (para,word)
 
 sub cs s = isPrefixOf cs s || isPrefixOf cs (drop 1 s)
 

src/GF/GFCC/Linearize.hs

@@ -28,14 +28,14 @@ realize trm = case trm of
 
 linExp :: GFCC -> CId -> Exp -> Term
 linExp mcfg lang tree@(DTr xs at trees) =
-  case at of
-    AC fun -> addB $ comp (lmap lin trees) $ look fun
+  addB $ case at of
+    AC fun -> comp (lmap lin trees) $ look fun
     AS s   -> R [kks (show s)] -- quoted
     AI i   -> R [kks (show i)] 
                 --- [C lst, kks (show i), C size] where 
                 --- lst = mod (fromInteger i) 10 ; size = if i < 10 then 0 else 1
     AF d   -> R [kks (show d)]
-    AV x   -> addB $ TM (prCId x)
+    AV x   -> TM (prCId x)
     AM i   -> TM (show i)
  where
    lin  = linExp mcfg lang
@@ -45,6 +45,7 @@ linExp mcfg lang tree@(DTr xs at trees) =
      | Data.List.null xs = t
      | otherwise = case t of
          R ts -> R $ ts ++ (Data.List.map (kks . prCId) xs)
+         TM s -> R $ t : (Data.List.map (kks . prCId) xs)
 
 compute :: GFCC -> CId -> [Term] -> Term -> Term
 compute mcfg lang args = comp where