ruleGenerator.ml 19.3 KB
open Xstd
open Printf
open Types

(* let alternation_map = Rules.alternation_map *)

let rule_types = Xlist.fold [
(*  Xlist.map (StringMap.find alternation_map "obce_ch") (fun (_,s,t) -> sprintf "%sch\t%s" s t), "{x}ych\t{x}";
  Xlist.map (StringMap.find alternation_map "obce_ch") (fun (_,s,t) -> sprintf "%smi\t%s" s t), "{x}ymi\t{x}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_iy") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{'}y\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_iy") (fun (_,s,t) -> sprintf "%sch\t%s" s t), "{'}ych\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_iy") (fun (_,s,t) -> sprintf "%sm\t%s" s t), "{'}ym\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_iy") (fun (_,s,t) -> sprintf "%smi\t%s" s t), "{'}ymi\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%se\t%s" s t), "{'}e\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sego\t%s" s t), "{'}ego\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sej\t%s" s t), "{'}ej\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%semu\t%s" s t), "{'}emu\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sa\t%s" s t), "{'}a\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%są\t%s" s t), "{'}ą\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%so\t%s" s t), "{'}o\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sę\t%s" s t), "{'}ę\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%su\t%s" s t), "{'}u\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sów\t%s" s t), "{'}ów\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%som\t%s" s t), "{'}om\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sami\t%s" s t), "{'}ami\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sach\t%s" s t), "{'}ach\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sowi\t%s" s t), "{'}owi\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sowie\t%s" s t), "{'}owie\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sum\t%s" s t), "{'}um\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ae") (fun (_,s,t) -> sprintf "%sem\t%s" s t), "{'}em\t{'}";
(*  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_ii") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{'}ii\t{'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_yj") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{'}yj\t{'}";*)
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_wyglos") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{'}ε\t{'}";
(*   Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{v'}y\t{v'}"; *)
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sch\t%s" s t), "{v'}ych\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sm\t%s" s t), "{v'}ym\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%smi\t%s" s t), "{v'}ymi\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%se\t%s" s t), "{v'}e\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sego\t%s" s t), "{v'}ego\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sej\t%s" s t), "{v'}ej\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%semu\t%s" s t), "{v'}emu\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sa\t%s" s t), "{v'}a\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%są\t%s" s t), "{v'}ą\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%so\t%s" s t), "{v'}o\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sę\t%s" s t), "{v'}ę\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%su\t%s" s t), "{v'}u\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sów\t%s" s t), "{v'}ów\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%som\t%s" s t), "{v'}om\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sami\t%s" s t), "{v'}ami\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sach\t%s" s t), "{v'}ach\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sowi\t%s" s t), "{v'}owi\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sowie\t%s" s t), "{v'}owie\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sum\t%s" s t), "{v'}um\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe") (fun (_,s,t) -> sprintf "%sem\t%s" s t), "{v'}em\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_miekkie_nowe_wyglos") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{v'}ε\t{v'}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_y") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{}y\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_y") (fun (_,s,t) -> sprintf "%sch\t%s" s t), "{}ych\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_y") (fun (_,s,t) -> sprintf "%sm\t%s" s t), "{}ym\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_y") (fun (_,s,t) -> sprintf "%smi\t%s" s t), "{}ymi\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_e") (fun (_,s,t) -> sprintf "%se\t%s" s t), "{}e\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_e") (fun (_,s,t) -> sprintf "%sego\t%s" s t), "{}ego\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_e") (fun (_,s,t) -> sprintf "%sej\t%s" s t), "{}ej\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_e") (fun (_,s,t) -> sprintf "%semu\t%s" s t), "{}emu\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sa\t%s" s t), "{}a\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%są\t%s" s t), "{}ą\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%so\t%s" s t), "{}o\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sę\t%s" s t), "{}ę\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%su\t%s" s t), "{}u\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sów\t%s" s t), "{}ów\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%som\t%s" s t), "{}om\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sami\t%s" s t), "{}ami\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sach\t%s" s t), "{}ach\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sowi\t%s" s t), "{}owi\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sowie\t%s" s t), "{}owie\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_a") (fun (_,s,t) -> sprintf "%sum\t%s" s t), "{}um\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_e") (fun (_,s,t) -> sprintf "%sem\t%s" s t), "{}em\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_i") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{}'i\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_ie") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{}'ie\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_wyglos") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{}ε\t{}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe_y") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{v}y\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe_y") (fun (_,s,t) -> sprintf "%sch\t%s" s t), "{v}ych\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe_y") (fun (_,s,t) -> sprintf "%sm\t%s" s t), "{v}ym\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe_y") (fun (_,s,t) -> sprintf "%smi\t%s" s t), "{v}ymi\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%se\t%s" s t), "{v}e\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sego\t%s" s t), "{v}ego\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sej\t%s" s t), "{v}ej\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%semu\t%s" s t), "{v}emu\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sa\t%s" s t), "{v}a\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%są\t%s" s t), "{v}ą\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%so\t%s" s t), "{v}o\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sę\t%s" s t), "{v}ę\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%su\t%s" s t), "{v}u\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sów\t%s" s t), "{v}ów\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%som\t%s" s t), "{v}om\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sami\t%s" s t), "{v}ami\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sach\t%s" s t), "{v}ach\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sowi\t%s" s t), "{v}owi\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sowie\t%s" s t), "{v}owie\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe") (fun (_,s,t) -> sprintf "%sum\t%s" s t), "{v}um\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe_ie") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{v}'ie\t{v}";
  Xlist.map (StringMap.find alternation_map "funkcjonalnie_twarde_nowe_wyglos") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{v}ε\t{v}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_y") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{-}y\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_y") (fun (_,s,t) -> sprintf "%sch\t%s" s t), "{-}ych\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_y") (fun (_,s,t) -> sprintf "%sm\t%s" s t), "{-}ym\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_y") (fun (_,s,t) -> sprintf "%smi\t%s" s t), "{-}ymi\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%se\t%s" s t), "{-}e\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sego\t%s" s t), "{-}ego\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sej\t%s" s t), "{-}ej\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%semu\t%s" s t), "{-}emu\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sa\t%s" s t), "{-}a\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%są\t%s" s t), "{-}ą\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%so\t%s" s t), "{-}o\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sę\t%s" s t), "{-}ę\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%su\t%s" s t), "{-}u\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sów\t%s" s t), "{-}ów\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%som\t%s" s t), "{-}om\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sem\t%s" s t), "{-}em\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sami\t%s" s t), "{-}ami\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sach\t%s" s t), "{-}ach\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sowi\t%s" s t), "{-}owi\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sowie\t%s" s t), "{-}owie\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_a") (fun (_,s,t) -> sprintf "%sum\t%s" s t), "{-}um\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_ie") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{-}'ie\t{-}";
  Xlist.map (StringMap.find alternation_map "kapitaliki_wyglos") (fun (_,s,t) -> sprintf "%s\t%s" s t), "{-}ε\t{-}";*)
  ] StringMap.empty (fun map (l,code) ->
      Xlist.fold l map (fun map rule -> StringMap.add_inc map rule code (fun code2 ->
        print_endline ("rule_types: " ^ rule ^ " " ^ code ^ " " ^ code2); code2)))

