Wojciech Jaworski / ENIAM

(*
 *  ENIAM: Categorial Syntactic-Semantic Parser for Polish
 *  Copyright (C) 2016 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
 *  Copyright (C) 2016 Institute of Computer Science Polish Academy of Sciences
 *
 *  This program is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open WalTypes
open Xstd

let expands,compreps,comprep_reqs,subtypes,equivs = WalParser.load_realizations ()
(*let verb_frames = WalParser.load_frames (Paths.walenty_path ^ Paths.verb_filename)
let noun_frames = WalParser.load_frames (Paths.walenty_path ^ Paths.noun_filename)
let adj_frames = WalParser.load_frames (Paths.walenty_path ^ Paths.adj_filename)
let adv_frames = WalParser.load_frames (Paths.walenty_path ^ Paths.adv_filename)    *)

let walenty = (*StringMap.empty*)WalTEI.load_walenty2 ()

(*let _ = StringMap.iter walenty (fun pos map ->
  StringMap.iter map (fun lexeme frames ->
    Printf.printf "%s %s %d\n%!" pos lexeme (Xlist.size frames)))*)

(*let all_frames =
  ["subst",noun_frames;
   "adj",adj_frames;
   "adv",adv_frames;
   "ger",verb_frames;
   "pact",verb_frames;
   "ppas",verb_frames;
   "fin",verb_frames; 
   "praet",verb_frames;
   "impt",verb_frames;
   "imps",verb_frames;
   "inf",verb_frames;
   "pcon",verb_frames]*)

let rec get_role_and_sense = function
    Phrase(Lex "się") -> "Theme","", []
  | PhraseAbbr(Xp "abl",_) -> "Location","Source", []
  | PhraseAbbr(Xp "adl",_) -> "Location","Goal", []
  | PhraseAbbr(Xp "caus",_) -> "Condition","", []
  | PhraseAbbr(Xp "dest",_) -> "Purpose","", []
  | PhraseAbbr(Xp "dur",_) -> "Duration","", []
  | PhraseAbbr(Xp "instr",_) -> "Instrument","", []
  | PhraseAbbr(Xp "locat",_) -> "Location","", []
  | PhraseAbbr(Xp "mod",_) -> "Manner","", []
  | PhraseAbbr(Xp "perl",_) -> "Path","", []
  | PhraseAbbr(Xp "temp",_) -> "Time","", []
  | PhraseAbbr(Advp "abl",_) -> "Location","Source", []
  | PhraseAbbr(Advp "adl",_) -> "Location","Goal", []
  | PhraseAbbr(Advp "dur",_) -> "Duration","", []
  | PhraseAbbr(Advp "locat",_) -> "Location","", []
  | PhraseAbbr(Advp "mod",_) -> "Manner","", []
  | PhraseAbbr(Advp "perl",_) -> "Path","", []
  | PhraseAbbr(Advp "temp",_) -> "Time","", []
(*  | PhraseAbbr(Advp "pron",_) -> "Arg","", []
  | PhraseAbbr(Advp "misc",_) -> "Arg","", []*)
  | PhraseAbbr(Distrp,_) -> "Distributive","", [] (* FIXME: to jest kwantyfikator *)
  | PhraseAbbr(Possp,_) -> "Possesive","", []
  | LexPhraseMode("abl",_,_) -> "Location","Source", []
  | LexPhraseMode("adl",_,_) -> "Location","Goal", []
  | LexPhraseMode("caus",_,_) -> "Condition","", []
  | LexPhraseMode("dest",_,_) -> "Purpose","", []
  | LexPhraseMode("dur",_,_) -> "Duration","", []
  | LexPhraseMode("instr",_,_) -> "Instrument","", []
  | LexPhraseMode("locat",_,_) -> "Location","", []
  | LexPhraseMode("mod",_,_) -> "Manner","", []
  | LexPhraseMode("perl",_,_) -> "Path","", []
  | LexPhraseMode("temp",_,_) -> "Time","", []
  | _ -> "Arg","", []
   
   
(*let rec get_gf_role = function
    [],Phrase(NP case) -> "C", "", ["T"]
  | [],Phrase(AdjP case) -> "R", "", ["T"]
  | [],Phrase(NumP(case,_)) -> "C", "", ["T"]
  | [],Phrase(PrepNP _) -> "C", "", ["T"] 
  | [],Phrase(PrepAdjP _) -> "C", "", ["T"] 
  | [],Phrase(PrepNumP _) -> "C", "", ["T"] 
  | [],Phrase(ComprepNP _) -> "C", "", ["T"] 
  | [],Phrase(ComparP _) -> "C", "", ["T"]  
  | [],Phrase(CP _) -> "C", "", ["T"] 
  | [],Phrase(NCP(case,_,_)) -> "C", "", ["T"]
  | [],Phrase(PrepNCP _) -> "C", "", ["T"] 
  | [],Phrase(InfP _) -> "C", "", ["T"] 
  | [],Phrase(FixedP _) -> "C", "", ["T"]
  | [],Phrase Or -> "C", "", ["T"] (* FIXME: zbadać w walentym faktyczne użycia or, bo to nie tylko zdania, ale też np(nom) w cudzysłowach *)
  | [],Phrase(Lex "się") -> "C", "Ptnt", ["T"]
  | [],PhraseAbbr(Xp mode,_) -> "C", mode, ["T"]
  | [],PhraseAbbr(Advp "pron",_) -> "R", "", ["T"]
  | [],PhraseAbbr(Advp "misc",_) -> "R", "", ["T"]
  | [],PhraseAbbr(Advp mode,_) -> "C", mode, ["T"]
  | [],PhraseAbbr(Nonch,_) -> "C", "", ["T"]
  | [],PhraseAbbr(Distrp,_) -> "C", "Distr", ["T"]
  | [],PhraseAbbr(Possp,_) -> "C", "Poss", ["T"]
  | [],LexPhraseMode(mode,_,_) -> "C", mode, ["T"]
  | [],LexPhrase((SUBST(_,case),_) :: _,_) -> "C", "", ["T"]
  | [],LexPhrase((PREP _,_) :: _,_) -> "C", "", ["T"] 
  | [],LexPhrase((NUM(case,_,_),_) :: _,_) -> "C", "", ["T"]
  | [],LexPhrase((ADJ(_,case,_,_),_) :: _,_) -> "C", "", ["T"]
  | [],LexPhrase((ADV _,_) :: _,_) -> "C", "", ["T"] 
  | [],LexPhrase((GER(_,case,_,_,_,_),_) :: _,_) -> "C", "", ["T"]
  | [],LexPhrase((PACT(_,case,_,_,_,_),_) :: _,_) -> "C", "", ["T"]
  | [],LexPhrase((PPAS(_,case,_,_,_),_) :: _,_) -> "C", "", ["T"]
  | [],LexPhrase((INF _,_) :: _,_) -> "C", "", ["T"] 
  | [],LexPhrase((QUB,_) :: _,_) -> "C", "", ["T"] 
  | [],LexPhrase((COMPAR,_) :: _,_) -> "C", "", ["T"] 
  | [],LexPhrase((COMP _,_) :: _,_) -> "C", "", ["T"] 
  | [],morf -> print_endline(*failwith*) ("get_gf: []," ^ WalStringOf.morf morf);"","",[]
  | _,Phrase(InfP _) -> "X", "", ["T"]
  | _,Phrase(CP _) -> "X", "", ["T"]  (* zwykle możliwa koordynacja z infp *)
  | _,Phrase _ -> "X", "", ["T"] 
  | _,PhraseAbbr _ -> "X", "", ["T"] 
  | _,LexPhraseMode _ -> "X", "", ["T"] 
  | _,LexPhrase((INF _,_) :: _,_) -> "X", "", ["T"] 
  | _,LexPhrase _ -> "X", "", ["T"]
  | _,morf -> failwith ("get_gf: _," ^ WalStringOf.morf morf)*)

(*let gf_rank = Xlist.fold [
  "",1;
  ] StringMap.empty (fun gf_rank (gf,v) -> StringMap.add gf_rank gf v)*)
  
(*let agregate_gfs s gfs_roles =
(*  fst (Xlist.fold gfs ("",0) (fun (best_gf,best_rank) gf ->
    let rank = try StringMap.find gf_rank gf with Not_found -> failwith ("agregate_gfs: " ^ gf) in
    if rank > best_rank then gf, rank else best_gf, best_rank))*)
(*  let gfs,roles = List.split gfs_roles in
  let gfs = StringSet.to_list (Xlist.fold gfs StringSet.empty StringSet.add) in
  if Xlist.size gfs > 1 then print_endline ("agregate_gfs: " ^ String.concat " " gfs);
  if Xlist.size roles > 1 then print_endline ("agregate_gfs: " ^ String.concat " " roles);*)
  let gf,role,prefs = List.hd gfs_roles in
  {s with gf=gf; role=role; prefs=prefs}
  
let rec make_gfs schema = 
  let schema = Xlist.map schema (function
        {gf="subj"} as s -> {s with gf="SUBJ"; role="Agnt"; prefs=["T"]; morfs=make_gfs_morfs s.morfs}
      | {gf="obj"} as s -> {s with gf="OBJ"; role="Ptnt"; prefs=["T"]; morfs=make_gfs_morfs s.morfs}
      | {gf=""} as s -> agregate_gfs {s with morfs=make_gfs_morfs s.morfs} (Xlist.map s.morfs (fun morf -> get_gf_role (s.ce,morf)))
      | {gf=t} -> failwith ("make_gfs: " ^ t)) in
(*  let schema = List.rev (fst (Xlist.fold schema ([],StringMap.empty) (fun (schema,map) s ->
    try 
      let n = StringMap.find map s.gf in
      {s with gf=s.gf ^ string_of_int (n+1)} :: schema, 
      StringMap.add map s.gf (n+1)
    with Not_found -> 
      s :: schema, StringMap.add map s.gf 1))) in*)
  schema
  
and make_gfs_morfs morfs =
  List.flatten (Xlist.map morfs (function 
      Phrase _ as morf -> [morf]
    | PhraseAbbr(Advp _,[]) -> [Phrase AdvP]
    | PhraseAbbr(_,[]) -> failwith "make_gfs_morfs"
    | PhraseAbbr(_,morfs) -> make_gfs_morfs morfs
    | LexPhrase(pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,make_gfs schema))]
    | LexPhraseMode(_,pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,make_gfs schema))]
    | _ -> failwith "make_gfs_morfs"))*)
   
let mark_nosem_morfs morfs =
  Xlist.map morfs (function
      Phrase(PrepNP(_,prep,c)) -> Phrase(PrepNP(NoSem,prep,c))
    | Phrase(PrepAdjP(_,prep,c)) -> Phrase(PrepAdjP(NoSem,prep,c))
    | Phrase(PrepNumP(_,prep,c)) -> Phrase(PrepNumP(NoSem,prep,c))
(*     | Phrase(ComprepNP(_,prep)) -> Phrase(ComprepNP(NoSem,prep)) *) (* FIXME: na razie ComprepNP są zawsze semantyczne *)
(*    | Phrase(ComparNP(_,prep,c)) -> Phrase(ComparNP(NoSem,prep,c)) (* FIXME: pomijam niesemantyczny compar *)
    | Phrase(ComparPP(_,prep)) -> Phrase(ComparPP(NoSem,prep))*)
    | Phrase(PrepNCP(_,prep,c,ct,co)) -> Phrase(PrepNCP(NoSem,prep,c,ct,co))
    | t -> t)
    
   
let agregate_role_and_sense s l =
  let roles,senses = Xlist.fold l (StringSet.empty,StringSet.empty) (fun (roles,senses) (role,role_attr,sense) ->
    StringSet.add roles (role ^ " " ^ role_attr),
    Xlist.fold sense senses StringSet.add) in
  let roles = if StringSet.size roles = 1 then roles else StringSet.remove roles "Arg " in
  let role,role_attr = 
    match Str.split (Str.regexp " ") (StringSet.min_elt roles) with 
      [r;a] -> r,a
    | [r] -> r,""
    | _ -> failwith "agregate_role_and_sense" in
  {s with role=role; role_attr=role_attr(*; sel_prefs=StringSet.to_list senses*)}
   
let rec assign_role_and_sense schema = 
  Xlist.map schema (function
        {gf=SUBJ} as s -> 
          if s.role = "" then {s with role="Initiator"; sel_prefs=["ALL"]; morfs=assign_role_and_sense_morfs s.morfs}
          else {s with morfs=assign_role_and_sense_morfs (mark_nosem_morfs s.morfs)}
      | {gf=OBJ} as s -> 
          if s.role = "" then {s with role="Theme"; sel_prefs=["ALL"]; morfs=assign_role_and_sense_morfs s.morfs}
          else {s with morfs=assign_role_and_sense_morfs (mark_nosem_morfs s.morfs)}
      | {gf=ARG} as s -> 
           if s.role = "" then agregate_role_and_sense {s with sel_prefs=["ALL"]; morfs=assign_role_and_sense_morfs s.morfs} 
             (Xlist.map s.morfs (fun morf -> get_role_and_sense morf))  
           else {s with morfs=assign_role_and_sense_morfs (mark_nosem_morfs s.morfs)}
      | _ -> failwith "assign_role_and_sense")
             
and assign_role_and_sense_morfs morfs =
  List.flatten (Xlist.map morfs (function 
      Phrase _ as morf -> [morf]
    | E _ as morf -> [morf]
    | PhraseAbbr(Advp _,[]) -> [Phrase AdvP]
    | PhraseAbbr(_,[]) -> failwith "assign_role_and_sense_morfs"
    | PhraseAbbr(_,morfs) -> assign_role_and_sense_morfs morfs
    | LexPhrase(pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,assign_role_and_sense schema))]
    | LexPhraseMode(_,pos_lex,(restr,schema)) -> [LexPhrase(pos_lex,(restr,assign_role_and_sense schema))]
    | _ -> failwith "assign_role_and_sense_morfs"))
   