let rec cut_prefix_list c ll =
  Xlist.map ll (function
    [] -> raise Not_found
  | x :: l -> if x = c then l else raise Not_found)

let rec find_common_prefix_length_rec n = function
    [] :: _ -> n
  | (c :: l) :: ll ->
      (try
        let ll = cut_prefix_list c ll in
        find_common_prefix_length_rec (n + String.length c) (l :: ll)
      with Not_found -> n)
 | [] -> failwith "find_common_prefix_length_rec"

let find_common_prefix_length l =
  let ll = Xlist.map l Xunicode.utf8_chars_of_utf8_string(*Stem.text_to_chars*) in
  find_common_prefix_length_rec 0 ll

let cut_prefixn i s =
  let n = String.length s in
  if i >= n then "" else
  try String.sub s i (n-i) with _ -> failwith ("cut_prefixn: " ^ s ^ " " ^ string_of_int i)

let rule_code (a,b) =
  let s = sprintf "%s\t%s" a b in
  try StringMap.find rule_types s, true with Not_found ->
  if Xstring.check_prefix b a then
    let suf = Xstring.cut_prefix b a in
    suf ^ "_" ^ (String.concat "_" (List.rev (Xunicode.utf8_chars_of_utf8_string(*Stem.text_to_chars*) b))), false
  else "???", false

let generate_rule stem stem_pref orth =
  let n = find_common_prefix_length [stem_pref;orth] in
  let a = cut_prefixn n orth in
  let b = cut_prefixn n stem in
  let c,f = rule_code (a,b) in
  if f then "\t" ^ c else sprintf "%s\t%s\t%s" c a b