let rec assign_pro_args schema =
  Xlist.map schema (fun s ->
    let morfs = match s.morfs with
      (E p) :: l -> E Pro :: (E p) :: l
    | [LexPhrase _] as morfs -> morfs
    | [Phrase(FixedP _)] as morfs -> morfs
    | [Phrase(Lex _)] as morfs -> morfs
(*    | [Phrase Refl] as morfs -> morfs
    | [Phrase Recip] as morfs -> morfs*)
    | Phrase Null :: _ as morfs -> morfs
    | Phrase Pro :: _ as morfs -> morfs
    | morfs -> if s.gf <> SUBJ && s.cr = [] && s.ce = [] then (Phrase Null) :: morfs else (Phrase Pro) :: morfs in (* FIXME: ustalić czy są inne przypadki uzgodnienia *)
(*     let morfs = assign_pro_args_lex morfs in *) (* bez pro wewnątrz leksykalizacji *)
    {s with morfs=morfs})
      
(*let assign_pro_args_lex morfs = 
  Xlist.map morfs (function 
      Lex(morf,specs,lex,restr) -> LexN(morf,specs,lex,assign_pro_args_restr restr)
    | LexNum(morf,lex1,lex2,restr) -> LexNum(morf,lex1,lex2,assign_pro_args_restr restr)
    | LexCompar(morf,l) -> LexCompar(morf,make_gfs_lex l)
    | morf -> morf)
    
and assign_pro_args_restr = function
    Natr -> Natr
  | Ratr1 schema -> Ratr1(assign_pro_args schema)
  | Atr1 schema -> Atr1(assign_pro_args schema)
  | Ratr schema -> Ratr(assign_pro_args schema)
  | Atr schema -> Atr(assign_pro_args schema)*)
  
(*let _ =
  Xlist.iter walenty_filenames (fun filename -> 
    print_endline filename;
    let frames = load_frames (walenty_path ^ filename) in
    StringMap.iter frames (fun _ l ->
      Xlist.iter l (fun (refl,opinion,negation,pred,aspect,schema) -> 
        ignore (process_opinion opinion);
        ignore (process_negation [Text negation]);
        ignore (process_pred [Text pred]);
        ignore (process_aspect [Text aspect]);    
        ignore (assign_pro_args (make_gfs (process_schema expands subtypes equivs schema))))))*)
        
exception ImpossibleSchema      

let rec reduce_comp lexemes = function    
    Comp s -> if StringMap.mem lexemes s then Comp s else raise Not_found
  | Zeby -> if StringMap.mem lexemes "żeby" || StringMap.mem lexemes "że" then Zeby else raise Not_found
  | Gdy -> if StringMap.mem lexemes "gdy" || StringMap.mem lexemes "gdyby" then Gdy else raise Not_found
  | CompUndef -> failwith "reduce_comp"
  
let reduce_phrase lexemes = function
  | PrepNP(_,prep,case) as phrase -> if StringMap.mem lexemes prep then phrase else raise Not_found
  | PrepAdjP(_,prep,case) as phrase -> if StringMap.mem lexemes prep then phrase else raise Not_found
  | PrepNumP(_,prep,case) as phrase -> if StringMap.mem lexemes prep then phrase else raise Not_found
  | ComprepNP(_,prep) as phrase  -> if Xlist.fold (try StringMap.find comprep_reqs prep with Not_found -> []) true (fun b s -> b && StringMap.mem lexemes s) then phrase else raise Not_found
  | ComparNP(_,prep,case) as phrase  -> if StringMap.mem lexemes prep then phrase else raise Not_found
  | ComparPP(_,prep) as phrase  -> if StringMap.mem lexemes prep then phrase else raise Not_found
  | CP(ctype,comp) -> CP(ctype,reduce_comp lexemes comp)
  | NCP(case,ctype,comp) -> if StringMap.mem lexemes "to" then NCP(case,ctype,reduce_comp lexemes comp) else raise Not_found
  | PrepNCP(sem,prep,case,ctype,comp) -> if StringMap.mem lexemes prep && StringMap.mem lexemes "to" then PrepNCP(sem,prep,case,ctype,reduce_comp lexemes comp) else raise Not_found
  | phrase -> phrase
  
let rec reduce_lex lexemes = function
    Lexeme s -> if StringMap.mem lexemes s then Lexeme s else raise Not_found
  | ORconcat l -> 
      let l = List.rev (Xlist.fold l [] (fun l lex -> try reduce_lex lexemes lex :: l with Not_found -> l)) in
      (match l with
          [] -> raise Not_found
        | [x] -> x
        | l -> ORconcat l)
  | ORcoord l -> 
      let l = List.rev (Xlist.fold l [] (fun l lex -> try reduce_lex lexemes lex :: l with Not_found -> l)) in
      (match l with
          [] -> raise Not_found
        | [x] -> x
        | l -> ORcoord l)
  | XOR l -> 
      let l = List.rev (Xlist.fold l [] (fun l lex -> try reduce_lex lexemes lex :: l with Not_found -> l)) in
      (match l with
          [] -> raise Not_found
        | [x] -> x
        | l -> XOR l)
  | Elexeme gender -> Elexeme gender  

let rec reduce_restr lexemes = function   (* leksykalizacje wewnątrz leksykalizacji są w niektórych sytuacjach opcjonalne *)
    Natr,[] -> Natr,[]
  | Atr,[] -> Atr,[]
  | Ratr,[] -> Ratr,[]
  | Atr1,[] -> Atr1,[]
  | Ratr1,[] -> Ratr1,[]
  | Ratr1,schema -> let schema = reduce_schema2 lexemes schema in if schema = [] then raise Not_found else Ratr1,schema
  | Atr1,schema -> let schema = reduce_schema2 lexemes schema in if schema = [] then Natr,[] else Atr1,schema
  | Ratr,schema -> let schema = reduce_schema2 lexemes schema in if schema = [] then raise Not_found else Ratr,schema
  | Atr,schema -> let schema = reduce_schema2 lexemes schema in if schema = [] then Natr,[] else Atr,schema
  | Ratrs,schema -> Ratrs,reduce_schema lexemes schema
  | _ -> failwith "reduce_restr"

and reduce_morf lexemes = function (* leksykalizacje, które się z czymś koordynują nie są obowiązakowe *)
    Phrase phrase -> Phrase(reduce_phrase lexemes phrase)
  | E phrases -> E phrases (* FIXME: uproszczenie *)
  | LexPhrase(pos_lex,restr) -> LexPhrase(Xlist.map pos_lex (fun (pos,lex) -> pos, reduce_lex lexemes lex),reduce_restr lexemes restr)
  | morf -> failwith ("reduce_morf: " ^ WalStringOf.morf morf)
    
and reduce_morfs lexemes = function 
    [] -> []
  | morf :: l -> (try [reduce_morf lexemes morf] with Not_found -> []) @ reduce_morfs lexemes l
    
and reduce_schema2 lexemes = function
    [] -> []
  | s :: l -> 
      let morfs = reduce_morfs lexemes s.morfs in
      if morfs = [] then reduce_schema2 lexemes l else 
      {s with morfs=morfs} :: reduce_schema2 lexemes l
      
and reduce_schema lexemes = function
    [] -> []
  | s :: l -> 
      let morfs = reduce_morfs lexemes s.morfs in
      if morfs = [] then raise ImpossibleSchema else 
      {s with morfs=morfs} :: reduce_schema lexemes l
      
let reduce_schema_frame lexemes = function  
    Frame(atrs,schema) -> Frame(atrs,reduce_schema lexemes schema)
(*  | ComprepFrame(s,morfs) -> 
      let morfs = reduce_morfs lexemes morfs in
      if morfs = [] then raise ImpossibleSchema else ComprepFrame(s,morfs)*)
  | _ -> failwith "reduce_schema_frame"

let remove_trivial_args schema = 
  Xlist.fold schema [] (fun l (_,_,_,morfs) ->
    let morfs = Xlist.fold morfs [] (fun morfs -> function
        Phrase(AdjP _) -> morfs
      | Phrase(NP(Case "gen")) -> morfs
      | Phrase(NCP(Case "gen",_,_)) -> morfs
      | Phrase(PrepNP _) -> morfs
      | Phrase(FixedP _) -> morfs
      | LexPhrase([ADJ _,_],_) -> morfs
      | LexPhrase([PPAS _,_],_) -> morfs
      | LexPhrase([PACT _,_],_) -> morfs
      | LexPhrase([SUBST(_,Case "gen"),_],_) -> morfs
      | LexPhrase([PREP _,_;_],_) -> morfs
      | morf -> morf :: morfs) in
    if morfs = [] then l else morfs :: l)

(* leksykalizacje do zmiany struktury
lex([PREP(gen),'z';SUBST(sg,gen),'nazwa'],atr1[OBL{lex([QUB,'tylko'],natr[])}])
lex([PREP(loc),'na';SUBST(sg,loc),'papier'],atr1[OBL{lex([QUB,'tylko'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(gen),'z';SUBST(sg,gen),'most'],ratr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(gen),'z';SUBST(sg,gen),'most'],ratr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
lex([PREP(acc),'w';SUBST(pl,acc),'oko'],atr1[OBL-MOD{lex([ADV(pos),'prosto'],natr[])}])
*) 
 
let rec split_elexeme = function
    Lexeme s -> [],[Lexeme s]
  | XOR l -> 
       let genders,l = Xlist.fold l ([],[]) (fun (genders,lexs) lex ->
         let gender,lex = split_elexeme lex in
        gender @ genders, lex @ lexs) in
       genders,[XOR(List.rev l)]
  | ORconcat l -> 
       let genders,l = Xlist.fold l ([],[]) (fun (genders,lexs) lex ->
         let gender,lex = split_elexeme lex in
         gender @ genders, lex @ lexs) in
       genders,[ORconcat(List.rev l)]
  | ORcoord l -> 
       let genders,l = Xlist.fold l ([],[]) (fun (genders,lexs) lex ->
         let gender,lex = split_elexeme lex in
          gender @ genders, lex @ lexs) in
       genders,[ORcoord(List.rev l)]
  | Elexeme gender -> [gender],[]
 
let prep_arg_schema_field morfs = 
  {gf=CORE; role="Ref"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Forward; morfs=morfs} (* FIXME: uporządkować sensy *)
 
let prep_arg_schema_field2 morfs = 
  {gf=CORE; role="Ref"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Forward; morfs=morfs} (* FIXME: uporządkować sensy *)
 
let num_arg_schema_field morfs = 
  {gf=CORE; role="QUANT-ARG"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Forward; morfs=morfs}
 
let std_arg_schema_field dir morfs = 
  {gf=ARG; role="Arg"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=dir; morfs=morfs}
 
let simple_arg_schema_field morfs = 
  {gf=ARG; role=""; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=morfs}
 
let nosem_refl_schema_field = 
  {gf=NOSEM; role=""; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[Phrase(Lex "się")]}

  
let rec expand_lexicalizations_schema schema =
  Xlist.map schema (fun s ->
    {s with morfs=expand_lexicalizations_morfs s.morfs})
 
and expand_lexicalizations_morfs morfs = (* uproszczenie polegające na zezwoleniu na koordynację przy zwiększaniu ilości LexPhrase *)
  List.flatten (Xlist.map morfs (fun morf ->
    let morf = match morf with
        LexPhrase(pos_lex,(restr,schema)) -> LexPhrase(pos_lex,(restr,expand_lexicalizations_schema schema))
      | morf -> morf in
    match morf with
(*         LexPhrase([ADV _,_],(_,_::_)) -> print_endline (WalStringOf.morf morf); [morf] *)
(*       | LexPhrase([PREP _,_;SUBST _,_],(_,schema)) -> if remove_trivial_args schema <> [] then print_endline (WalStringOf.morf morf); [morf] *)
(*       | LexPhrase([PREP _,_;GER _,_],(_,schema)) -> if remove_trivial_args schema <> [] then print_endline (WalStringOf.morf morf); [morf] *)
(*       | LexPhrase([NUM _,_;_],(_,schema)) -> if remove_trivial_args schema <> [] then print_endline (WalStringOf.morf morf); [morf]  *)
(*       | LexPhrase([PREP _,_;NUM _,_;_],(_,schema)) -> if remove_trivial_args schema <> [] then print_endline (WalStringOf.morf morf); [morf]  *)
(*      | LexPhrase([PREP _,_;ADJ _,_],(_,_::_)) -> print_endline (WalStringOf.morf morf); [morf]
      | LexPhrase([PREP _,_;PPAS _,_],(_,_::_)) -> print_endline (WalStringOf.morf morf); [morf] 
      | LexPhrase([PREP _,_;PACT _,_],(_,_::_)) -> print_endline (WalStringOf.morf morf); [morf] *)
      | Phrase(PrepNumP(_,prep,case)) -> [LexPhrase([PREP case,Lexeme prep],(Ratrs,[prep_arg_schema_field2 [Phrase(NumP(case))]]))]
      | LexPhrase([PREP pcase,plex;SUBST(n,c),slex],(Atr1,[{morfs=[LexPhrase([QUB,_],_)]} as s])) -> 
(*            print_endline (WalStringOf.morf morf);  *)
           [LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([SUBST(n,c),slex],(Natr,[]))]]));
            LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([SUBST(n,c),slex],(Natr,[]))];{s with dir=Backward}]))]
      | LexPhrase([PREP(pcase),plex;SUBST(n,c),slex],(Atr1,[{morfs=[LexPhrase([ADV _,_],_)]} as s])) -> 
(*            print_endline (WalStringOf.morf morf);  *)
           [LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([SUBST(n,c),slex],(Natr,[]))]]));
            LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([SUBST(n,c),slex],(Natr,[]))];{s with dir=Backward}]))]
      | LexPhrase([PREP pcase,plex;SUBST(n,c),slex],(Ratr1,[{morfs=[LexPhrase([ADV _,_],_)]} as s])) -> 
(*            print_endline (WalStringOf.morf morf);  *)
           [LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([SUBST(n,c),slex],(Natr,[]))];{s with dir=Backward}]))]
      | LexPhrase([PREP pcase,plex;pos,lex],restr) -> 
           [LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([pos,lex],restr)]]))]
      | LexPhrase([PREP pcase,plex;NUM(c,g,a),nlex;pos,lex],restr) -> 
           let genders,lexs = split_elexeme lex in
           Xlist.map genders (fun gender ->
             LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([NUM(c,gender,a),nlex],(Ratrs,[num_arg_schema_field [Phrase Pro]]))]]))) @
           Xlist.map lexs (fun lex ->             
             LexPhrase([PREP pcase,plex],(Ratrs,[prep_arg_schema_field [LexPhrase([NUM(c,g,a),nlex],(Ratrs,[num_arg_schema_field [LexPhrase([pos,lex],restr)]]))]])))
      | LexPhrase([NUM(c,g,a),nlex;pos,lex],restr) -> 
           let genders,lexs = split_elexeme lex in
           Xlist.map genders (fun gender ->
             LexPhrase([NUM(c,gender,a),nlex],(Ratrs,[num_arg_schema_field [Phrase Pro]]))) @
           Xlist.map lexs (fun lex ->             
             LexPhrase([NUM(c,g,a),nlex],(Ratrs,[num_arg_schema_field [LexPhrase([pos,lex],restr)]])))
      | LexPhrase([COMP ctype,clex;pos,lex],restr) -> 
           [LexPhrase([COMP ctype,clex],(Ratrs,[std_arg_schema_field Forward [LexPhrase([pos,lex],restr)]]))]
      | LexPhrase([SUBST(n,c),slex;COMP ctype,clex;pos,lex],restr) -> 
           [LexPhrase([SUBST(n,c),slex],(Ratrs,[std_arg_schema_field Forward [LexPhrase([COMP ctype,clex],(Ratrs,[std_arg_schema_field Forward [LexPhrase([pos,lex],restr)]]))]]))] (* FIXME: poprawić po zrobieniu NCP *)
      | LexPhrase(_::_::_,_) -> failwith ("expand_lexicalizations_morfs: " ^ WalStringOf.morf morf)
(*      | LexPhrase([PREP pcase,plex;SUBST(n,c),slex],(Atr1,[gf,cr,ce,[LexPhrase([QUB,lex],arestr)]])) -> 
(*            print_endline (WalStringOf.morf morf);  *)
           [LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([SUBST(n,c),slex],(Natr,[]))]]));
            LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([SUBST(n,c),slex],(Natr,[]))];gf,cr,ce,[LexPhrase([QUB,lex],arestr)]]))]
      | LexPhrase([PREP(pcase),plex;SUBST(n,c),slex],(Atr1,[gf,cr,ce,[LexPhrase([ADV gr,lex],arestr)]])) -> 
(*            print_endline (WalStringOf.morf morf);  *)
           [LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([SUBST(n,c),slex],(Natr,[]))]]));
            LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([SUBST(n,c),slex],(Natr,[]))];gf,cr,ce,[LexPhrase([ADV gr,lex],arestr)]]))]
      | LexPhrase([PREP pcase,plex;SUBST(n,c),slex],(Ratr1,[gf,cr,ce,[LexPhrase([ADV gr,lex],arestr)]])) -> 
(*            print_endline (WalStringOf.morf morf);  *)
           [LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([SUBST(n,c),slex],(Natr,[]))];gf,cr,ce,[LexPhrase([ADV gr,lex],arestr)]]))]
      | LexPhrase([PREP pcase,plex;pos,lex],restr) -> 
           [LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([pos,lex],restr)]]))]
      | LexPhrase([PREP pcase,plex;NUM(c,g,a),nlex;pos,lex],restr) -> 
           let genders,lexs = split_elexeme lex in
           Xlist.map genders (fun gender ->
             LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([NUM(c,gender,a),nlex],(Ratrs,[("OBJ","QUANT-ARG",["T"]),[],[],[Phrase Pro]]))]]))) @
           Xlist.map lexs (fun lex ->             
             LexPhrase([PREP pcase,plex],(Ratrs,[("OBJ","Ref",["T"]),[],[],[LexPhrase([NUM(c,g,a),nlex],(Ratrs,[("OBJ","QUANT-ARG",["T"]),[],[],[LexPhrase([pos,lex],restr)]]))]])))
      | LexPhrase([NUM(c,g,a),nlex;pos,lex],restr) -> 
           let genders,lexs = split_elexeme lex in
           Xlist.map genders (fun gender ->
             LexPhrase([NUM(c,gender,a),nlex],(Ratrs,[("OBJ","QUANT-ARG",["T"]),[],[],[Phrase Pro]]))) @
           Xlist.map lexs (fun lex ->             
             LexPhrase([NUM(c,g,a),nlex],(Ratrs,[("OBJ","QUANT-ARG",["T"]),[],[],[LexPhrase([pos,lex],restr)]])))
      | LexPhrase([COMP ctype,clex;pos,lex],restr) -> 
           [LexPhrase([COMP ctype,clex],(Ratrs,[("C","",["T"]),[],[],[LexPhrase([pos,lex],restr)]]))]
      | LexPhrase([SUBST(n,c),slex;COMP ctype,clex;pos,lex],restr) -> 
           [LexPhrase([SUBST(n,c),slex],(Ratrs,[("OBJ","",["T"]),[],[],[LexPhrase([COMP ctype,clex],(Ratrs,[("C","",["T"]),[],[],[LexPhrase([pos,lex],restr)]]))]]))]
      | LexPhrase(_::_::_,_) -> failwith ("expand_lexicalizations_morfs: " ^ WalStringOf.morf morf)*)
      | morf -> [morf]))
  
let expand_lexicalizations = function  
    Frame(atrs,schema) -> Frame(atrs,expand_lexicalizations_schema schema)
(*     ComprepFrame(s,morfs) -> ComprepFrame(atrs,expand_lexicalizations_morfs morfs) *)
  | _ -> failwith "expand_lexicalizations"

let lex_id_counter = ref 0

let get_lex_id () =
  incr lex_id_counter;
  string_of_int (!lex_id_counter)  
  
let get_pos lex = function  
    SUBST _ -> 
      (match lex with
        "ja" -> ["ppron12"]
      | "my" -> ["ppron12"]
      | "ty" -> ["ppron12"]
      | "wy" -> ["ppron12"]
      | "on" -> ["ppron3"]
      | "siebie" -> ["siebie"]
      | "się" -> ["qub"]
      | _ -> ["subst"])
  | PREP _ -> ["prep"]
  | NUM _ -> ["num"]
  | ADV _ -> ["adv"]
  | ADJ _ -> ["adj"]
  | GER _ -> ["ger"]
  | PPAS _ -> ["ppas"]
  | PACT _ -> ["pact"]
  | PERS _ -> ["fin";"praet";"winien"(*;"impt";"imps"*);"pred"]
  | INF _ -> ["inf"]
  | QUB -> ["qub"]
  | COMPAR -> ["compar"]
  | COMP _ -> ["comp"]
  
let rec extract_lex_frames lexeme p frames = function
    Frame(atrs,schema) ->
      let schema,frames = Xlist.fold schema ([],frames) (fun (schema,frames) s ->
        let morfs,frames = Xlist.fold s.morfs ([],frames) extract_lex_morf in
        {s with morfs=List.rev morfs} :: schema, frames) in
      (lexeme,p,Frame(atrs,List.rev schema)) :: frames
  | LexFrame(id,pos,restr,schema) -> 
      let schema,frames = Xlist.fold schema ([],frames) (fun (schema,frames) s ->
        let morfs,frames = Xlist.fold s.morfs ([],frames) extract_lex_morf in
        {s with morfs=List.rev morfs} :: schema, frames) in
      (lexeme,p,LexFrame(id,pos,restr,List.rev schema)) :: frames
  | ComprepFrame(s,pos,restr,schema) -> 
      let schema,frames = Xlist.fold schema ([],frames) (fun (schema,frames) s ->
        let morfs,frames = Xlist.fold s.morfs ([],frames) extract_lex_morf in
        {s with morfs=List.rev morfs} :: schema, frames) in
      (lexeme,p,ComprepFrame(s,pos,restr,List.rev schema)) :: frames
(*   | _ -> failwith "extract_lex_frames" *)

and extract_lex_morf (morfs,frames) = function 
    LexPhrase([pos,lex],(restr,schema)) ->
      let id = get_lex_id () in
      let lexemes = WalParser.get_lexemes lex in
      let frames = Xlist.fold lexemes frames (fun frames lexeme ->
        let poss = get_pos lexeme pos in
        Xlist.fold poss frames (fun frames p ->
          extract_lex_frames lexeme p frames (LexFrame(id,pos,restr,schema)))) in
      LexPhraseId(id,pos,lex) :: morfs, frames
  | LexPhrase _ -> failwith "extract_lex_morf"
  | morf -> morf :: morfs, frames
      
let split_xor schema = 
  Xlist.multiply_list (Xlist.map schema (fun s ->
    Xlist.map (Xlist.multiply_list (Xlist.map s.morfs (function
      LexPhraseId(id,pos,XOR l) -> Xlist.map l (fun lex -> LexPhraseId(id,pos,lex))
    | LexPhraseId(id,pos,lex) -> [LexPhraseId(id,pos,lex)]
    | morf -> [morf]))) (fun morfs -> {s with morfs=morfs})))
      
let split_or_coord schema = 
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
      LexPhraseId(id,pos,ORcoord l) -> Xlist.map l (fun lex -> LexPhraseId(id,pos,lex)) 
    | LexPhraseId(id,pos,ORconcat l) -> Xlist.map l (fun lex -> LexPhraseId(id,pos,lex)) (* FIXME: koordynacja zamiast konkatenacji *)
    | LexPhraseId(id,pos,lex) -> [LexPhraseId(id,pos,lex)]
    | morf -> [morf]))})
      
let simplify_lex schemas =
  Xlist.map schemas (fun schema ->
    Xlist.map schema (fun s ->
      {s with morfs=Xlist.map s.morfs (function
        LexPhraseId(id,pos,Lexeme lex) -> LexArg(id,pos,lex)
      | LexPhraseId _ as morf -> failwith ("simplify_lex: " ^ WalStringOf.morf morf)
      | morf -> morf)}))        

let prepare_schema_comprep expands subtypes equivs schema = 
  assign_pro_args (assign_role_and_sense (WalParser.expand_equivs_schema equivs (WalParser.expand_subtypes subtypes (WalParser.expand_schema expands schema))))

let prepare_schema expands subtypes equivs schema = 
  prepare_schema_comprep expands subtypes equivs (WalParser.parse_schema schema)

let prepare_schema_sem expands subtypes equivs schema = 
  prepare_schema_comprep expands subtypes equivs schema

let default_frames = Xlist.fold [ (* FIXME: poprawić domyślne ramki po ustaleniu adjunctów *)
  "verb",(ReflEmpty,Domyslny,NegationUndef,PredNA,AspectUndef,"subj{np(str)}+obj{np(str)}"); (* FIXME: dodać ramkę z refl *)
  "noun",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{possp}+{adjp(agr)}");
  "adj",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"");
  "adv",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"");
  "empty",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"");
  "date",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{null;lex(np(gen),sg,'rok',natr)}");
  "date2",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{null;lex(np(gen),sg,'rok',atr1({adjp(agr)}))}"); (* FIXME: wskazać możliwe podrzędniki *)
  "day",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,""
    (*"{lex(np(gen),sg,XOR('styczeń','luty','marzec','kwiecień','maj','czerwiec','lipiec','sierpień','wrzesień','październik','litopad','grudzień'),atr1({np(gen)}))}"*)); (* FIXME: wskazać możliwe podrzędniki *)
  "hour",(ReflEmpty,Domyslny,NegationNA,PredNA,AspectNA,"{null;lex(advp(temp),pos,'rano',natr)}");
  ] StringMap.empty (fun map (k,(refl,opinion,negation,pred,aspect,schema)) -> 
    StringMap.add map k (Frame(DefaultAtrs([],refl,opinion,negation,pred,aspect),prepare_schema expands subtypes equivs schema)))
    
let adjunct_schema_field role dir morfs = 
  {gf=ADJUNCT; role=role; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=dir; morfs=morfs}    

let verb_prep_adjunct_schema_field lemma case = 
  {gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[
    Phrase Null;
    Phrase(PrepNP(Sem,lemma,Case case));
    Phrase(PrepAdjP(Sem,lemma,Case case));
    Phrase(PrepNumP(Sem,lemma,Case case))]}    

let verb_comprep_adjunct_schema_field lemma = 
  {gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[
    Phrase Null;
    Phrase(ComprepNP(Sem,lemma))]}    

let verb_compar_adjunct_schema_field lemma = 
  {gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=[
    Phrase Null;
    Phrase(ComparPP(Sem,lemma))] @
    Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> Phrase(ComparNP(Sem,lemma,Case case)))}    

let noun_prep_adjunct_schema_field preps compreps = 
  {gf=ADJUNCT; role="Attribute"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=
    let l = Xlist.fold preps [Phrase Null] (fun l (lemma,case) -> 
      [Phrase(PrepNP(Sem,lemma,Case case));
       Phrase(PrepAdjP(Sem,lemma,Case case));
       Phrase(PrepNumP(Sem,lemma,Case case))] @ l) in
    Xlist.fold compreps l (fun l lemma -> 
      Phrase(ComprepNP(Sem,lemma)) :: l)}    
    