let rec classify_entry entry = function
    (class_interp,suf,cl) :: class_sel ->
       let l = Xlist.fold entry.forms [] (fun l form ->
         if form.interp = class_interp then form.orth :: l else l) in
       let b = Xlist.fold l false (fun b orth ->
         if Xstring.check_sufix suf orth then true else b) in
       if b then cl else classify_entry entry class_sel
(*       let l = StringSet.to_list (Xlist.fold l StringSet.empty (fun set orth ->
         if check_prefix stem orth then
           StringSet.add set (cut_prefix stem orth)
         else set)) in
       if Xlist.mem l suf then cl else classify_noun lemma stem interps class_sel
       let l = StringSet.to_list (Xlist.fold l StringSet.empty (fun set orth ->
         if check_prefix stem orth then
           StringSet.add set (cut_prefix stem orth)
         else set)) in
       if Xlist.mem l suf then cl else classify_noun lemma stem interps class_sel*)
(*       (match l with
         [] -> classify_noun lemma stem interps class_sel
       | [s] -> if s = suf then cl else classify_noun lemma stem interps class_sel
       | _ -> print_endline ("classify_noun multiple class: " ^ lemma ^ " " ^ String.concat " " l);
              classify_noun lemma stem interps class_sel)*)
  | [] -> (*print_endline ("classify_noun unknown class: " ^ lemma);*) "X"

let entry_classes =
  List.flatten (Xlist.map ["m1";"m2";"m3";"n1";"n2";"f";"p1";"p2";"p3"] (fun gender ->
    Xlist.map ["ii";"ji";"yj"] (fun sufix ->
      "subst:pl:gen:" ^ gender, sufix,"II"))) @
  List.flatten (Xlist.map ["m1";"m2";"m3";"n1";"n2";"f"] (fun gender ->
    Xlist.map ["a"] (fun sufix ->
      "subst:sg:nom:" ^ gender, sufix,"A"))) @
  List.flatten (Xlist.map ["m1";"m2";"m3";"n1";"n2";"f"] (fun gender ->
    Xlist.map ["ę"] (fun sufix ->
      "subst:sg:acc:" ^ gender, sufix,"Ę"))) @
  List.flatten (Xlist.map ["m1";"m2";"m3";"n1";"n2";"f"] (fun gender ->
    Xlist.map ["ą"] (fun sufix ->
      "subst:sg:inst:" ^ gender, sufix,"Ą"))) @
(*  List.flatten (Xlist.map ["m1";"m2";"m3";"n1";"n2";"f";"p1";"p2";"p3"] (fun gender ->
    Xlist.map ["ym";"im";"m"] (fun sufix ->
      "subst:pl:dat:" ^ gender, sufix,"ADJ"))) @
  List.flatten (Xlist.map ["m1";"m2";"m3";"n1";"n2";"f"] (fun gender ->
    Xlist.map ["a","A";"o","O";"e","E"] (fun (sufix,s) ->
      "subst:sg:nom:" ^ gender, sufix,s))) @*)
[
   "subst:sg:nom:n2","um","UM";
  ]

let generate_rules_entry entry =
  let stem_pref = Stem.cut_stem_sufix entry.stem in
  let cl = classify_entry entry entry_classes in
  Xlist.map entry.forms (fun form ->
    form.interp,cl ^ "\t" ^ generate_rule entry.stem stem_pref form.orth)

let generate_interp_rules rules con_flag group_flag lemma_flag simple_lemma form =
  let candidates = Rules.CharTrees.find rules form.orth in
      (* printf "S %d\n" (Xlist.size forms); *)
  let candidates = Xlist.fold candidates [] (fun candidates (stem,rule) ->
        (* printf "R %s\t%s\n" stem (Rules.string_of_rule rule); *)
    if stem ^ rule.set = simple_lemma then rule :: candidates else candidates) in
  Xlist.rev_map candidates (fun rule ->
    let tags = rule.tags in
    let tags = if con_flag then snd (Rules.extract_tag "con" [] tags) else tags in
    let tags = if group_flag then snd (Rules.extract_tag "group" [] tags) else tags in
    let tags = if lemma_flag then snd (Rules.extract_tag "lemma" [] tags) else tags in
    let tags = Xlist.sort tags Rules.compare_tag in
    String.concat " " (Xlist.map tags (fun (k,v) -> k ^ "=" ^ v)) ^ "\t" ^ form.interp)