let noun_compar_adjunct_schema_field compars = 
  {gf=ADJUNCT; role="Attribute"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=
    Xlist.fold compars [Phrase Null] (fun l lemma -> 
      [Phrase(ComparPP(Sem,lemma))] @ Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> Phrase(ComparNP(Sem,lemma,Case case))) @ l)}   
    
let adj_compar_adjunct_schema_field compars = 
  {gf=ADJUNCT; role="Manner"; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=Both; morfs=
    Xlist.fold compars [Phrase Null] (fun l lemma -> 
      [Phrase(ComparPP(Sem,lemma))] @ Xlist.map ["nom"] (fun case -> Phrase(ComparNP(Sem,lemma,Case case))) @ l)}   
    
(*let nogf_schema_field dir morfs = 
  {gf=NOGF; role=""; role_attr=""; sel_prefs=[]; cr=[]; ce=[]; dir=dir; morfs=morfs}    *)

let schema_field gf role dir morfs = 
  {gf=gf; role=role; role_attr=""; sel_prefs=["ALL"]; cr=[]; ce=[]; dir=dir; morfs=morfs}    

(*let verb_adjuncts = [
  adjunct_schema_field "R" "" Both [Phrase AdvP];
  adjunct_schema_field "R" "" Both [Phrase PrepP]; (* FIXME: Trzeba będzie uzgodnić PrepNP, PrepAdjP, PrepNumP z PrepP i XP *)
  ]

let noun_adjuncts = [
  adjunct_schema_field "C" "poss" Both [Phrase(NP(Case "gen"))];
  adjunct_schema_field "C" "=" Both [Phrase(NP(Case "nom"))];
  adjunct_schema_field "C" "=" Both [Phrase(NP(CaseAgr))];
  adjunct_schema_field "R" "" Backward [Multi[AdjP AllAgr]];
  adjunct_schema_field "R" "" Forward [Multi[AdjP AllAgr]];
  adjunct_schema_field "R" "" Both [Phrase PrepP];
  ]
  
let adj_adjuncts = [
  adjunct_schema_field "R" "" Both [Phrase PrepP];
  ]*)
  
let verb_adjuncts = [
(*  adjunct_schema_field "" Both [Phrase Null;Phrase AdvP];
  adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; (* FIXME: Trzeba będzie uzgodnić PrepNP, PrepAdjP, PrepNumP z PrepP i XP *)
  adjunct_schema_field "Topic" Forward [Phrase Null;Phrase (CP(CompTypeUndef,CompUndef))]; (* poprawić semantykę *) (* FIXME: to powinno być jako ostatnia lista argumentów *)*)
  ]

(* FIXME: pozycje dublują się z domyślną ramką "noun" *)  
let noun_adjuncts = [ (* FIXME: usuniecie noun_adjuncts pozostawia poss dla 'Witoldzie' *)
(*  adjunct_schema_field "poss" Both [Phrase Null;Phrase(NP(Case "gen"))];
  adjunct_schema_field "=" Both [Phrase Null;Phrase(NP(Case "nom"))];
  adjunct_schema_field "=" Both [Phrase Null;Phrase(NP(CaseAgr))];
  adjunct_schema_field "" Backward [(*Phrase Null;Phrase(AdjP AllAgr)*)Multi[AdjP AllAgr]]; (* FIXME: za pomocą Multi można zrobić konkatenowane leksykalizacje *)
  adjunct_schema_field "" Forward [Phrase Null;Phrase(AdjP AllAgr)];
  adjunct_schema_field "" Both [Phrase Null;Phrase PrepP];*)
  ]
  
let adj_adjuncts = [
(*   adjunct_schema_field "" Both [Phrase Null;Phrase AdvP];  *)
  ]
  
  
let verb_adjuncts_simp = [
  adjunct_schema_field "Manner" Both [Phrase Null;Phrase AdvP];
  adjunct_schema_field "Recipent" Both [Phrase Null;Phrase (NP(Case "dat"));Phrase (NumP(Case "dat"));Phrase (NCP(Case "dat",CompTypeUndef,CompUndef))];
  adjunct_schema_field "Instrument" Both [Phrase Null;Phrase (NP(Case "inst"));Phrase (NumP(Case "inst"));Phrase (NCP(Case "inst",CompTypeUndef,CompUndef))];
  adjunct_schema_field "Time" Both [Phrase Null;Phrase (Lex "date");Phrase (Lex "day-lex");Phrase (Lex "day-month");Phrase (Lex "day")]; 
(*   adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; (* FIXME: Trzeba będzie uzgodnić PrepNP, PrepAdjP, PrepNumP z PrepP i XP *) *)
  adjunct_schema_field "Condition" Forward [Phrase Null;Phrase (CP(CompTypeUndef,CompUndef))]; (* poprawić semantykę *) (* FIXME: to powinno być jako ostatnia lista argumentów *)
  adjunct_schema_field "Theme" Both [Phrase Null;Phrase Or];
  ]
  
let noun_adjuncts_simp = [ (* FIXME: usuniecie noun_adjuncts pozostawia poss dla 'Witoldzie' *)
  adjunct_schema_field "Possesive" Both [Phrase Null;Phrase(NP(Case "gen"));Phrase(NumP(Case "gen"))];
  adjunct_schema_field "Aposition" Forward [Phrase Null;Phrase(NP(Case "nom"));Phrase(NumP(Case "nom"));Phrase Null;Phrase(NP(CaseAgr));Phrase(NumP(CaseAgr))];
  adjunct_schema_field "Attribute" Backward [(*Phrase Null;Phrase(AdjP AllAgr)*)Multi[AdjP AllAgr]]; (* FIXME: za pomocą Multi można zrobić konkatenowane leksykalizacje *)
  adjunct_schema_field "Base" Forward [Phrase Null;Phrase(AdjP AllAgr)];
(*   adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; *)
  ]
  
let noun_measure_adjuncts_simp = [ (* FIXME: usuniecie noun_adjuncts pozostawia poss dla 'Witoldzie' *)
  adjunct_schema_field "Attribute" Backward [(*Phrase Null;Phrase(AdjP AllAgr)*)Multi[AdjP AllAgr]]; (* FIXME: za pomocą Multi można zrobić konkatenowane leksykalizacje *)
  adjunct_schema_field "Base" Forward [Phrase Null;Phrase(AdjP AllAgr)];
(*   adjunct_schema_field "" Both [Phrase Null;Phrase PrepP]; *)
  ]
  
let adj_adjuncts_simp = [
  adjunct_schema_field "Manner" Both [Phrase Null;Phrase AdvP]; 
  ]
  
let adv_adjuncts_simp = [
  adjunct_schema_field "Manner" Both [Phrase Null;Phrase AdvP]; 
  ]
  
let convert_frame expands subtypes equivs lexemes valence lexeme pos (refl,opinion,negation,pred,aspect,schema) =
(*   Printf.printf "convert_frame %s %s\n" lexeme pos; *)
  try
    if refl = "się" && not (StringMap.mem lexemes "się") then raise ImpossibleSchema else  
    let frame = 
      try StringMap.find default_frames refl (* w refl jest przekazywana informacja o typie domyślnej ramki *)
      with Not_found -> 
        Frame(DefaultAtrs([],WalParser.parse_refl [Text refl],
          WalParser.parse_opinion opinion,
          WalParser.parse_negation [Text negation],
          WalParser.parse_pred [Text pred],
          WalParser.parse_aspect [Text aspect]),  
          prepare_schema expands subtypes equivs schema) in
    let frame = if StringMap.is_empty lexemes then frame else reduce_schema_frame lexemes frame in
    let frame = expand_lexicalizations frame in
    Xlist.fold (extract_lex_frames lexeme pos [] frame) valence (fun valence -> function
        lexeme,pos,Frame(atrs,schema) ->
           let schemas = simplify_lex (split_xor (split_or_coord schema)) in
           Xlist.fold schemas valence (fun valence schema ->
             let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
             let poss = StringMap.add_inc poss pos [Frame(atrs,schema)] (fun l -> Frame(atrs,schema) :: l) in
             StringMap.add valence lexeme poss)
      | lexeme,pos,LexFrame(id,pos2,restr,schema) ->
           let schemas = simplify_lex (split_xor (split_or_coord schema)) in
           Xlist.fold schemas valence (fun valence schema ->
             let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
             let poss = StringMap.add_inc poss pos [LexFrame(id,pos2,restr,schema)] (fun l -> LexFrame(id,pos2,restr,schema) :: l) in
             StringMap.add valence lexeme poss)
      | _ -> failwith "convert_frame")
  with ImpossibleSchema -> valence

let convert_frame_sem expands subtypes equivs lexemes valence lexeme pos = function
  Frame(DefaultAtrs(meanings,refl,opinion,negation,pred,aspect),positions) ->
(*   Printf.printf "convert_frame_sem %s\n" (WalStringOf.frame lexeme (Frame(DefaultAtrs(meanings,refl,opinion,negation,pred,aspect),positions))); *)
  (try
    if refl = ReflSie && not (StringMap.mem lexemes "się") then raise ImpossibleSchema else  
    let frame = 
        Frame(DefaultAtrs(meanings,refl,opinion,negation,pred,aspect),  
          prepare_schema_sem expands subtypes equivs positions) in
    let frame = if StringMap.is_empty lexemes then frame else reduce_schema_frame lexemes frame in
    let frame = expand_lexicalizations frame in
    Xlist.fold (extract_lex_frames lexeme pos [] frame) valence (fun valence -> function
        lexeme,pos,Frame(atrs,schema) ->
           let schemas = simplify_lex (split_xor (split_or_coord schema)) in
           Xlist.fold schemas valence (fun valence schema ->
             let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
             let poss = StringMap.add_inc poss pos [Frame(atrs,schema)] (fun l -> Frame(atrs,schema) :: l) in
             StringMap.add valence lexeme poss)
      | lexeme,pos,LexFrame(id,pos2,restr,schema) ->
           let schemas = simplify_lex (split_xor (split_or_coord schema)) in
           Xlist.fold schemas valence (fun valence schema ->
             let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
             let poss = StringMap.add_inc poss pos [LexFrame(id,pos2,restr,schema)] (fun l -> LexFrame(id,pos2,restr,schema) :: l) in
             StringMap.add valence lexeme poss)
      | _ -> failwith "convert_frame_sem")
  with ImpossibleSchema -> valence)
  | _ -> failwith "convert_frame_sem"

let make_comprep_frames_of_schema s = function
    [{cr=[];ce=[]; morfs=[LexPhrase([pos,Lexeme lex],(restr,schema))]}] -> 
      lex,
      (match get_pos lex pos with [pos] -> pos | _ -> failwith "make_comprep_frame_of_schema 2"),
      ComprepFrame(s,pos,restr,schema)
  | schema -> failwith ("make_comprep_frame_of_schema: " ^ WalStringOf.schema schema)
    
let convert_comprep_frame expands subtypes equivs lexemes valence lexeme pos (s,morf) =
  try
    let schema = prepare_schema_comprep expands subtypes equivs [simple_arg_schema_field [morf]] in
    let schema = if StringMap.is_empty lexemes then schema else reduce_schema lexemes schema in
    let schema = expand_lexicalizations_schema schema in        
    let lexeme,pos,frame = make_comprep_frames_of_schema s schema in
    Xlist.fold (extract_lex_frames lexeme pos [] frame) valence (fun valence -> function
        lexeme,pos,ComprepFrame(s,pos2,restr,schema) ->
           let schemas = simplify_lex (split_xor (split_or_coord schema)) in
           Xlist.fold schemas valence (fun valence schema ->
             let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
             let poss = StringMap.add_inc poss pos [ComprepFrame(s,pos2,restr,schema)] (fun l -> ComprepFrame(s,pos2,restr,schema) :: l) in
             StringMap.add valence lexeme poss)
      | lexeme,pos,LexFrame(id,pos2,restr,schema) ->
           let schemas = simplify_lex (split_xor (split_or_coord schema)) in
           Xlist.fold schemas valence (fun valence schema ->
             let poss = try StringMap.find valence lexeme with Not_found -> StringMap.empty in
             let poss = StringMap.add_inc poss pos [LexFrame(id,pos2,restr,schema)] (fun l -> LexFrame(id,pos2,restr,schema) :: l) in
             StringMap.add valence lexeme poss)
      | _ -> failwith "convert_comprep_frame")
  with ImpossibleSchema -> valence
  
let remove_pro_args schema = (* FIXME: sprawdzić czy Pro i Null są zawsze na początku *)
  List.rev (Xlist.fold schema [] (fun schema -> function 
      {morfs=[Phrase Pro]} -> schema
    | {morfs=(Phrase Pro) :: morfs} as s -> {s with morfs=morfs} :: schema
    | {morfs=[Phrase Null]} -> schema
    | {morfs=(Phrase Null) :: morfs} as s -> {s with morfs=morfs} :: schema
    | s -> s :: schema))
      
let rec expand_restr valence lexeme pos = function
    LexFrame(id,pos2,Natr,[]) -> [LexFrame(id,pos2,NoRestr,[])]
  | LexFrame(id,pos2,Natr,_) -> failwith "expand_restr"
  | LexFrame(id,pos2,restr,[]) -> 
(*       print_endline "expand_restr"; *)
      let frames = try StringMap.find (StringMap.find valence lexeme) pos with Not_found -> failwith ("expand_restr:" ^ lexeme ^ " " ^ pos) in
(*      Printf.printf "%s %s %d\n" lexeme pos (Xlist.size frames);
      Xlist.iter frames (fun frame -> print_endline (WalStringOf.frame lexeme frame));
      print_endline "";*)
      (if restr = Atr || restr = Atr1 then [LexFrame(id,pos2,NoRestr,[])] else []) @ 
      (Xlist.fold frames [] (fun frames -> function
          Frame(_,schema) -> 
            let schema = remove_pro_args schema in
            if schema = [] then frames else
            (expand_restr valence lexeme pos (LexFrame(id,pos2,restr,schema))) @ frames
        | _ -> frames))
  | LexFrame(id,pos2,Atr,schema) -> 
      let schemas = Xlist.map (Xlist.multiply_list (Xlist.map schema (fun x -> [[x];[]]))) List.flatten in
      Xlist.map schemas (fun schema -> LexFrame(id,pos2,NoRestr,schema))
  | LexFrame(id,pos2,Atr1,schema) -> 
      LexFrame(id,pos2,NoRestr,[]) :: (Xlist.map schema (fun x -> LexFrame(id,pos2,NoRestr,[x])))
  | LexFrame(id,pos2,Ratr,schema) -> 
      let schemas = Xlist.map (Xlist.multiply_list (Xlist.map schema (fun x -> [[x];[]]))) List.flatten in
      Xlist.fold schemas [] (fun schemas schema -> if schema = [] then schemas else LexFrame(id,pos2,NoRestr,schema) :: schemas)
  | LexFrame(id,pos2,Ratr1,schema) -> 
      Xlist.map schema (fun x -> LexFrame(id,pos2,NoRestr,[x]))
  | LexFrame(id,pos2,Ratrs,schema) -> [LexFrame(id,pos2,NoRestr,schema)]
  | LexFrame(id,pos2,NoRestr,_) -> failwith "expand_restr"
  | ComprepFrame(s,pos2,Natr,[]) -> [ComprepFrame(s,pos2,NoRestr,[])]
  | ComprepFrame(s,pos2,Natr,_) -> failwith "expand_restr"
  | ComprepFrame(s,pos2,restr,[]) as frame -> failwith ("expand_restr: " ^ WalStringOf.frame lexeme frame)
  | ComprepFrame(s,pos2,Atr,schema) -> 
      let schemas = Xlist.map (Xlist.multiply_list (Xlist.map schema (fun x -> [[x];[]]))) List.flatten in
      Xlist.map schemas (fun schema -> ComprepFrame(s,pos2,NoRestr,schema))
  | ComprepFrame(s,pos2,Atr1,schema) -> 
      ComprepFrame(s,pos2,NoRestr,[]) :: (Xlist.map schema (fun x -> ComprepFrame(s,pos2,NoRestr,[x])))
  | ComprepFrame(s,pos2,Ratr,schema) -> 
      let schemas = Xlist.map (Xlist.multiply_list (Xlist.map schema (fun x -> [[x];[]]))) List.flatten in
      Xlist.fold schemas [] (fun schemas schema -> if schema = [] then schemas else ComprepFrame(s,pos2,NoRestr,schema) :: schemas)
  | ComprepFrame(s,pos2,Ratr1,schema) -> 
      Xlist.map schema (fun x -> ComprepFrame(s,pos2,NoRestr,[x]))
  | ComprepFrame(s,pos2,Ratrs,schema) -> [ComprepFrame(s,pos2,NoRestr,schema)]
  | ComprepFrame(s,pos2,NoRestr,_) -> failwith "expand_restr"
  | Frame _ as frame -> [frame]
(*   | _ -> failwith "expand_restr" *)
 
let simplify_pos = function
    "subst" -> "noun"
  | "depr" -> "noun"
  | "psubst" -> "noun"
  | "pdepr" -> "noun"
  | "adj" -> "adj"
  | "adjc" -> "adj"
  | "ger" -> "verb"
  | "pact" -> "verb"
  | "ppas" -> "verb"
  | "fin" -> "verb"
  | "bedzie" -> "verb"
  | "praet" -> "verb"
  | "winien" -> "verb"
  | "impt" -> "verb"
  | "imps" -> "verb"
  | "inf" -> "verb"
  | "pcon" -> "verb"
  | "pant" -> "verb"
  | "pred" -> "verb"
  | "ppron12" -> "pron"
  | "ppron3" -> "pron"
  | "siebie" -> "pron"
  | s -> s
    
let transform_zeby = function
    Aff -> [Comp "że"]
  | Negation -> [Comp "że";Comp "żeby"]
  | NegationUndef -> [Comp "że";Comp "żeby"]
  | _ -> failwith "transform_zeby"
  
let transform_gdy = function
    "indicative" -> [Comp "gdy"]
  | "imperative" -> [Comp "gdy"]
  | "conditional" -> [Comp "gdyby"]
  | "gerundial" -> [Comp "gdy"]
  | "" -> [Comp "gdy";Comp "gdyby"]
  | s -> failwith ("transform_gdy: " ^ s)
  
let transform_comp negation mood = function
    Comp comp -> [Comp comp]
  | Zeby -> transform_zeby negation
  | Gdy -> transform_gdy mood
  | CompUndef -> [CompUndef](*failwith "transform_comp"*)
    
let transform_str = function
    Aff -> [Case "acc"]
  | Negation -> [Case "gen"]
  | NegationUndef -> [Case "acc";Case "gen"]
  | _ -> failwith "transform_str"
  
(* FIXME: wstawić wszędzie adj jako wariant PrepNP, ComprepNP i NP *)  
let transform_np_phrase = function
    NP(Case case) -> [NP(Case case)(*;NumP(Case case)*)]
  | NP(CaseAgr) -> [NP(CaseAgr)(*;NumP(CaseAgr)*)]
  | AdjP(Case _) as morf -> [morf] 
  | AdjP(CaseAgr) -> [AdjP(AllAgr)]
  | AdjP(AllAgr) -> [AdjP(AllAgr)]
  | AdjP(Str) -> [AdjP(AllAgr)]
  | PrepNP(sem,prep,Case case) -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)]
(*   | PrepNumP(_,Case _) as morf -> [morf]  *)
  | ComprepNP _ as morf -> [morf]
  | ComparNP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> ComparNP(sem,prep,Case case))
  | ComparPP _ as morf -> [morf]
  | CP(ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> CP(ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji*)
  | NCP(Case c,ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> NCP(Case c,ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji*)
  | PrepNCP(sem,prep,Case case,ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> PrepNCP(sem,prep,Case case,ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji *)
  | PrepAdjP(sem,_,Case _) as morf -> [morf] (* to wygląda seryjny błąd w Walentym xp(abl[prepadjp(z,gen)]) *)
  | PrepNP(sem,prep,Str) -> List.flatten (Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)])) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | PrepAdjP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> PrepAdjP(sem,prep,Case case)) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | AdvP as morf -> [morf] (* FIXME: tu trafiają przysłówkowe realizacje, trzeba by je przetłumaczyć na przymiotniki *)
  | FixedP _ as morf -> [morf]
  | PrepP as morf -> [morf]
  | Or as morf -> [morf]
  | Pro as morf -> [morf]
  | Null as morf -> [morf]
  | phrase -> print_endline ("transform_np_phrase: " ^ WalStringOf.phrase phrase); [phrase]
    
let transform_np_pos = function
  | SUBST(_,Case _) as morf -> [morf]
  | SUBST(_,CaseAgr) as morf -> [morf]
  | ADJ(_,Case _,_,_) as morf -> [morf]
  | ADJ(n,CaseAgr,g,gr) -> [ADJ(n,AllAgr,g,gr)]
  | PACT(n,CaseAgr,g,a,neg,r) -> [PACT(n,AllAgr,g,a,neg,r)]
  | PPAS(_,Case _,_,_,_) as morf -> [morf] 
  | PPAS(n,CaseAgr,g,a,neg) -> [PPAS(n,AllAgr,g,a,neg)]
  | ADJ(n,Str,g,gr) -> [ADJ(n,AllAgr,g,gr)]
  | PPAS(n,Str,g,a,neg) -> [PPAS(n,AllAgr,g,a,neg)]
  | PREP(Case _) as morf -> [morf]
  | ADV _ as morf -> [morf] (* FIXME: tu trafiają przysłówkowe realizacje, trzeba by je przetłumaczyć na przymiotniki *)
  | COMP _ as morf -> [morf]
  | QUB as morf -> [morf]
  | pos -> print_endline ("transform_np_pos: " ^ WalStringOf.pos pos); [pos]
    
let transform_adj_phrase = function
    NP(Case case) -> [NP(Case case)(*;NumP(Case case)*)]
  | NP(Part) -> [NP(Case "gen");NP(Case "acc")(*;NumP(Case "gen");NumP(Case "acc")*)]
  | AdjP(CaseAgr) -> [AdjP(AllAgr)] (* jedno wystąpienie 'cały szczęśliwy', może się przydać podniesienie typu *)
  | PrepNP(sem,prep,Case case) -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)]
  | ComprepNP _ as morf -> [morf]
  | ComparNP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> ComparNP(sem,prep,Case case))
  | ComparPP _ as morf -> [morf]
  | CP(ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> CP(ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji*)
  | NCP(Case c,ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> NCP(Case c,ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji*)
  | PrepNCP(sem,prep,Case case,ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> PrepNCP(sem,prep,Case case,ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji *)
  | PrepAdjP(sem,_,Case _) as morf -> [morf]
  | PrepNP(sem,prep,Str) -> List.flatten (Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)])) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | PrepAdjP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> PrepAdjP(sem,prep,Case case)) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | InfP _ as morf -> [morf]
  | AdvP as morf -> [morf]
  | FixedP _ as morf -> [morf]
  | PrepP as morf -> [morf]
  | Or as morf -> [morf]
  | Pro as morf -> [morf]
  | Null as morf -> [morf]
  | morf -> print_endline ("transform_adj_phrase: " ^ WalStringOf.phrase morf); [morf]
  
let transform_adj_pos = function
  | SUBST(_,Case _) as morf -> [morf]
  | ADJ(n,CaseAgr,g,gr) -> [ADJ(n,AllAgr,g,gr)]
  | PREP(Case _) as morf -> [morf]
  | ADV _ as morf -> [morf]
  | morf -> print_endline ("transform_adj_pos: " ^ WalStringOf.pos morf); [morf]
    
let transform_prep_pos = function
  | SUBST(_,Case _) as morf -> [morf]
  | SUBST(n,Str) -> [SUBST(n,CaseAgr)]
  | NUM(Case _,_,_) as morf -> [morf]
  | ADJ(_,Case _,_,_) as morf -> [morf]
  | GER(_,Case _,_,_,_,_) as morf -> [morf]
  | PPAS(_,Case _,_,_,_) as morf -> [morf] 
  | ADV _ as morf -> [morf]
  | QUB as morf -> [morf]
  | pos -> print_endline ("transform_prep_pos: " ^ WalStringOf.pos pos); [pos]
    
let transform_compar_phrase = function
    NP(Str) -> [NP CaseUndef(*;NumP(CaseUndef)*)] (* FIXME: ta sama sytuacja co w "jako" *)
  | FixedP _ as morf -> [morf]
  | phrase -> print_endline ("transform_compar_phrase: " ^ WalStringOf.phrase phrase); [phrase]
    
let transform_compar_pos = function
  | SUBST(_,Case _) as morf -> [morf]
  | ADJ(_,Case _,_,_) as morf -> [morf]
  | PREP(Case _) as morf -> [morf]
  | PPAS(_,Case _,_,_,_) as morf -> [morf] 
  | SUBST(Number n,Str) -> [SUBST(Number n,CaseUndef)]
  | SUBST(NumberAgr,Str) -> [SUBST(NumberUndef,CaseUndef)]
  | SUBST(NumberUndef,Str) -> [SUBST(NumberUndef,CaseUndef)]
  | PPAS(NumberAgr,Str,GenderAgr,a,neg) -> [PPAS(NumberUndef,CaseUndef,GenderUndef,a,neg)]  (* FIXME: ta sama sytuacja co w "jako" *)
  | PPAS(NumberAgr,CaseAgr,GenderAgr,a,neg) -> [PPAS(NumberUndef,CaseUndef,GenderUndef,a,neg)] (* FIXME: ta sama sytuacja co w "jako" *)
  | ADJ(NumberAgr,Str,GenderAgr,gr) -> [ADJ(NumberUndef,CaseUndef,GenderUndef,gr)] (* FIXME: ta sama sytuacja co w "jako" *)
  | ADJ(NumberAgr,CaseAgr,GenderAgr,gr) -> [ADJ(NumberUndef,CaseUndef,GenderUndef,gr)] (* FIXME: ta sama sytuacja co w "jako" *)
  | NUM(Case _,_,_) as morf -> [morf]
  | pos -> print_endline ("transform_compar_pos: " ^ WalStringOf.pos pos); [pos]
    
let transform_adv_phrase = function
    NP(Case case) -> [NP(Case case)(*;NumP(Case case)*)]
  | PrepNP(sem,prep,Case case) -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)]
  | PrepNCP(sem,prep,Case case,ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> PrepNCP(sem,prep,Case case,ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji *)
  | ComprepNP _ as morf -> [morf]
  | CP(ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> CP(ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji*)
  | InfP _ as morf -> [morf]
  | AdvP as morf -> [morf]
  | Or as morf -> [morf]
  | Pro as morf -> [morf]
  | Null as morf -> [morf]
  | PrepAdjP(sem,_,Case _) as morf -> [morf]
  | PrepNP(sem,prep,Str) -> List.flatten (Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)])) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | PrepAdjP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> PrepAdjP(sem,prep,Case case)) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | ComparNP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> ComparNP(sem,prep,Case case))
  | ComparPP _ as morf -> [morf]
(*   | AdjP(CaseAgr) as morf -> [morf]  *)
(*  | NCP(Case c,ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> NCP(Case c,ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji*)
  | PrepNCP(prep,Case case,ctype,comp) -> Xlist.map (transform_comp NegationUndef "" comp) (fun comp -> PrepNCP(prep,Case case,ctype,comp)) (* FIXME zależność od trybu warunkowego*) (* FIXME zależność od negacji *)
  | FixedP _ as morf -> [morf]*)
  | morf -> print_endline ("transform_adv_phrase: " ^ WalStringOf.phrase morf); [morf]
  
let transform_adv_pos = function
(*  | SUBST(_,Case _) as morf -> [morf]
  | ADJ(_,CaseAgr,_,_) as morf -> [morf]*)
    COMP _ as morf -> [morf] 
  | PREP(Case _) as morf -> [morf]
  | ADV _ as morf -> [morf]
  | morf -> print_endline ("transform_adv_pos: " ^ WalStringOf.pos morf); [morf]
    
(*| Prepnp("jako",Str) as morf -> morf
  | Prepnp("jak",Str) as morf -> morf
  | Prepnp("niczym",Str) as morf -> morf
  | Prepadjp("jako",Str) as morf -> morf
  | Prepadjp("jak",Str) as morf -> morf
  | Prepadjp("niczym",Str) as morf -> morf
  | Compar "jako" as morf -> morf
  | Compar "jak" as morf -> morf
  | Compar "niczym" as morf -> morf
  | Compar "niż" as morf -> morf*)
    
let transform_pers_subj_phrase negation mood = function (* FIXME: prepnp(na,loc) *)
  | NP(Str) -> [NP(NomAgr)(*;NumP(NomAgr)*)]
  | NCP(Str,ctype,comp) -> Xlist.map (transform_comp negation mood comp) (fun comp -> NCP(NomAgr,ctype,comp))
  | CP(ctype,comp) -> Xlist.map (transform_comp negation mood comp) (fun comp -> CP(ctype,comp))
  | InfP _ as morf -> [morf]
  | Or as morf -> [morf]
  | NP(Part) -> [NP(Case "gen")(*;NP(Case "acc")*)(*;NumP(Case "gen");NumP(Case "acc")*)]
  | Pro -> [ProNG]
  | morf -> print_endline ("transform_pers_subj_phrase: " ^ WalStringOf.phrase morf); [morf]
    
let transform_pers_subj_pos negation mood = function
    COMP _ as morf -> [morf]
  | SUBST(n,Str) -> [SUBST(n,NomAgr)]
  | SUBST(n,Case "nom") -> [SUBST(n,NomAgr)] (* wygląda na błąd Walentego, ale nie ma znaczenia *)
  | NUM(Str,g,AcmUndef) -> [NUM(NomAgr,g,AcmUndef)]
  | ADJ(n,Str,g,gr) -> [ADJ(n,NomAgr,g,gr)]
  | morf -> print_endline ("transform_ger_subj_pos: " ^ WalStringOf.pos morf); [morf]
    
let transform_ger_subj_phrase negation mood control = function
  | NP(Str) -> [NP(Case "gen");PrepNP(NoSem,"przez",Case "acc")(*;NumP(Case "gen")*)(*;PrepNumP("przez",Case "acc")*)] (* FIXME: czy przez:acc jest możliwe? *)
  | NCP(Str,ctype,comp) -> List.flatten (Xlist.map (transform_comp negation mood comp) (fun comp -> [NCP(Case "gen",ctype,comp);PrepNCP(NoSem,"przez",Case "acc",ctype,comp)])) (* FIXME: czy przez:acc jest możliwe? *)
  | CP(ctype,comp) -> Xlist.map (transform_comp negation mood comp) (fun comp -> CP(ctype,comp)) (* FIXME: czy to jest możliwe? *)
  | InfP _ as morf -> [morf] (* FIXME: czy to jest możliwe? *)
  | Or as morf -> [morf]
  | NP(Part) -> [NP(Case "gen")(*;NP(Case "acc")*)(*;NumP(Case "gen");NumP(Case "acc")*)]
  | Pro -> if control then [Pro] else [Null]
  | morf -> print_endline ("transform_ger_subj_phrase: " ^ WalStringOf.phrase morf); [morf]
    
let transform_ger_subj_pos negation mood = function (* FIXME: ADV(_) *)
    COMP _ as morf -> [morf] (* FIXME: czy to jest możliwe? *)
  | SUBST(n,Str) -> [SUBST(n,Case "gen")]
  | SUBST(n,Case "nom") -> [SUBST(n,Case "gen")] (* wygląda na błąd Walentego, ale nie ma znaczenia *)
  | NUM(Str,g,AcmUndef) -> [NUM(Case "gen",g,AcmUndef)]
  | ADJ(n,Str,g,gr) -> [ADJ(n,Case "gen",g,gr)]
  | morf -> print_endline ("transform_pers_subj_pos: " ^ WalStringOf.pos morf); [morf]
    
let transform_ppas_subj_phrase negation mood control = function
  | NP(Str) -> [PrepNP(NoSem,"przez",Case "acc")(*;PrepNumP("przez",Case "acc")*)] 
  | NCP(Str,ctype,comp) -> Xlist.map (transform_comp negation mood comp) (fun comp -> PrepNCP(NoSem,"przez",Case "acc",ctype,comp)) 
  | CP(ctype,comp) -> [Null] (* zakładam, że w ramie jest też NCP *)
  | Pro -> if control then [Pro] else [Null]
  | morf -> print_endline ("transform_ppas_subj_phrase: " ^ WalStringOf.phrase morf); [morf]
    
let transform_pers_phrase negation mood = function
  | NP(Str) -> List.flatten (Xlist.map (transform_str negation) (fun case -> [NP case(*;NumP(case)*)]))
  | AdjP(Str) -> Xlist.map (transform_str negation) (fun case -> AdjP case) (* FIXME: pomijam uzgadnianie liczby i rodzaju - wykonalne za pomocą kontroli *)
  | NCP(Str,ctype,comp) -> List.flatten (Xlist.map (transform_str negation) (fun case -> Xlist.map (transform_comp negation mood comp) (fun comp -> NCP(case,ctype,comp))))
  | NP(Part) -> [NP(Case "gen");NP(Case "acc")(*;NumP(Case "gen");NumP(Case "acc")*)]
  | NCP(Part,ctype,comp) -> List.flatten (Xlist.map (transform_comp negation mood comp) (fun comp -> [NCP(Case "gen",ctype,comp);NCP(Case "acc",ctype,comp)]))
  | NP(Case case) -> [NP(Case case)(*;NumP(Case case)*)]
  | PrepNP(sem,prep,Case case) -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)]
(*   | PrepNumP(_,Case _) as morf -> [morf] *)
  | ComprepNP _ as morf -> [morf]
  | NCP(Case case,ctype,comp) -> Xlist.map (transform_comp negation mood comp) (fun comp -> NCP(Case case,ctype,comp))
  | PrepNCP(sem,prep,Case case,ctype,comp) -> Xlist.map (transform_comp negation mood comp) (fun comp -> PrepNCP(sem,prep,Case case,ctype,comp))
  | AdjP(Case _) as morf -> [morf] (* FIXME: pomijam uzgadnianie liczby i rodzaju - wykonalne za pomocą kontroli *)
  | PrepAdjP(sem,_,Case _) as morf -> [morf] (* FIXME: pomijam uzgadnianie liczby i rodzaju - wykonalne za pomocą kontroli *)
  | PrepNP(sem,prep,Str) -> List.flatten (Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> [PrepNP(sem,prep,Case case)(*;PrepNumP(prep,Case case)*)])) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | PrepAdjP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> PrepAdjP(sem,prep,Case case)) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | ComparNP(sem,prep,Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> ComparNP(sem,prep,Case case))
  | ComparPP _ as morf -> [morf]
  | CP(ctype,comp) -> Xlist.map (transform_comp negation mood comp) (fun comp -> CP(ctype,comp))
  | InfP _ as morf -> [morf]
  | PadvP as morf -> [morf]
  | AdvP -> if mood = "gerundial" then [AdjP AllAgr] else [AdvP]
  | FixedP _ as morf -> [morf]
  | PrepP as morf -> [morf]
  | Or as morf -> [morf]
  | Lex "się" as morf -> [morf]
(*   | Refl as morf -> [morf] *)
(*   | Recip as morf -> [morf] *)
  | Pro as morf -> [morf]
  | Null as morf -> [morf]
  | morf -> print_endline ("transform_pers_phrase: " ^ WalStringOf.phrase morf); [morf]
    
let transform_pers_pos negation mood = function
  | SUBST(n,Str) -> Xlist.map (transform_str negation) (fun case -> SUBST(n,case))
  | NUM(Str,g,a) -> Xlist.map (transform_str negation) (fun case -> NUM(case,g,a))
  | ADJ(n,Str,g,gr) -> Xlist.map (transform_str negation) (fun case -> ADJ(n,case,g,gr))
  | PPAS(n,Str,g,a,neg) -> Xlist.map (transform_str negation) (fun case -> PPAS(n,Str,g,a,neg))
  | SUBST(n,Part) -> [SUBST(n,Case "gen");SUBST(n,Case "acc")]
  | SUBST(_,Case _) as morf -> [morf]
  | NUM(Case _,_,_) as morf -> [morf]
  | PREP(Case _) as morf -> [morf]
  | ADJ(_,Case _,_,_) as morf -> [morf]
  | PREP(Str) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> PREP(Case case)) (* FIXME: sprawdzić kto kontroluje! *) (* FIXME: pomijam uzgodnienie liczby i rodzaju *) (* zakładam, że nie jest kontrolowany przez SUBJ w czasowikach z OBJ *)
  | SUBST(n,CaseAgr) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> SUBST(n,Case case)) (* FIXME: sprawdzić kto kontroluje! *)
  | ADJ(n,CaseAgr,g,gr) -> Xlist.map ["nom";"gen";"dat";"acc";"inst"] (fun case -> ADJ(n,Case case,g,gr))  (* FIXME: sprawdzić kto kontroluje! *)
  | COMPAR as morf -> [morf]
  | COMP _ as morf -> [morf]
  | INF _ as morf -> [morf]
  | ADV grad -> if mood = "gerundial" then [ADJ(NumberAgr,AllAgr,GenderAgr,grad)] else [ADV grad]
  | morf -> print_endline ("transform_pers_pos: " ^ WalStringOf.pos morf); [morf]
    
let transform_pers_schema negation mood schema =
  Xlist.map schema (fun s -> 
    {s with morfs = 
       if s.gf = SUBJ then List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_subj_phrase negation mood phrase) (fun phrase -> Phrase phrase)
         | E phrase -> Xlist.map (transform_pers_subj_phrase negation mood phrase) (fun phrase -> E phrase)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_subj_pos negation mood pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_fin_schema")) 
       else List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_phrase negation mood phrase) (fun phrase -> Phrase phrase)
         | E phrase -> [Phrase Null] (*E(List.flatten (Xlist.map phrases (transform_pers_phrase negation mood)))*) (* FIXME *)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_pos negation mood pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_fin_schema"))})
    
let transform_impt_schema negation mood schema =
  Xlist.map schema (fun s -> 
    {s with morfs = 
       if s.gf = SUBJ then [Phrase ProNG]
       else List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_phrase negation mood phrase) (fun phrase -> Phrase phrase)
         | E phrase -> [Phrase Null] (*E(List.flatten (Xlist.map phrases (transform_pers_phrase negation mood)))*) (* FIXME *)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_pos negation mood pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_impt_schema"))})
    
let transform_imps_schema negation mood schema =
  Xlist.map schema (fun s -> 
    {s with morfs = 
       if s.gf = SUBJ then [Phrase Pro]
       else List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_phrase negation mood phrase) (fun phrase -> Phrase phrase)
         | E phrase -> [Phrase Null] (*E(List.flatten (Xlist.map phrases (transform_pers_phrase negation mood)))*) (* FIXME *)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_pos negation mood pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_imps_chema"))})
    
let transform_ger_schema negation schema = (* FIXME: zakładam, że ger zeruje mood, czy to prawda? *)
  Xlist.map schema (fun s -> 
    {s with morfs = 
       if s.gf = SUBJ then List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_ger_subj_phrase negation "gerundial" (s.cr <> [] || s.ce <> []) phrase) (fun phrase -> Phrase phrase)
         | E phrase -> Xlist.map (transform_ger_subj_phrase negation "gerundial" (s.cr <> [] || s.ce <> []) phrase) (fun phrase -> E phrase)
         | LexArg(id,pos,lex) -> Xlist.map (transform_ger_subj_pos negation "gerundial" pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_fin_schema"))
       else List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_phrase negation "gerundial" phrase) (fun phrase -> Phrase phrase)
         | E phrase -> [Phrase Null] (*E(List.flatten (Xlist.map phrases (transform_pers_phrase negation mood)))*) (* FIXME *)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_pos negation "gerundial" pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_fin_schema"))})
    
let transform_padv_schema negation mood pro schema =
  Xlist.map schema (fun s ->
    {s with morfs = 
       if s.gf = SUBJ then if s.ce = [] then if pro then [Phrase Pro] else [Phrase Null] else [Phrase Null] else
       List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_phrase negation mood phrase) (fun phrase -> Phrase phrase)
         | E phrase -> [Phrase Null] (*E(List.flatten (Xlist.map phrases (transform_pers_phrase negation mood)))*) (* FIXME *)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_pos negation mood pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_fin_schema"))})
    
let transform_pact_schema negation mood schema =
  Xlist.map schema (fun s -> 
    {s with morfs = 
       if s.gf = SUBJ then [Phrase Null]
       else List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_phrase negation mood phrase) (fun phrase -> Phrase phrase)
         | E phrase -> [Phrase Null] (*E(List.flatten (Xlist.map phrases (transform_pers_phrase negation mood)))*) (* FIXME *)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_pos negation mood pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_pact_schema"))})
    
let transform_ppas_schema negation mood schema =
  Xlist.map schema (fun s -> 
    {s with morfs = 
       if s.gf = OBJ then [Phrase Null] else
       if s.gf = SUBJ then List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_ppas_subj_phrase negation mood (s.cr <> [] || s.ce <> []) phrase) (fun phrase -> Phrase phrase)
         | E phrase -> Xlist.map (transform_ppas_subj_phrase negation mood (s.cr <> [] || s.ce <> []) phrase) (fun phrase -> E phrase)
         | LexArg(id,SUBST(n,Str),lex) -> raise Not_found (* FIXME!!! *)
         | _ -> failwith "transform_ppas_schema"))
       else List.flatten (Xlist.map s.morfs (function
           Phrase phrase -> Xlist.map (transform_pers_phrase negation mood phrase) (fun phrase -> Phrase phrase)
         | E phrase -> [Phrase Null] (*E(List.flatten (Xlist.map phrases (transform_pers_phrase negation mood)))*) (* FIXME *)
         | LexArg(id,pos,lex) -> Xlist.map (transform_pers_pos negation mood pos) (fun pos -> LexArg(id,pos,lex))
         | _ -> failwith "transform_ppas_schema"))})
    
let add_padv schema = 
  List.flatten (Xlist.map schema (fun s -> 
    if s.gf = SUBJ then 
      match s.cr with
        [] -> [{s with cr=["3"]}; let s = adjunct_schema_field "" Both [Phrase Null;Phrase PadvP] in {s with ce=["3"]}]
      | [cr] -> [s; let s = adjunct_schema_field "" Both [Phrase Null;Phrase PadvP] in {s with ce=[cr]}]
      | _ -> failwith "add_padv"
    else [s]))
    
let transform_np_schema schema =
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
      Phrase phrase -> Xlist.map (transform_np_phrase phrase) (fun phrase -> Phrase phrase)
(*     | LexArg(id,ADV _,lex) as morf -> print_endline (WalStringOf.morf morf); [morf] *)
    | LexArg(id,pos,lex) -> Xlist.map (transform_np_pos pos) (fun pos -> LexArg(id,pos,lex))
    | Multi[AdjP AllAgr] -> [Multi[AdjP AllAgr]]
    | _ -> failwith "transform_np_schema"))})
    
let transform_num_schema acm schema =
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function (* kierunek argumentu został dodany w expand_lexicalizations_morfs *)
    | Phrase Pro -> [Phrase Pro]
    | LexArg(id,SUBST(NumberUndef,CaseUndef),lex) -> 
         (match acm with
            Acm "rec" -> [LexArg(id,SUBST(NumberUndef,GenAgr),lex)]
          | Acm "congr" -> [LexArg(id,SUBST(NumberUndef,AllAgr),lex)]
          | _ -> failwith "transform_num_schema")
    | morf -> failwith ("transform_num_schema: " ^ WalStringOf.morf morf)))})
    
let transform_adj_schema schema =
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
      Phrase phrase -> Xlist.map (transform_adj_phrase phrase) (fun phrase -> Phrase phrase)
    | LexArg(id,pos,lex) -> Xlist.map (transform_adj_pos pos) (fun pos -> LexArg(id,pos,lex))
    | _ -> failwith "transform_adj_schema"))})
    
let transform_adv_schema schema =
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
      Phrase phrase -> Xlist.map (transform_adv_phrase phrase) (fun phrase -> Phrase phrase)
    | LexArg(id,pos,lex) -> Xlist.map (transform_adv_pos pos) (fun pos -> LexArg(id,pos,lex))
    | _ -> failwith "transform_adv_schema"))})
    
let transform_prep_schema schema =
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
      Phrase(NumP(case)) -> [Phrase(NumP(case))]
    | LexArg(id,pos,lex) -> Xlist.map (transform_prep_pos pos) (fun pos -> LexArg(id,pos,lex))
    | morf -> failwith ("transform_prep_schema: " ^ WalStringOf.morf morf)))})
    
let transform_compar_schema schema =
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
      Phrase phrase -> Xlist.map (transform_compar_phrase phrase) (fun phrase -> Phrase phrase)
    | LexArg(id,pos,lex) -> Xlist.map (transform_compar_pos pos) (fun pos -> LexArg(id,pos,lex))
    | morf -> failwith ("transform_compar_schema: " ^ WalStringOf.morf morf)))})
    
let transform_comp_schema schema = (* kierunek argumentu został dodany w expand_lexicalizations_morfs *)
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
    | LexArg(_,PERS _,_) as morf -> [morf]
    | morf -> failwith ("transform_comp_schema: " ^ WalStringOf.morf morf)))})
    
let transform_qub_schema schema =
  Xlist.map schema (fun s ->
    {s with morfs=List.flatten (Xlist.map s.morfs (function
    | LexArg(_,PERS _,_) as morf -> [morf]
    | morf -> failwith ("transform_qub_schema: " ^ WalStringOf.morf morf)))})
    
let rec remove_adj_agr = function  
    [] -> []
  | {morfs=[Phrase Null;Phrase(AdjP(CaseAgr))]} :: l -> remove_adj_agr l
  | {morfs=[Phrase Null;Phrase(AdjP(Part))]} :: l -> remove_adj_agr l
  | s :: l -> (*print_endline (WalStringOf.schema [s]);*) s :: (remove_adj_agr l)
  
let rec get_role gf = function
    [] -> raise Not_found
  | s :: l -> if s.gf = gf then s.role,s.role_attr else get_role gf l
  
let expand_negation = function
    Negation -> [Negation]
  | Aff -> [Aff]
  | NegationUndef -> [Negation;Aff]
  | NegationNA -> failwith "expand_negation"
    
let expand_aspect = function
    Aspect s -> [Aspect s]
  | AspectUndef -> [Aspect "imperf";Aspect "perf"]
  | AspectNA -> failwith "expand_aspect"
  
let load_list filename = 
  Str.split (Str.regexp "\n") (File.load_file filename)  
  
let subst_uncountable_lexemes = StringSet.of_list (load_list Paths.subst_uncountable_lexemes_filename)
let subst_uncountable_lexemes2 = StringSet.of_list (load_list Paths.subst_uncountable_lexemes_filename2)
let subst_container_lexemes = StringSet.of_list (load_list Paths.subst_container_lexemes_filename)
let subst_numeral_lexemes = StringSet.of_list (load_list Paths.subst_numeral_lexemes_filename)
let subst_time_lexemes = StringSet.of_list (load_list Paths.subst_time_lexemes_filename)

let subst_pronoun_lexemes = StringSet.of_list ["co"; "kto"; "cokolwiek"; "ktokolwiek"; "nic"; "nikt"; "coś"; "ktoś"; "to"]
let adj_pronoun_lexemes = StringSet.of_list ["czyj"; "jaki"; "który"; "jakiś"; "ten"; "taki"]

(* let adj_quant_lexemes = StringSet.of_list ["każdy"; "wszelki"; "wszystek"; "żaden"; "jakiś"; "pewien"; "niektóry"; "jedyny"; "sam"] *)

let empty_valence_lexemes = StringSet.union subst_pronoun_lexemes adj_pronoun_lexemes

  
let noun_type lemma pos = 
  let nsyn = 
    if pos = "ppron12" || pos = "ppron3" || pos = "siebie" then "pronoun" else
    if pos = "psubst" || pos = "pdepr" || pos = "date" then "proper" else
    if StringSet.mem subst_pronoun_lexemes lemma then "pronoun" else
    "common" in
  let nsem = 
    if pos = "ppron12" || pos = "ppron3" || pos = "siebie" then [Common "count"] else
    if StringSet.mem subst_time_lexemes lemma then [Time] else
    let l = ["count"] in
    let l = if StringSet.mem subst_uncountable_lexemes lemma || StringSet.mem subst_uncountable_lexemes2 lemma then "mass" :: l else l in
    let l = if StringSet.mem subst_container_lexemes lemma then "measure" :: l else l in
    Xlist.map l (fun s -> Common s) in
  nsyn,nsem
  
let adj_type lemma = (* FIXME: typy przymiotników wymagają zbadania - przejrzenia listy przymiotników *)
  let adjsyn = if StringSet.mem adj_pronoun_lexemes lemma then "pronoun" else "common" in  (* FIXME: dodać heurystykę uwzględniającą wielkość liter aby wykrywać proper np. Oświęcimski*)
  adjsyn
    
let transform_frame lexeme pos = function (* FIXME: dodać tutaj typy rzeczowników *)
    Frame(DefaultAtrs(meanings,refl,opinion,negation,pred,aspect),schema) as frame ->
      if pos = "subst" || pos = "depr" || pos = "psubst" || pos = "pdepr" || pos = "ppron12" || pos = "ppron3" || pos = "siebie" then (
        if refl <> ReflEmpty || negation <> NegationNA || pred <> PredNA || aspect <> AspectNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let nsyn,nsem(*,typ*) = noun_type lexeme pos in
        let schema = if nsyn = "pronoun" then [] else (remove_adj_agr schema) @ noun_adjuncts in (* FIXME: remove_adj_agr jest w słowniku tymczasowo *)
(*         List.flatten (Xlist.map typ (fun typ ->  *)
          Xlist.map nsem (fun nsem -> Frame(NounAtrs(meanings,nsyn,nsem(*,typ*)),transform_np_schema schema)))(* ))*) else
      if pos = "symbol" || pos = "date" || pos = "date-interval" || pos = "hour" || pos = "hour-minute" || pos = "hour-interval" || pos = "hour-minute-interval" || 
         pos = "year" || pos = "year-interval" || pos = "day" || pos = "day-interval" || pos = "day-month" || pos = "day-month-interval" || 
         pos = "match-result" || pos = "month-interval" || pos = "roman" || pos = "roman-interval" || pos = "url" || pos = "email" || pos = "obj-id" then 
        let nsyn,nsem = "proper",[Common "count"] in
        Xlist.map nsem (fun nsem -> Frame(NounAtrs(meanings,nsyn,nsem),transform_np_schema schema)) else
      if pos = "adj" || pos = "adjc" || pos = "adjp" || pos = "ordnum" then (
        if refl <> ReflEmpty || negation <> NegationNA || aspect <> AspectNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let adjsyn(*,adjsem,typ*) = adj_type lexeme in
        let schema = if pos = "adjp" || pos = "ordnum" then schema else if adjsyn = "pronoun" then [] else schema @ adj_adjuncts in
        let case = match pred with Pred -> Case "pred" | PredNA -> CaseUndef in
(*         Xlist.map typ (fun typ ->  *)
          [Frame(AdjAtrs(meanings,case,adjsyn(*,adjsem,typ*)),transform_adj_schema schema)])(* )*) else      
      if pos = "adv" then (
        if refl <> ReflEmpty || negation <> NegationNA || pred <> PredNA || aspect <> AspectNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame); (* FIXME: typy przysłówków *)
        [Frame(EmptyAtrs meanings,transform_adv_schema (remove_adj_agr schema))]) else
      if pos = "fin" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in 
        let schema = (add_padv schema) @ verb_adjuncts in
        List.flatten (Xlist.map (expand_negation negation) (fun negation -> 
          Xlist.map (expand_aspect aspect) (function 
            Aspect "imperf" -> Frame(PersAtrs(meanings,s,negation,"indicative","pres",NoAux,Aspect "imperf"), transform_pers_schema negation "indicative" schema)
          | Aspect "perf" -> Frame(PersAtrs(meanings,s,negation,"indicative","fut",NoAux,Aspect "perf"), transform_pers_schema negation "indicative" schema)
          | _ -> failwith "transform_frame") @
          [Frame(PersAtrs(meanings,s,negation,"imperative","fut",ImpAux,aspect), transform_pers_schema negation "imperative" schema)]))) else
      if pos = "bedzie" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in 
        let schema = (add_padv schema) @ verb_adjuncts in
        List.flatten (Xlist.map (expand_negation negation) (fun negation -> 
          Xlist.map (expand_aspect aspect) (function 
            Aspect "imperf" -> Frame(PersAtrs(meanings,s,negation,"indicative","fut",NoAux,Aspect "imperf"), transform_pers_schema negation "indicative" schema)
          | Aspect "perf" -> Frame(PersAtrs(meanings,s,negation,"indicative","fut",NoAux,Aspect "perf"), transform_pers_schema negation "indicative" schema) (* FIXME: niepotrzebne *)
          | _ -> failwith "transform_frame")))) else
      if pos = "praet" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in 
        let schema = (add_padv schema) @ verb_adjuncts in
        List.flatten (Xlist.map (expand_negation negation) (fun negation -> 
          List.flatten (Xlist.map (expand_aspect aspect) (function 
            Aspect "imperf" -> 
              [Frame(PersAtrs(meanings,s,negation,"indicative","past",NoAux,Aspect "imperf"), transform_pers_schema negation "indicative" schema);
               Frame(PersAtrs(meanings,s,negation,"conditional","past",NoAux,Aspect "imperf"), transform_pers_schema negation "conditional" schema);
               Frame(PersAtrs(meanings,s,negation,"indicative","fut",FutAux,Aspect "imperf"), transform_pers_schema negation "indicative" schema)]
          | Aspect "perf" -> 
              [Frame(PersAtrs(meanings,s,negation,"indicative","past",NoAux,Aspect "perf"), transform_pers_schema negation "indicative" schema);
               Frame(PersAtrs(meanings,s,negation,"conditional","past",NoAux,Aspect "perf"), transform_pers_schema negation "conditional" schema)]
          | _ -> failwith "transform_frame"))))) else
      if pos = "winien"  then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in 
        let schema = (add_padv schema) @ verb_adjuncts in
        List.flatten (Xlist.map (expand_negation negation) (fun negation -> 
          List.flatten (Xlist.map (expand_aspect aspect) (fun aspect -> 
              [Frame(PersAtrs(meanings,s,negation,"indicative","pres",NoAux,aspect), transform_pers_schema negation "indicative" schema);
               Frame(PersAtrs(meanings,s,negation,"conditional","past",NoAux,aspect), transform_pers_schema negation "conditional" schema);
               Frame(PersAtrs(meanings,s,negation,"indicative","past",PastAux,aspect), transform_pers_schema negation "indicative" schema)]))))) else
      if pos = "impt" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in 
        let schema = (add_padv schema) @ verb_adjuncts in
        Xlist.map (expand_negation negation) (fun negation -> 
            Frame(PersAtrs(meanings,s,negation,"imperative","fut",NoAux,aspect),transform_impt_schema negation "imperative" schema))) else
      if pos = "imps" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in 
        let schema = (add_padv schema) @ verb_adjuncts in
        Xlist.map (expand_negation negation) (fun negation -> 
            Frame(PersAtrs(meanings,s,negation,"indicative","past",NoAux,aspect),transform_imps_schema negation "indicative" schema))) else
      if pos = "pred" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in 
        let schema = (add_padv schema) @ verb_adjuncts in
        List.flatten (Xlist.map (expand_negation negation) (fun negation -> 
              [Frame(PersAtrs(meanings,s,negation,"indicative","pres",NoAux,aspect), transform_pers_schema negation "indicative" schema);
               Frame(PersAtrs(meanings,s,negation,"indicative","fut",FutAux,aspect), transform_pers_schema negation "indicative" schema);
               Frame(PersAtrs(meanings,s,negation,"indicative","past",PastAux,aspect), transform_pers_schema negation "indicative" schema)]))) else
      if pos = "pcon" || pos = "pant" || pos = "inf" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let role,role_attr = try get_role SUBJ schema with Not_found -> "Initiator","" in
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in
        let schema = schema @ verb_adjuncts in
        Xlist.map (expand_negation negation) (fun negation -> 
            Frame(NonPersAtrs(meanings,s,role,role_attr,negation,aspect),transform_padv_schema negation "indicative" true schema))) else
      if pos = "pact" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        try 
          let role,role_attr = try get_role SUBJ schema with Not_found -> "Initiator","" in
          let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in
          let schema = schema @ verb_adjuncts in
          Xlist.map (expand_negation negation) (fun negation -> 
              Frame(NonPersAtrs(meanings,s,role,role_attr,negation,aspect),transform_pact_schema negation "indicative" schema))
        with Not_found -> []) else
      if pos = "ppas" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        try 
          let role,role_attr = try get_role OBJ schema with Not_found -> "Theme","" in
          let s,schema = if refl = ReflSie then raise Not_found else lexeme, schema in
          let schema = schema @ verb_adjuncts in
          Xlist.map (expand_negation negation) (fun negation -> 
              Frame(NonPersAtrs(meanings,s,role,role_attr,negation,aspect),transform_ppas_schema negation "indicative" schema))
        with Not_found -> []) else
      if pos = "ger" then (
        if pred <> PredNA then failwith ("transform_frame: " ^ WalStringOf.frame lexeme frame);
        let s,schema = if refl = ReflSie then lexeme ^ " się", nosem_refl_schema_field :: schema else lexeme, schema in (* FIXME: czy ger może mieć niesemantyczne się? *)
        let schema = schema @ verb_adjuncts in
        Xlist.map (expand_negation negation) (fun negation -> 
            Frame(GerAtrs(meanings,s,negation,aspect),transform_ger_schema negation schema))) else
      failwith ("transform_frame: " ^ pos)
  | LexFrame(id,pos,NoRestr,schema) as frame ->
      (match pos with
         SUBST _ -> [LexFrame(id,pos,NoRestr,transform_np_schema schema)]
       | PREP _ -> [LexFrame(id,pos,NoRestr,transform_prep_schema schema)]
       | NUM(c,g,AcmUndef) -> 
            Xlist.map [Acm "congr";Acm "rec"] (fun acm -> 
              LexFrame(id,NUM(c,g,acm),NoRestr,transform_num_schema acm schema))
       | ADJ(n,c,g,gr) -> [LexFrame(id,pos,NoRestr,transform_adj_schema schema)]
       | ADV(gr) -> [LexFrame(id,pos,NoRestr,transform_adv_schema schema)]
       | GER(n,c,g,a,negation,ReflEmpty) -> 
            Xlist.map (expand_negation negation) (fun negation -> 
              LexFrame(id,GER(n,c,g,a,negation,ReflEmpty),NoRestr,transform_ger_schema negation schema))
       | PACT(n,c,g,a,negation,ReflEmpty) -> 
            Xlist.map (expand_negation negation) (fun negation -> 
              LexFrame(id,PACT(n,c,g,a,negation,ReflEmpty),NoRestr,transform_pact_schema negation "indicative" schema))
       | PPAS(n,c,g,a,negation) -> 
            Xlist.map (expand_negation negation) (fun negation -> 
              LexFrame(id,PPAS(n,c,g,a,negation),NoRestr,transform_ppas_schema negation "indicative" schema))
       | INF(a,negation,r) -> 
            Xlist.map (expand_negation negation) (fun negation -> 
              LexFrame(id,INF(a,negation,r),NoRestr,transform_padv_schema negation "indicative" false schema))
       | QUB -> [LexFrame(id,pos,NoRestr,transform_qub_schema schema)]
       | COMPAR -> [LexFrame(id,pos,NoRestr,transform_compar_schema schema)]
       | COMP _ -> [LexFrame(id,pos,NoRestr,transform_comp_schema schema)]
       | PERS(negation,r) -> 
            Xlist.map (expand_negation negation) (fun negation -> 
              LexFrame(id,PERS(negation,r),NoRestr,transform_pers_schema negation "indicative" schema))
       | _ -> failwith ("transform_frame:" ^ WalStringOf.frame lexeme frame))
  | ComprepFrame(s,pos,NoRestr,schema) as frame ->
      (match pos with
         PREP _ -> [ComprepFrame(s,pos,NoRestr,transform_prep_schema schema)]
       | ADV _ -> [ComprepFrame(s,pos,NoRestr,transform_adv_schema schema)]
       | _ -> failwith ("transform_frame:" ^ WalStringOf.frame lexeme frame))
  | frame -> failwith ("transform_frame:" ^ WalStringOf.frame lexeme frame) 

let reduce_frame_negation lexemes = function
    Negation -> StringMap.mem lexemes "nie"
  | _ -> true
  
let reduce_frame_mood lexemes = function
    "conditional" -> StringMap.mem lexemes "by"
  | _ -> true
  
let reduce_frame_aux lexemes = function
    NoAux -> true
  | PastAux -> (try let poss = StringMap.find lexemes "być" in StringSet.mem poss "praet" with Not_found -> false)
  | FutAux  -> (try let poss = StringMap.find lexemes "być" in StringSet.mem poss "bedzie" with Not_found -> false)
  | ImpAux -> StringMap.mem lexemes "niech" || StringMap.mem lexemes "niechaj" || StringMap.mem lexemes "niechże" || StringMap.mem lexemes "niechajże"
  
let reduce_frame_atrs pos lexemes = function  
    Frame(NounAtrs _,_) -> true
  | Frame(AdjAtrs _,_) -> true
  | Frame(EmptyAtrs _,_) -> true
  | Frame(PersAtrs(_,_,negation,mood,_,aux,_),_) -> reduce_frame_negation lexemes negation && reduce_frame_mood lexemes mood && reduce_frame_aux lexemes aux
  | Frame(NonPersAtrs(_,_,_,_,negation,_),_) -> if pos = "pact" || pos = "ppas" then true else reduce_frame_negation lexemes negation
  | Frame(GerAtrs(_,_,negation,_),_) -> reduce_frame_negation lexemes negation
  | Frame(_,_) as frame -> failwith ("reduce_frame_atrs: " ^ WalStringOf.frame "" frame)
  | LexFrame _ -> true
  | ComprepFrame _ -> true
  
let rec reduce_frame_atrs_list pos lexemes = function  
    [] -> []
  | frame :: l -> (if reduce_frame_atrs pos lexemes frame then [frame] else []) @ reduce_frame_atrs_list pos lexemes l
  
let find_frames lexemes =
(*   print_endline "find_frames 1"; *)
  let valence = StringMap.fold lexemes StringMap.empty (fun valence lexeme poss ->
(*     let poss = StringSet.fold poss StringSet.empty (fun poss pos -> StringSet.add poss (simplify_pos pos)) in *)
(*   Printf.printf "find_frame: %s |%s|\n" s (String.concat " " (StringSet.to_list lexemes));   *)
    StringSet.fold poss valence (fun valence pos -> 
      let valence = 
        let frames_sem = try StringMap.find (StringMap.find walenty (simplify_pos pos)) lexeme with Not_found -> [] in
(*         if frames_sem <> [] then Printf.printf "%s %s in TEI\n%!" lexeme pos; *)
        if frames_sem <> [] then           
          Xlist.fold frames_sem valence (fun valence frame -> 
            convert_frame_sem expands subtypes equivs lexemes valence lexeme pos frame)
        else
          let frames = match simplify_pos pos with
              "verb" -> ((*try StringMap.find verb_frames lexeme with Not_found ->*) ["verb","","","","",""])
            | "noun" -> ((*try StringMap.find noun_frames lexeme with Not_found ->*) if StringSet.mem empty_valence_lexemes lexeme then ["empty","","","","",""] else ["noun","","","","",""])
            | "adj" -> ((*try StringMap.find adj_frames lexeme with Not_found ->*) if StringSet.mem empty_valence_lexemes lexeme then ["empty","","","","",""] else ["adj","","","","",""])
            | "adv" -> ((*try StringMap.find adv_frames lexeme with Not_found ->*) ["adv","","","","",""])
            | "pron" -> ["empty","","","","",""]
            | "adjp" -> ["empty","","","","",""]
            | "ordnum" -> ["empty","","","","",""]
            | "symbol" -> ["empty","","","","",""]
            | "date" -> ["date","","","","",""]
            | "date-interval" -> ["empty","","","","",""]
            | "hour" -> ["hour","","","","",""]
            | "hour-minute" -> ["hour","","","","",""]
            | "hour-interval" -> ["empty","","","","",""]
            | "hour-minute-interval" -> ["empty","","","","",""]
            | "year" -> ["empty","","","","",""]
            | "year-interval" -> ["empty","","","","",""]
            | "day" -> ["day","","","","",""]
            | "day-interval" -> ["day","","","","",""]
            | "day-month" -> ["date2","","","","",""]
            | "day-month-interval" -> ["empty","","","","",""]
            | "match-result" -> ["empty","","","","",""]
            | "month-interval" -> ["empty","","","","",""]
            | "roman" -> ["empty","","","","",""]
            | "roman-interval" -> ["empty","","","","",""]
            | "url" -> ["empty","","","","",""]
            | "email" -> ["empty","","","","",""]
            | "obj-id" -> ["empty","","","","",""]
            | _ -> [] in
(*          if frames = [] then valence else 
   Printf.printf "find_frame: %s |l|=%d\n" s (Xlist.size l); *)
          Xlist.fold frames valence (fun valence frame -> 
            convert_frame expands subtypes equivs lexemes valence lexeme pos frame) in
      Xlist.fold ((*try StringMap.find compreps lexeme with Not_found ->*) []) valence (fun valence (cpos,frame) -> (* FIXME: na razie przyimki złożone są wyłączone *)
        if cpos = pos then convert_comprep_frame expands subtypes equivs lexemes valence lexeme pos frame else valence))) in
(*   print_endline "find_frames 2"; *)
  let valence = StringMap.mapi valence (fun lexeme poss ->
    StringMap.mapi poss (fun pos frames ->
      List.flatten (Xlist.map frames (fun frame ->
(*         print_endline ("find_frames: " ^ WalStringOf.frame lexeme frame); *)
        expand_restr valence lexeme pos frame)))) in
(*   print_endline "find_frames 3"; *)
  let valence = StringMap.mapi valence (fun lexeme poss ->
    StringMap.mapi poss (fun pos frames ->
      reduce_frame_atrs_list pos lexemes (List.flatten (Xlist.map frames (transform_frame lexeme pos))))) in
(*  let valence = StringMap.mapi valence (fun lexeme poss ->
    StringMap.mapi poss (fun pos frames ->
      Xlist.map frames (assign_thematic_role pos))) in*)
(*  StringMap.iter valence (fun lexeme poss ->
    StringMap.iter poss (fun pos frames ->
      Xlist.iter frames (fun frame -> print_endline (WalStringOf.frame lexeme frame))));*)
(*   print_endline "find_frames 4"; *)
  valence
  
(*let _ =
  let valence = Xlist.fold all_frames StringMap.empty (fun valence (pos,frame_map) ->
    print_endline pos;
    StringMap.fold frame_map valence (fun valence lexeme frames ->
      Xlist.fold frames valence (fun valence frame -> 
(*         print_endline (WalStringOf.unparsed_frame lexeme frame); *)
        convert_frame expands subtypes equivs StringMap.empty valence lexeme pos frame))) in
  print_endline "comprepnp";
  let valence = StringMap.fold compreps valence (fun valence lexeme frames ->
    Xlist.fold frames valence (fun valence (pos,frame) ->
      convert_comprep_frame expands subtypes equivs StringMap.empty valence lexeme pos frame)) in
  print_endline "expand_restr";
  let valence = StringMap.mapi valence (fun lexeme poss ->
    StringMap.mapi poss (fun pos frames ->
      List.flatten (Xlist.map frames (expand_restr valence lexeme pos)))) in
  print_endline "transform_frame";
  let _ = StringMap.mapi valence (fun lexeme poss ->
    StringMap.mapi poss (fun pos frames ->
(*       print_endline lexeme; *)
      List.flatten (Xlist.map frames (transform_frame lexeme pos)))) in
  print_endline "done";
  ()*)
(*  StringMap.iter valence (fun lexeme poss ->
    StringMap.iter poss (fun pos frames ->
      Xlist.iter frames (fun frame -> print_endline (WalStringOf.frame lexeme frame))))*)