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 PreTypes
open WalTypes
open LCGtypes
open Xstd

let all_genders = ["m1";"m2";"m3";"f";"n1";"n2";"p1";"p2";"p3"]
let all_cases = ["nom";"gen";"dat";"acc";"inst";"loc";"voc"]
let all_persons = ["pri";"sec";"ter"]
let all_numbers = ["sg";"pl"]
(* FIXME: zamiast wszystkich możliwych wartości można używać Zero gdy nie ma uzgodnienia *)

let expand_numbers numbers =
  if Xlist.mem numbers "_" then ["sg";"pl"] else numbers

let expand_genders genders  =
  if Xlist.mem genders "_" then all_genders else genders

let expand_cases cases  =
  if Xlist.mem cases "_" || Xlist.mem cases "$C" then all_cases else cases

let expand_akcs akcs  =
  if Xlist.mem akcs "_" then ["akc";"nakc"] else akcs

let split_voc cases =
  let cases,voc = Xlist.fold cases ([],[]) (fun (cases,voc) -> function
    "voc" -> cases, "voc" :: voc
  | s -> s :: cases, voc) in
  match cases,voc with
    [],["voc"] -> [["voc"]]
  | _,["voc"] -> [List.rev cases; ["voc"]]
  | _,[] -> [List.rev cases]
  | _ -> failwith "split_voc"

let check_frame_case cases = function
    CaseAgr -> cases
  | AllAgr -> cases
  | CaseUndef -> cases
  | Case case -> if not (Xlist.mem cases case) then raise Not_found else [case]
  | Str -> cases
  | case -> failwith ("check_frame_case: " ^ WalStringOf.case case)

let check_frame_number numbers = function
    Number num -> if not (Xlist.mem numbers num) then raise Not_found else [num]
  | NumberUndef -> numbers
  | NumberAgr -> numbers

let check_frame_number2 numbers = function
    Common "mass" -> if not (Xlist.mem numbers "sg") then raise Not_found else ["sg"]
  | _ -> numbers

let check_frame_gender genders = function
    Gender gender -> if not (Xlist.mem genders gender) then raise Not_found else [gender]
  | GenderUndef -> genders
  | GenderAgr -> genders
  | Genders genders2 ->
       let set = StringSet.intersection (StringSet.of_list genders) (StringSet.of_list genders2) in
       if StringSet.is_empty set then raise Not_found
       else StringSet.to_list set

let check_frame_grad grads = function
    Grad grad -> if not (Xlist.mem grads grad) then raise Not_found else [grad]
  | GradUndef -> grads

let check_frame_acm acms = function
    Acm acm -> if not (Xlist.mem acms acm) then raise Not_found else acm
  | AcmUndef -> failwith "check_acm"

let check_frame_aspect aspects = function
    Aspect aspect -> if not (Xlist.mem aspects aspect) then raise Not_found else [aspect]
  | AspectUndef -> aspects
  | AspectNA -> failwith "check_frame_aspect"

let check_frame_negation = function
    ["aff"] -> (function Negation -> raise Not_found | Aff -> "aff" | NegationUndef -> "aff" | NegationNA -> failwith "check_frame_negation")
  | ["neg"] -> (function Negation -> "negation" | Aff -> raise Not_found | NegationUndef -> "negation" | NegationNA -> failwith "check_frame_negation")
  | _ -> failwith "check_frame_negation"

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

let comp_arg_schema_field morfs =
  {gf=CORE; role=""; role_attr=""; sel_prefs=[]; cr=[]; ce=[]; dir=Forward; morfs=morfs} (* FIXME: uporządkować sensy *)

let prep_arg_schema_field morfs =
  {gf=CORE; role="Ref"; role_attr=""; sel_prefs=[]; cr=[]; ce=[]; dir=Forward; morfs=morfs} (* FIXME: uporządkować sensy *)

let prep_arg_schema_field2 morfs =
  {gf=CORE; role="Ref"; role_attr=""; sel_prefs=[]; cr=[]; ce=[]; dir=Forward; morfs=morfs} (* FIXME: uporządkować sensy *)

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

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

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

let nosem_refl_schema_field =
  {gf=NOSEM; role=""; role_attr=""; sel_prefs=[]; cr=[]; ce=[]; dir=Both; morfs=[Phrase(Lex "się")]}

let num_arg_schema_field morfs =
  {gf=CORE; role="QUANT-ARG"; role_attr=""; sel_prefs=["sense"]; cr=[]; ce=[]; dir=Forward; morfs=morfs}

let inclusion = nosem_schema_field(*adjunct_schema_field "Inclusion"*) Forward [Phrase Null;Phrase Inclusion]

let qub_inclusion = [adjunct_schema_field "Manner" Backward [Phrase Null;Phrase Qub];
                     inclusion]

let nosem_prep = [nosem_schema_field Backward [Phrase(Prep("",CaseAgr))]]
let nosem_uprep = [nosem_schema_field Backward [Phrase(Prep("",CaseUAgr))]]

let num_congr = [adjunct_schema_field "Quantifier" Backward [Phrase Null;Phrase(Num(AllAgr,Acm "congr"))]]
let num_rec = [adjunct_schema_field "Quantifier" Backward [Phrase(Num(AllAgr,Acm "rec"))]]
let noun_measure = [adjunct_schema_field "Quantifier" Backward [Phrase(Measure(AllUAgr))]]

(* Przykłady:  ironia losu, ścieżki anomalia, akcja w obronie słonia, na słoniu *)

let uni_weight = ref 0.
let uni_weight_step = 0.000001

let add_uni_weight weight =
  uni_weight := !uni_weight (*+. uni_weight_step*);
  weight +. !uni_weight

let make_node lemma cat id weight fnum l =
  let attrs,args = Xlist.fold  l ([],[]) (fun (attrs,args) -> function
    | "number" -> ("NUM",SubstVar "number") :: attrs, args
    | "case" -> ("CASE",SubstVar "case") :: attrs, args
    | "gen" -> ("CASE",Val "gen") :: attrs, args
    | "gender" -> ("GEND",SubstVar "gender") :: attrs, args
    | "person" -> ("PERS",SubstVar "person") :: attrs, args
    | "aspect" -> ("ASPECT", SubstVar "aspect") :: attrs, args
    | "ctype" -> ("TYPE", SubstVar "ctype") :: attrs, args
    | "lex" -> ("LEX",Val "+") :: attrs, args
    | "pres" -> ("TENSE", Val "pres") :: attrs, args
    | "fut" -> ("TENSE", Val "fut") :: attrs, args
    | "past" -> ("TENSE", Val "past") :: attrs, args
    | "indicative" -> ("MOOD", Val "indicative") :: attrs, args
    | "conditional" -> ("MOOD", Val "conditional") :: attrs, args
    | "imperative" -> ("MOOD", Val "imperative") :: attrs, args
    | "pronoun" -> ("SYN", Val "pronoun") :: attrs, args
    | "proper" -> ("SYN", Val "proper") :: attrs, args
    | "common" -> ("SYN", Val "common") :: attrs, args
    | "count" -> ("NSEM", Val "count") :: attrs, args
    | "mass" -> ("NSEM", Val "mass") :: attrs, args
    | "measure" -> ("NSEM", Val "measure") :: attrs, args
    | "time" -> ("NSEM", Val "time") :: attrs, args
    | "int" -> ("TYPE", Val "int") :: attrs, args
    | "rel" -> ("TYPE", Val "rel") :: attrs, args
    | "sub" -> ("TYPE", Val "sub") :: attrs, args
    | "coord" -> ("TYPE", Val "coord") :: attrs, args
    | "comp" -> ("TYPE", Val "comp") :: attrs, args
    | "indexical" -> attrs, args
    | "deictic" -> attrs, args
    | "coreferential" -> attrs, args
    | "order" -> attrs, args
    | "comparative" -> attrs, args
    | "pos" -> ("GRAD", Val "pos") :: attrs, args
    | "com" -> ("GRAD", Val "com") :: attrs, (Cut(Node{LCGrenderer.empty_node with pred="bardziej"; id=LCGrenderer.get_pro_id (); cat="adv"; agf=ADJUNCT; arole="Manner"; attrs=[(*"MEANING", Val "bardziej";*)"GRAD", Val "com"(*;"GF",Val "adjunct"*)]})) :: args (* FIXME: MEANING powinno być dodawane później *)
    | "sup" -> ("GRAD", Val "sup") :: attrs, (Cut(Node{LCGrenderer.empty_node with pred="najbardziej"; id=LCGrenderer.get_pro_id (); cat="adv"; agf=ADJUNCT; arole="Manner"; attrs=[(*"MEANING", Val "najbardziej";*)"GRAD", Val "sup"(*;"GF",Val "adjunct"*)]})) :: args (* FIXME: MEANING powinno być dodawane później *)
    | "aff" -> attrs, args
    | "negation" -> ("NEG",Val "+") :: attrs, args
    | "rec" -> ("ACM",Val "rec") :: attrs, args
    | "congr" -> ("ACM",Val "congr") :: attrs, args
    | "nosem" -> ("NOSEM",Val "+") :: attrs, args
    | "" -> attrs, args
    | s -> failwith ("make_node: " ^ s)) in
  let attrs = if fnum = 0 then attrs else ("FNUM",Val(string_of_int fnum)) :: attrs in
  {LCGrenderer.empty_node with pred=lemma; cat=cat; weight=weight; id=id; attrs=List.rev attrs;
     args=if args = [] then Dot else Tuple(List.rev args)}

let rec list_assoc2 x = function
    (s,a,b) :: l -> if x = s then a,b else list_assoc2 x l
  | [] -> raise Not_found

let lex_weight = 2.
let symbol_weight = 1.

(* FIXME: mowę niezależną należałoby ograniczyć do zewnętrznych argumentów. *)

let ge = LCGreductions.get_variant_label

let measure_weight = 0.5

let months = StringSet.of_list ["styczeń";"luty";"marzec";"kwiecień";"maj";"czerwiec";"lipiec";"sierpień";"wrzesień";"październik";"litopad";"grudzień"]
let objids = StringSet.of_list ["rysunek"]

(* FIXME: "Można było" - brakuje uzgodnienia rodzaju przymiotnika w przypadku predykatywnym, i ogólnie kontroli składniowej *)
let make_np numbers cases genders persons d lemma cat = (* FIXME: koreferencja siebie i się *)
  let numbers = expand_numbers numbers in
  let cases = expand_cases cases in
  let genders = expand_genders genders in (* FIXME: trzeba dodać konstrukcję w marcu 2000 i leksykalizowane nazwy własne przy miesiącach *)
  (if StringSet.mem objids lemma then
    Xlist.fold numbers [] (fun l -> function
      "sg" ->
              let quant = ["number",d.e.number,["sg"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "obj-id")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | "pl" -> l
    | _ -> failwith "make_np")
  else []) @
  (if lemma = "rok" then
    Xlist.fold numbers [] (fun l -> function
      "sg" ->
              let quant = ["number",d.e.number,["sg"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Both [Phrase(Lex "year")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | "pl" ->
              let quant = ["number",d.e.number,["pl"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "year-interval")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | _ -> failwith "make_np")
  else []) @
  (if lemma = "wiek" then (* FIXME: "Aranżuje w XIX w." się nie parsuje, niewłaściwa reprezentacja sem dla XIX *)
    Xlist.fold numbers [] (fun l -> function
      "sg" ->
              let quant = ["number",d.e.number,["sg"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Both [Phrase(Lex "roman")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | "pl" ->
              let quant = ["number",d.e.number,["pl"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "roman-interval")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | _ -> failwith "make_np")
  else []) @
  (if StringSet.mem months lemma then
    Xlist.fold numbers [] (fun l -> function
      "sg" ->
              let l = Xlist.fold cases l (fun l -> function
                  "gen" ->
                      let quant = ["number",d.e.number,["sg"];"case",d.e.case,["gen"];"gender",d.e.gender,genders; "person", d.e.person,persons] in
                      let t = ["month-lex"] in
                      let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
                      let schema_list = [[schema_field CORE "Possesive" Forward [Phrase Null; Phrase(Lex "year"); Phrase(NP(Case "gen"))]]] in
                      [LCGrenderer.make_frame quant schema_list t d batrs] @ l
                | _ -> l) in
              let quant = ["number",d.e.number,["sg"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Possesive" Forward [Phrase(Lex "year")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | "pl" -> l
    | _ -> failwith "make_np")
  else []) @
  (if lemma = "dzień" then
    Xlist.fold numbers [] (fun l -> function
      "sg" ->
              let l = Xlist.fold cases l (fun l -> function
                  "gen" ->
                      let quant = ["number",d.e.number,["sg"];"case",d.e.case,["gen"];"gender",d.e.gender,genders; "person", d.e.person,persons] in
                      let t = ["day-lex"] in
                      let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
                      let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "date");Phrase(Lex "day");Phrase(Lex "day-month")]]] in
                      [LCGrenderer.make_frame quant schema_list t d batrs] @ l
                | _ -> l) in
              let quant = ["number",d.e.number,["sg"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "date");Phrase(Lex "day");Phrase(Lex "day-month")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | "pl" ->
(*              let l = Xlist.fold cases l (fun l -> function
                  "gen" ->
                      let quant = ["number",d.e.number,["sg"];"case",d.e.case,["gen"];"gender",d.e.gender,genders; "person", d.e.person,persons] in
                      let t = ["day-lex"] in
                      let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
                      let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "date-interval");Phrase(Lex "day-interval");Phrase(Lex "day-month-interval")]]] in
                      [LCGrenderer.make_frame quant schema_list t d batrs] @ l
                | _ -> l) in*)
              let quant = ["number",d.e.number,["pl"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "date-interval");Phrase(Lex "day-interval");Phrase(Lex "day-month-interval")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | _ -> failwith "make_np")
  else []) @
  (if lemma = "godzina" then
    Xlist.fold numbers [] (fun l -> function
      "sg" ->
              let quant = ["number",d.e.number,["sg"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "hour");Phrase(Lex "hour-minute")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | "pl" ->
              let quant = ["number",d.e.number,["pl"];"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) 0 ["number"; "case"; "gender"; "person"] in
              let schema_list = [[schema_field CORE "Aposition" Forward [Phrase(Lex "hour-interval");Phrase(Lex "hour-minute-interval")]]] in
              [LCGrenderer.make_frame quant schema_list t d batrs] @ l
    | _ -> failwith "make_np")
  else []) @
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(NounAtrs(_,nsyn,nsem),schema) ->
        (try
          let numbers = check_frame_number2 numbers nsem in
          Xlist.fold (split_voc cases) l (fun l cases ->
            if nsem = Common "measure" then
              let persons = if cases = ["voc"] then ["sec"] else persons in
              let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let quant3 = ["number",d.e.number,numbers;"case",d.e.case,all_cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["measure"; "number"; "case"; "gender"; "person"] in
              let t3 = ["measure"; "sg"; "case"; "n2"; "person"] in (* UWAGA: number "sg" i gender "n2", żeby uzgadniać z podmiotem czasownika *)
              let batrs = make_node lemma cat d.id (d.weight +. measure_weight) fnum (nsyn :: (WalStringOf.nsem nsem) :: ["number"; "case"; "gender"; "person"]) in
              let batrs3 = make_node lemma cat d.id (d.weight +. measure_weight) fnum (nsyn :: (WalStringOf.nsem nsem) :: ["number"; "gen"; "gender"; "person"]) in
              let schema_list = [qub_inclusion;schema;num_congr] in
              let schema_list3 = [qub_inclusion;schema;num_rec] in
              (LCGrenderer.make_frame quant schema_list t d batrs) ::
              (if Xlist.mem cases "gen" then [LCGrenderer.make_frame quant3 schema_list3 t3 d batrs3] else []) @ l
            else
              let persons = if cases = ["voc"] then ["sec"] else persons in
              let quant = ["lemma",ge (),[];"number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let quant3 = ["lemma",ge (),[];"number",d.e.number,numbers;"case",d.e.case,all_cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let quant5 = ["lemma",ge (),[];"unumber",ge (),all_numbers;"ucase",ge (),all_cases;"ugender",ge (),all_genders; "uperson",ge (),all_persons;
                            "number",d.e.number,numbers;"case",d.e.case,all_cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
              let t = ["np"; "number"; "case"; "gender"; "person"] in
              let t2 = ["prepnp"; "lemma"; "case"] in
              let t3 = ["np"; "sg"; "case"; "n2"; "person"] in (* UWAGA: number "sg" i gender "n2", żeby uzgadniać z podmiotem czasownika *)
              let t5 = ["np"; "unumber"; "ucase"; "ugender"; "uperson"] in
              let t6 = ["prepnp"; "lemma"; "ucase"] in
              let batrs = make_node lemma cat d.id d.weight fnum (nsyn :: (WalStringOf.nsem nsem) :: ["number"; "case"; "gender"; "person"]) in
              let batrs2 = make_node lemma cat d.id d.weight fnum ("nosem" :: nsyn :: (WalStringOf.nsem nsem) :: ["number"; "case"; "gender"; "person"]) in
              let batrs3 = make_node lemma cat d.id d.weight fnum (nsyn :: (WalStringOf.nsem nsem) :: ["number"; "gen"; "gender"; "person"]) in
              let batrs4 = make_node lemma cat d.id d.weight fnum ("nosem" :: nsyn :: (WalStringOf.nsem nsem) :: ["number"; "gen"; "gender"; "person"]) in
              let schema_list = [qub_inclusion;schema;num_congr] in
              let schema_list2 = [qub_inclusion;schema;num_congr;nosem_prep] in
              let schema_list3 = [qub_inclusion;schema;num_rec] in
              let schema_list4 = [qub_inclusion;schema;num_rec;nosem_prep] in
              let schema_list5 = [qub_inclusion;schema;noun_measure] in
              let schema_list6 = [qub_inclusion;schema;noun_measure;nosem_uprep] in
              (LCGrenderer.make_frame quant schema_list t d batrs) ::
              (LCGrenderer.make_frame quant schema_list2 t2 d batrs2) ::
              (if Xlist.mem cases "gen" then [LCGrenderer.make_frame quant3 schema_list3 t3 d batrs3] else []) @
              (if Xlist.mem cases "gen" then [LCGrenderer.make_frame quant3 schema_list4 t2 d batrs4] else []) @
              (if Xlist.mem cases "gen" then [LCGrenderer.make_frame quant5 schema_list5 t5 d batrs3] else []) @
              (if Xlist.mem cases "gen" then [LCGrenderer.make_frame quant5 schema_list6 t6 d batrs4] else []) @ l)
        with Not_found -> l)
    | fnum,Frame(AdjAtrs(_,case,_),schema) ->
        (try
          let cases = check_frame_case cases case in
          let quant = ["lemma",ge (),[];"number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
          let quant3 = ["lemma",ge (),[];"number",d.e.number,numbers;"case",d.e.case,all_cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
          let t = ["np"; "number"; "case"; "gender"; "person"] in
          let t2 = ["prepnp"; "lemma"; "case"] in
          let t3 = ["np"; "sg"; "case"; "n2"; "person"] in (* UWAGA: number "sg" i gender "n2", żeby uzgadniać z podmiotem czasownika *)
          let batrs = make_node lemma cat d.id d.weight fnum ["number"; "case"; "gender"; "person"] in
          let batrs2 = make_node lemma cat d.id d.weight fnum ["nosem"; "number"; "case"; "gender"; "person"] in
          let batrs3 = make_node lemma cat d.id d.weight fnum ["number"; "gen"; "gender"; "person"] in
          let batrs4 = make_node lemma cat d.id d.weight fnum ["nosem"; "number"; "gen"; "gender"; "person"] in
          let schema_list = [qub_inclusion;schema;num_congr] in
          let schema_list2 = [qub_inclusion;schema;num_congr;nosem_prep] in
          let schema_list3 = [qub_inclusion;schema;num_rec] in
          let schema_list4 = [qub_inclusion;schema;num_rec;nosem_prep] in
          (LCGrenderer.make_frame quant schema_list t d batrs) ::
          (LCGrenderer.make_frame quant schema_list2 t2 d batrs2) ::
          (if Xlist.mem cases "gen" then [LCGrenderer.make_frame quant3 schema_list3 t3 d batrs3] else []) @
          (if Xlist.mem cases "gen" then [LCGrenderer.make_frame quant3 schema_list4 t2 d batrs4] else []) @  l
        with Not_found -> l)
    | fnum,LexFrame(id,SUBST(number,case),NoRestr,schema) ->
        (try
          let cases = check_frame_case cases case in
          let numbers = check_frame_number numbers number in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
          let t =  ["lex";id;lemma;"subst"; "number"; "case"; "gender"; "person"] in
          let batrs = make_node lemma cat d.id (lex_weight +. d.weight) fnum ["lex";"number"; "case"; "gender"; "person"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,LexFrame(_,ADJ _,_,_) -> l
    | fnum,frame -> failwith ("make_np: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_np_symbol d lemma cat =
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(NounAtrs(_,nsyn,nsem),schema) ->
              let t = [cat] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) fnum (nsyn :: (WalStringOf.nsem nsem) :: []) in
              let schema_list = [schema] in
              (LCGrenderer.make_frame [] schema_list t d batrs) :: l
    | fnum,frame -> failwith ("make_np_symbol: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_day d lemma cat =
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(NounAtrs(_,nsyn,nsem),[]) ->
              let t = [cat] in
              let batrs = make_node lemma cat d.id (symbol_weight +. d.weight) fnum (nsyn :: (WalStringOf.nsem nsem) :: []) in
              let schema_list = [[schema_field CORE "Possesive" Forward [Phrase(Lex "month-lex")]]] in
              (LCGrenderer.make_frame [] schema_list t d batrs) :: l
    | fnum,frame -> failwith ("make_day: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_nump numbers cases genders persons acm d lemma cat = (* FIXME: liczba po rzeczowniku *) (* FIXME: zbadać jak liczebniki współdziałąją z jako COMPAR *)
  let numbers = expand_numbers numbers in
  let cases = expand_cases cases in
  let genders = expand_genders genders in
  let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders;"person",d.e.person,persons] in
  Xlist.map acm (function
      "rec" ->
         let t = ["num"; "number"; "case"; "gender"; "person"; "rec"] in
         let batrs = make_node lemma cat d.id d.weight 0 ["rec"; "number"; "case"; "gender"; "person"] in
         let schema_list = [qub_inclusion] in (* FIXME: jak usunięcie Phrase ProNG wpływa na pokrycie? *)
         LCGrenderer.make_frame quant schema_list t d batrs
    | "congr" ->
         let t = ["num"; "number"; "case"; "gender"; "person"; "congr"] in
         let batrs = make_node lemma cat d.id d.weight 0 ["congr"; "number"; "case"; "gender"; "person"] in
         let schema_list = [qub_inclusion] in (* FIXME: jak usunięcie Phrase ProNG wpływa na pokrycie? *)
         LCGrenderer.make_frame quant schema_list t d batrs
    | _ -> failwith "process_interp: num acm") @
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,LexFrame(id,NUM(case,gender,acm2),NoRestr,schema) ->
        (try
          let cases = check_frame_case cases case in
          let genders = check_frame_gender genders gender in
          let acm = check_frame_acm acm acm2 in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons] in
          match acm with
            "rec" ->
               let t = ["lex";id;lemma;"num"; "number"; "case"; "gender"; "person"] in (* UWAGA: Number "sg" i Gender "n2", żeby uzgadniać z podmiotem czasownika *)
               let batrs = make_node lemma cat d.id (lex_weight +. d.weight) fnum ["rec";"lex"; "number"; "case"; "gender"; "person"] in
               let schema_list = [[inclusion];schema] in
               (LCGrenderer.make_frame quant schema_list t d batrs) :: l
          | "congr" ->
               let t = ["lex";id;lemma;"num"; "number"; "case"; "gender"; "person"] in
               let batrs = make_node lemma cat d.id (lex_weight +. d.weight) fnum ["congr";"lex"; "number"; "case"; "gender"; "person"] in
               let schema_list = [[inclusion];schema] in
               (LCGrenderer.make_frame quant schema_list t d batrs) :: l
          | _ -> failwith "process_interp: num acm"
        with Not_found -> l)
    | fnum,frame -> failwith ("make_num: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_compar d lemma =
  let quant = ["case",d.e.case,["nom";"gen";"dat";"acc";"inst"]] in
  let t = ["comparnp"; lemma; "case"] in
  let t2 = ["comparpp"; lemma] in
  let batrs = make_node lemma "prep" d.id d.weight 0 ["case"] in
  let batrs2 = make_node lemma "prep" d.id d.weight 0 [] in
  let schema_list = [qub_inclusion;[adjunct_schema_field "Manner" Backward [Phrase Null;Phrase AdvP];prep_arg_schema_field [Phrase (NP(CaseAgr))]]] in
  let schema_list2 = [qub_inclusion;[adjunct_schema_field "Manner" Backward [Phrase Null;Phrase AdvP];prep_arg_schema_field [Phrase (PrepNP(Sem,"",CaseUndef));Phrase (PrepNumP(Sem,"",CaseUndef));Phrase (PrepAdjP(Sem,"",CaseUndef));Phrase (ComprepNP(Sem,""))]]] in
  [LCGrenderer.make_frame quant schema_list t d batrs;
   LCGrenderer.make_frame [] schema_list2 t2 d batrs2]

let make_arg_prepp cases d lemma pcat phrase =
  let quant = ["case",d.e.case,expand_cases cases] in
  let t = [pcat; lemma; "case"] in
  let batrs = make_node lemma "prep" d.id d.weight 0 ["case"] in
  let schema_list = [qub_inclusion;[adjunct_schema_field "Manner" Backward [Phrase Null;Phrase AdvP];prep_arg_schema_field [Phrase phrase]]] in
  LCGrenderer.make_frame quant schema_list t d batrs

let make_prepnp cases d lemma = make_arg_prepp cases d lemma "prepnp" (NP(CaseAgr))
let make_prepnump cases d lemma = make_arg_prepp cases d lemma "prepnp" (NumP(CaseAgr))
let make_prepadjp cases d lemma =
  let cases = if lemma = "po" then "postp" :: cases else cases in
  make_arg_prepp cases d lemma "prepadjp" (AdjP(CaseAgr))

let make_prepp cases d lemma =
  let quant = ["case",d.e.case,expand_cases cases] in
  let t = ["prepp"; "case"] in
  let batrs = make_node lemma "prep" d.id d.weight 0 ["case"] in
  let schema_list = [qub_inclusion;[adjunct_schema_field "Manner" Backward [Phrase Null;Phrase AdvP];prep_arg_schema_field2 [Phrase (NP(CaseAgr));Phrase (NumP(CaseAgr));Phrase (AdjP(CaseAgr))]]] in
  LCGrenderer.make_frame quant schema_list t d batrs

let make_prep cases d lemma =
  let quant = ["case",d.e.case,expand_cases cases] in
  let t = ["prep"; lemma; "case"] in
  let batrs = make_node lemma "prep" d.id d.weight 0 ["case"] in
  let schema_list = [qub_inclusion] in
  LCGrenderer.make_frame quant schema_list t d batrs

let make_time_prep2 case d lemma l =
  let quant = ["case",d.e.case,[case]] in
  let t = ["prepnp"; lemma; "case"] in
  let batrs = make_node lemma "prep" d.id d.weight 0 ["case"] in
  let schema_list = [qub_inclusion;[prep_arg_schema_field (Xlist.map l (fun s -> Phrase(Lex s)))]] in
  LCGrenderer.make_frame quant schema_list t d batrs

let make_time_prep cases d lemma =
  Xlist.fold cases [] (fun l case ->
    match lemma,case with
      "z","gen" -> [make_time_prep2 case d lemma ["day-month";"day";"year";"date";"hour";"hour-minute"]] @ l
   |  "do","gen" -> [make_time_prep2 case d lemma ["day-month";"day";"year";"date";"hour";"hour-minute"]] @ l
   |  "na","acc" -> [make_time_prep2 case d lemma ["day-month";"day";"hour";"hour-minute"]] @ l
   |  "o","loc" -> [make_time_prep2 case d lemma ["hour";"hour-minute"]] @ l
   |  "od","gen" -> [make_time_prep2 case d lemma ["day-month";"day";"year";"date";"hour";"hour-minute"]] @ l
   |  "około","gen" -> [make_time_prep2 case d lemma ["day-month";"day";"year";"hour";"hour-minute"]] @ l
   |  "po","loc" -> [make_time_prep2 case d lemma ["day-month";"day";"year";"date";"hour";"hour-minute"]] @ l
   |  "przed","inst" -> [make_time_prep2 case d lemma ["day-month";"day";"year";"date";"hour";"hour-minute"]] @ l
   |  "w","loc" -> [make_time_prep2 case d lemma ["year"]] @ l
   | _ -> l)

let make_lex_prep cases d lemma =
  let cases = expand_cases cases in
  Xlist.fold d.simple_valence [] (fun l -> function
    | fnum,LexFrame(id,PREP case,NoRestr,schema) ->
        (try
          let cases = check_frame_case cases case in
          let quant = ["case",d.e.case,cases] in
          let t =  ["lex";id;lemma;"prep"; "case"] in
          let batrs = make_node lemma "prep" d.id (lex_weight +. d.weight) fnum ["lex";"case"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,ComprepFrame(new_lemma,PREP case,NoRestr,schema) ->
        (try
          let cases = check_frame_case cases case in
          let quant = ["case",d.e.case,cases] in
          let t = ["comprepnp"; new_lemma] in
          let batrs = make_node new_lemma "prep" d.id (lex_weight +. d.weight) fnum [] in
          let schema_list = [[inclusion];schema] in
          let l = (LCGrenderer.make_frame quant schema_list t d batrs) :: l in
          let t = ["prepp"; "case"] in
          let batrs = make_node new_lemma "prep" d.id (lex_weight +. d.weight) fnum ["case"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_lex_prep: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_adjp numbers cases genders grads d lemma cat = (* FIXME: usunąć niektóre opcje dla roman i ordnum *)
  let numbers = expand_numbers numbers in
  let cases = expand_cases cases in
  let cases = if Xlist.mem cases "nom" then "pred" :: cases else cases in
  let genders = expand_genders genders in
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(AdjAtrs(_,case,adjsyn),schema) ->
        (try
          let cases = check_frame_case cases case in
          let grad = match grads with [grad] -> grad | _ -> failwith "make_adjp: grad" in
          let quant = ["lemma",ge (),[];"number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders] in
          let t = ["adjp"; "number"; "case"; "gender"] in
          let t2 = ["prepadjp"; "lemma"; "case"] in
          let batrs = make_node lemma cat d.id d.weight fnum (adjsyn :: grad :: ["number"; "case"; "gender"]) in
          let batrs2 = make_node lemma cat d.id d.weight fnum ("nosem" :: adjsyn :: grad :: ["number"; "case"; "gender"]) in
          let schema_list = [if adjsyn = "pronoun" then [] else [adjunct_schema_field "Aposition" Backward [Phrase Null;Phrase Adja]];qub_inclusion;schema] in
          let schema_list2 = [if adjsyn = "pronoun" then [] else [adjunct_schema_field "Aposition" Backward [Phrase Null;Phrase Adja]];qub_inclusion;schema;nosem_prep] in
          (LCGrenderer.make_frame quant schema_list t d batrs) ::
          (LCGrenderer.make_frame quant schema_list2 t2 d batrs2) :: l
        with Not_found -> l)
    | fnum,Frame(NounAtrs(_,nsyn,nsem),schema) ->
        (try
          let grad = match grads with [grad] -> grad | _ -> failwith "make_adjp: grad" in
          let quant = ["lemma",ge (),[];"number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders] in
          let t = ["adjp"; "number"; "case"; "gender"] in
          let batrs = make_node lemma cat d.id d.weight fnum (nsyn :: (WalStringOf.nsem nsem) :: grad :: ["number"; "case"; "gender"]) in
          let schema_list = [if nsyn = "pronoun" then [] else [adjunct_schema_field "Aposition" Backward [Phrase Null;Phrase Adja]];qub_inclusion;schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,LexFrame(id,ADJ(number,case,gender,grad),NoRestr,schema) ->
        (try
          let cases = check_frame_case cases case in
          let numbers = check_frame_number numbers number in
          let genders = check_frame_gender genders gender in
          let grads = check_frame_grad grads grad in
          let grad = match grads with [grad] -> grad | _ -> failwith "make_adjp: grad" in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders] in
          let t =  ["lex";id;lemma;"adj"; "number"; "case"; "gender"] in
          let batrs = make_node lemma cat d.id (lex_weight +. d.weight) fnum [grad;"lex"; "number"; "case"; "gender"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_adjp: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let adv_relators = Xlist.fold [
  "jak","Attr",[Int;Rel];
  "skąd","abl",[Int;Rel];
  "dokąd","adl",[Int;Rel];
  "gdzie","locat",[Int;Rel];
  "którędy","perl",[Int;Rel];
  "kiedy","temp",[Int;Rel];
  "odkąd","temp",[Int];
  "dlaczego","caus",[Int];
  "czemu","caus",[Int];
  "gdy","con",[Sub];
  ] StringMap.empty (fun map (k,v,l) -> StringMap.add map k (v,l))

let make_advp grads (d:PreTypes.token_record) lemma =
  (if StringMap.mem adv_relators lemma then
        let role,ctypes = StringMap.find adv_relators lemma in
        List.flatten (Xlist.map ctypes (fun ctype ->
          let ctype = WalStringOf.comp_type ctype in
          let quant = ["inumber",ge (),[];"igender",ge (),[];"iperson",ge (),[];"ctype",ge (),[ctype]] in
          let t = ["cp"; "ctype"; lemma] in
          let sem_mods = ["CTYPE",SubstVar "ctype"] in
          let batrs = make_node lemma "adv" d.id d.weight 0 [ctype] in
          let raised_arg1 = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["advp"])] in
	let schema_list = [if lemma = "jak" then [num_arg_schema_field [Phrase Null;(*Phrase ProNG;*) Phrase AdvP]] else [];[schema_field RAISED "" Forward raised_arg1]] in (* FIXME: dwa znaczenia jak: pytanie o cechę lub spójnik *)
          let frame_advp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          [frame_advp])) else []) @
  Xlist.fold d.simple_valence [] (fun l -> function (* FIXME: sprawdzic czy adv_relators maja leksykalizacje i schematy *)
      fnum,Frame(EmptyAtrs _,schema) ->
        (try
          let grad = match grads with [grad] -> grad | _ -> failwith "make_advp: grad" in
          let quant = [] in
          let t = ["advp"] in
          let batrs = make_node lemma "adv" d.id d.weight fnum [grad] in
          let schema_list = [[adjunct_schema_field "Aposition" Backward [Phrase Null;Phrase Adja]];qub_inclusion;schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,LexFrame(id,ADV grad,NoRestr,schema) ->
        (try
          let grads = check_frame_grad grads grad in
          let grad = match grads with [grad] -> grad | _ -> failwith "make_adjp: grad" in
          let quant = [] in
          let t =  ["lex";id;lemma;"adv"] in
          let batrs = make_node lemma "adv" d.id (lex_weight +. d.weight) fnum [grad;"lex"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,ComprepFrame(new_lemma,ADV grad,NoRestr,schema) ->
        (try
          let _ = check_frame_grad grads grad in
          let quant = [] in
          let t = ["comprepnp"; new_lemma] in
          let batrs = make_node new_lemma "adv" d.id (lex_weight +. d.weight) fnum [] in
          let schema_list = [[inclusion];schema] in
          let l = (LCGrenderer.make_frame quant schema_list t d batrs) :: l in (* FIXME: nieprzetestowane *)
          let t = ["prepp"; "gen"] in (* FIXME: przypadek nie jest znany *)
          let batrs = make_node new_lemma "adv" d.id (lex_weight +. d.weight) fnum [] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_advp: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_ger numbers cases genders persons aspects negations d lemma cat =
  let numbers = expand_numbers numbers in
  let cases = expand_cases cases in
  let genders = expand_genders genders in
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(GerAtrs(_,new_lemma,negation,aspect),schema) ->
        (try
          let aspects = check_frame_aspect aspects aspect in
          let negation = check_frame_negation negations negation in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons; "aspect",d.e.aspect,aspects] in
          let t = ["np"; "number"; "case"; "gender"; "person"] in
          let batrs = make_node new_lemma cat d.id d.weight fnum [negation;"aspect";"number"; "case"; "gender"; "person"] in
          let schema_list = [qub_inclusion;schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,LexFrame(id,GER(number,case,gender,aspect,negation,ReflEmpty),NoRestr,schema) ->
        (try
          let cases = check_frame_case cases case in
          let genders = check_frame_gender genders gender in
          let numbers = check_frame_number numbers number in
          let aspects = check_frame_aspect aspects aspect in
          let negation = check_frame_negation negations negation in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "person", d.e.person,persons; "aspect",d.e.aspect,aspects] in
          let t =  ["lex";id;lemma;"ger"; "number"; "case"; "gender"; "person"] in
          let batrs = make_node lemma cat d.id (lex_weight +. d.weight) fnum [negation;"aspect";"lex"; "number"; "case"; "gender"; "person"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_ger: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_padj numbers cases genders aspects negations d lemma cat =
  let numbers = expand_numbers numbers in
  let cases = expand_cases cases in
  let cases = if Xlist.mem cases "nom" || cat = "ppas" then "pred" :: cases else cases in
  let genders = expand_genders genders in
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(NonPersAtrs(_,new_lemma,role,role_attr,negation,aspect),schema) ->
        (try
          let aspects = check_frame_aspect aspects aspect in
          let negation = check_frame_negation negations negation in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "aspect",d.e.aspect,aspects] in
          let t = ["adjp"; "number"; "case"; "gender"] in
          let batrs = make_node new_lemma cat d.id d.weight fnum [negation;"aspect";"number"; "case"; "gender"] in
          let schema_list = [qub_inclusion;schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,LexFrame(id,PACT(number,case,gender,aspect,negation,ReflEmpty),NoRestr,schema) ->
        (try
          let aspects = check_frame_aspect aspects aspect in
          let negation = check_frame_negation negations negation in
          let cases = check_frame_case cases case in
          let numbers = check_frame_number numbers number in
          let genders = check_frame_gender genders gender in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "aspect",d.e.aspect,aspects] in
          let t =  ["lex";id;lemma;"pact"; "number"; "case"; "gender"] in
          let batrs = make_node lemma cat d.id (lex_weight +. d.weight) fnum [negation;"lex";"aspect"; "number"; "case"; "gender"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,LexFrame(id,PPAS(number,case,gender,aspect,negation),NoRestr,schema) ->
        (try
          let aspects = check_frame_aspect aspects aspect in
          let negation = check_frame_negation negations negation in
          let cases = check_frame_case cases case in
          let numbers = check_frame_number numbers number in
          let genders = check_frame_gender genders gender in
          let quant = ["number",d.e.number,numbers;"case",d.e.case,cases;"gender",d.e.gender,genders; "aspect",d.e.aspect,aspects] in
          let t =  ["lex";id;lemma;"ppas"; "number"; "case"; "gender"] in
          let batrs = make_node lemma cat d.id (lex_weight +. d.weight) fnum [negation;"lex";"aspect"; "number"; "case"; "gender"] in
          let schema_list = [[inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_padj: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let int_arg = [arg_schema_field Forward [Phrase(Null);Phrase(Lex "int")]]

let make_ip numbers genders persons aspects aglt aux2 d lemma cat =
  let numbers = expand_numbers numbers in
  let genders = expand_genders genders in
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(PersAtrs(_,new_lemma,negation,mood,tense,aux,aspect),schema) ->
        (try
          if aux2 = true && aux = NoAux then raise Not_found else
          if aux2 = false && aux <> NoAux then raise Not_found else
          let aspects = check_frame_aspect aspects aspect in
          let quant = ["number",d.e.number,numbers;"gender",d.e.gender,genders; "person", d.e.person,persons; "aspect",d.e.aspect,aspects] in
          let t = ["ip"; "number"; "gender"; "person"] in
          let batrs = make_node new_lemma cat d.id d.weight fnum ([mood;tense;"aspect"; "number"; "gender"; "person"] @ if negation = Aff then [] else ["negation"]) in
          let cond_arg = match mood with "conditional" -> [nosem_schema_field Both [Phrase(Lex "by")]] | "" -> failwith "make_ip" | _ -> [] in
          let aglt_arg = if aglt then [nosem_schema_field Both [Phrase Aglt]] else [] in
          let aux_arg = match aux with PastAux -> [nosem_schema_field Both [Phrase AuxPast]] | FutAux -> [nosem_schema_field Both [Phrase AuxFut]] | ImpAux -> [nosem_schema_field Both [Phrase AuxImp]] | NoAux -> [] in
          let schema_list = [if negation = Aff then [] else [nosem_schema_field Backward [Phrase(Lex "nie")]];
                             qub_inclusion;
                             aglt_arg @ aux_arg @ cond_arg @ schema @ int_arg] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_ip 1: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))


let make_infp aspects d lemma =
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(NonPersAtrs(_,new_lemma,role,role_attr,negation,aspect),schema) ->
        (try
          let aspects = check_frame_aspect aspects aspect in
          let quant = ["aspect",d.e.aspect,aspects] in
          let t = ["infp"; "aspect"] in
          let batrs = make_node new_lemma "inf" d.id d.weight fnum (["aspect"] @ if negation = Aff then [] else ["negation"]) in
          let schema_list = [if negation = Aff then [] else [nosem_schema_field Backward [Phrase(Lex "nie")]];
                             qub_inclusion;schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,LexFrame(id,INF(aspect,negation,refl),NoRestr,schema) ->
        (try
          let aspects = check_frame_aspect aspects aspect in
          let quant = ["aspect",d.e.aspect,aspects] in
          let t =  ["lex";id;lemma;"inf"; "aspect"] in
          let new_lemma,schema = if refl = ReflEmpty then lemma, schema else lemma ^ " się", nosem_refl_schema_field :: schema in
          let batrs = make_node new_lemma "inf" d.id (lex_weight +. d.weight) fnum (["lex";"aspect"] @ if negation = Aff then [] else ["negation"]) in
          let schema_list = [if negation = Aff then [] else [nosem_schema_field Backward [Phrase(Lex "nie")]];
                             [inclusion];schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_infp: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_padvp aspects d lemma cat =
  Xlist.fold d.simple_valence [] (fun l -> function
      fnum,Frame(NonPersAtrs(_,new_lemma,role,role_attr,negation,aspect),schema) ->
        (try
          let aspects = check_frame_aspect aspects aspect in
          let quant = ["aspect",d.e.aspect,aspects] in
          let t = ["padvp"] in
          let batrs = make_node new_lemma cat d.id d.weight fnum (["aspect"] @ if negation = Aff then [] else ["negation"]) in
          let schema_list = [if negation = Aff then [] else [nosem_schema_field Backward [Phrase(Lex "nie")]];
                             qub_inclusion;schema] in
          (LCGrenderer.make_frame quant schema_list t d batrs) :: l
        with Not_found -> l)
    | fnum,frame -> failwith ("make_padvp: " ^ lemma ^ ": " ^ WalStringOf.frame lemma frame))

let make_conjunct (d:PreTypes.token_record) lemma cat =   (* FIXME: poprawić semantykę *)
          let ctype = if cat = "comp" then "sub" else if cat = "conj" then "coord" else failwith "make_conjunct" in
          let quant = [] in
          let t = ["cp"; ctype; lemma] in
          let batrs = make_node lemma cat d.id d.weight 0 [ctype] in
          let schema_list = [[comp_arg_schema_field [Phrase IP]]] in
          [LCGrenderer.make_frame quant schema_list t d batrs]

(* FIXME: uzgadniania HIPERO i SELPREFS *)
let make_conj f d lemma =
  (if f then
   [LCGrenderer.make_conj_frame
     ["number",d.e.number,all_numbers;"gender",d.e.gender,all_genders;"person",d.e.person,all_persons]
     (Tensor[Atom "ip"; Top; Top; Top]) (Tensor[Atom "ip"; Top; Top; Top])
     ["ip";"number";"gender";"person"] d
     (make_node lemma "conj" d.id d.weight 0 ["number";"gender";"person"])] else []) @
  [LCGrenderer.make_conj_frame []
     (Tensor[Atom "prepnp"; Top; Top]) (Tensor[Atom "prepnp"; Top; Top]) ["advp"] d
     (make_node lemma "conj" d.id d.weight 0 []);
   LCGrenderer.make_conj_frame []
     (Tensor[Atom "advp"]) (Tensor[Atom "prepnp"; Top; Top]) ["advp"] d
     (make_node lemma "conj" d.id d.weight 0 []);
   LCGrenderer.make_conj_frame []
     (Tensor[Atom "prepnp"; Top; Top]) (Tensor[Atom "advp"]) ["advp"] d
     (make_node lemma "conj" d.id d.weight 0 []);
   LCGrenderer.make_conj_frame []
     (Tensor[Atom "advp"]) (Tensor[Atom "advp"]) ["advp"] d
     (make_node lemma "conj" d.id d.weight 0 []);
   LCGrenderer.make_conj_frame ["lemma",ge (),[];"case",d.e.case,all_cases]
     (Tensor[Atom "prepnp";AVar "lemma"; AVar "case"]) (Tensor[Atom "prepnp"; AVar "lemma"; AVar "case"])
     ["prepnp";"lemma";"case"] d
     (make_node lemma "conj" d.id d.weight 0 ["case"]);
   LCGrenderer.make_conj_frame
     ["number",d.e.number,all_numbers;"case",d.e.case,all_cases;"gender",d.e.gender,all_genders;"person",d.e.person,all_persons]
     (Tensor[Atom "np"; Top; AVar "case"; Top; Top]) (Tensor[Atom "np"; Top; AVar "case"; Top; Top])
     ["np"; "number"; "case"; "gender"; "person"] d
     (make_node lemma "conj" d.id d.weight 0 ["number";"case";"gender";"person"]);
   LCGrenderer.make_conj_frame
     ["number",d.e.number,all_numbers;"case",d.e.case,all_cases;"gender",d.e.gender,all_genders]
     (Tensor[Atom "adjp"; AVar "number"; AVar "case"; AVar "gender"]) (Tensor[Atom "adjp"; AVar "number"; AVar "case"; AVar "gender"])
     ["adjp";"number";"case";"gender"] d
     (make_node lemma "conj" d.id d.weight 0 ["number";"case";"gender"]);
   ]

(* FIXME: aktualnie NP nie obejmują przymiotników, trzeba albo dodać podrzędniki przymiotnikowe, albo kategorię np dla przymiotników *)
(* FIXME: nadmiarowe interpretacje dla num np. dodana jest opcja z pro i apozycją *)
(* FIXME: zrobić kontolę w znaczeniu dziedziczenia podmiotu *)
(* FIXME: poprawić walencję z negacją, problem z zanegowanymi ramami dla ger i ppas *)
(* FIXME: sprawdzić czy są ramy z NegationUndef i NegationNA *)
(* FIXME: obniżyć wagi przyimków i kublików pisanych z wielkiej litery podobnie przy skrótach *)

let rec process_interp (d:PreTypes.token_record) = function (* FIXME: rozpoznawanie lematów nie działa, gdy mają wielką literę *)
    lemma,"subst",[numbers;cases;genders] ->
      (if lemma = "co" || lemma  = "kto" then (* FIXME: dodać podrzędniki np. co nowego *)
        List.flatten (Xlist.map ["int";"rel"] (fun ctype ->
          let quant = ["inumber",ge (),[];"igender",ge (),[];"iperson",ge (),[];"plemma",ge (),[];"ctype",ge (),[ctype];"number",d.e.number,expand_numbers numbers;"case",d.e.case,expand_cases cases;"gender",d.e.gender,expand_genders genders; "person",d.e.person,["ter"]] in
          let t = ["cp"; "ctype"; lemma] in
          let sem_mods = ["CTYPE",SubstVar "ctype"] in (* atrybuty ip *)
          let batrs = make_node lemma "subst" d.id d.weight 0 [ctype;"case"] in (* atrybuty liścia *)
          let raised_arg = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["np";"number";"case";"gender";"person"])] in
          let raised_arg1 = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["prepnp";"plemma";"case"])] in
          let raised_arg2 = [Raised(["prepnp";"plemma";"case"],Forward,["np";"number";"case";"gender";"person"])] in
          let raised_arg3 = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["comprepnp";"plemma"])] in
          let raised_arg4 = [Raised(["comprepnp";"plemma"],Forward,["np";"number";"case";"gender";"person"])] in
          let schema_list = [[schema_field RAISED "" Forward raised_arg]] in
          let frame_np = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[schema_field RAISED "" Backward raised_arg2];[schema_field RAISED "" Forward raised_arg1]] in
          let frame_prepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[schema_field RAISED "" Backward raised_arg4];[schema_field RAISED "" Forward raised_arg3]] in
          let frame_comprepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          [frame_np;frame_prepnp;frame_comprepnp])) else []) @
      (if lemma = "to" then (* FIXME: przetestować *)
          let quant = ["ctype",ge (),[];"lemma",ge (),[];"number",d.e.number,expand_numbers numbers;"case",d.e.case,expand_cases cases;"gender",d.e.gender,expand_genders genders; "person",d.e.person,["ter"]] in
          let t = ["ncp"; "number"; "case"; "gender"; "person"; "ctype"; "lemma"] in
          let batrs = make_node "to" "subst" d.id d.weight 0 ["coreferential"; "number"; "case"; "gender"; "person"; "ctype"] in
          let schema_list = [qub_inclusion;[prep_arg_schema_field [Phrase(CP(CompTypeAgr,Comp "lemma"))]]] in
          [LCGrenderer.make_frame quant schema_list t d batrs]
      else []) @
      make_np numbers cases genders ["ter"] d lemma "subst"
  | lemma,"depr",[numbers;cases;genders] -> (* FIXME: sprawdzić uzgodnienie rodzaju dla depr w podmiocie *)
      make_np numbers cases genders ["ter"] d lemma "depr"
  | lemma,"ppron12",[numbers;cases;genders;persons] ->
      make_np numbers cases genders persons d lemma "ppron12"
  | lemma,"ppron12",[numbers;cases;genders;persons;akcs] ->
      make_np numbers cases genders persons d lemma "ppron12"
  | lemma,"ppron3",[numbers;cases;genders;persons] ->
      make_np numbers cases genders persons d lemma "ppron3"
  | lemma,"ppron3",[numbers;cases;genders;persons;akcs] ->
      make_np numbers cases genders persons d lemma "ppron3"
  | lemma,"ppron3",[numbers;cases;genders;persons;akcs;praep] ->
      List.flatten (Xlist.map praep (function
        "npraep" -> make_np numbers cases genders persons d lemma "ppron3"
     | "_" -> make_np numbers cases genders persons d lemma "ppron3"
     | "praep" ->
          let quant = ["lemma",ge (),[]; "number",d.e.number,expand_numbers numbers;"case",d.e.case,expand_cases cases;"gender",d.e.gender,expand_genders genders; "person",d.e.person,persons] in
          let t = ["prepnp"; "lemma"; "case"] in
          Xlist.fold d.simple_valence [] (fun l -> function
              fnum,Frame(NounAtrs(_,nsyn,nsem),schema) ->
                let batrs = make_node lemma "ppron3" d.id d.weight fnum (nsyn ::(WalStringOf.nsem nsem) :: ["number";"case";"gender";"person"]) in
                let raised_arg = [Raised(["prepnp";"lemma";"case"],Forward,["np";"number";"case";"gender";"person"])] in
                let schema_list = [[schema_field RAISED "" Backward raised_arg];[inclusion]] in
                (LCGrenderer.make_frame quant schema_list t d batrs) :: l
            | _ -> failwith "process_interp: ppron3 praep")
     | _ -> failwith "process_interp: ppron3 praep"))
  | lemma,"siebie",[cases] -> (* FIXME: rozwiązać koreferencję *)
      make_np ["_"] cases ["_"] ["ter"] d lemma "siebie"
  | lemma,"prep",[cases;woks] ->  (* FIXME: pomijam niesemantyczny compar *)
      if lemma = "jak" || lemma = "jako" || lemma = "niż" || lemma = "niczym" || lemma = "niby" || lemma = "co" then [make_prep all_cases d lemma] @ make_compar d lemma else
      [make_prepnp cases d lemma;
       make_prepnump cases d lemma;
       make_prepadjp cases d lemma;
       make_prep cases d lemma] @
      make_lex_prep cases d lemma @
      make_time_prep cases d lemma
  | lemma,"prep",[cases] ->
      if lemma = "jak" || lemma = "jako" || lemma = "niż" || lemma = "niczym" || lemma = "niby" || lemma = "co" then [make_prep all_cases d lemma] @ make_compar d lemma else
      [make_prepnp cases d lemma;
       make_prepnump cases d lemma;
       make_prepadjp cases d lemma;
       make_prep cases d lemma] @
      make_lex_prep cases d lemma @
      make_time_prep cases d lemma
(*  | lemma,"NUM",[["comp"]] -> failwith "num:comp"*)
  | lemma,"num",[numbers;cases;genders;acm] -> (* FIXME: liczebniki złożone *)
      (if lemma = "ile" then (* FIXME: walencja ile *)
        List.flatten (Xlist.map ["int";"rel"] (fun ctype ->
        List.flatten (Xlist.map acm (fun acm ->
          let phrase,num,gend = match acm with "congr" -> NP AllAgr,"number","gender" | "rec" -> NP GenAgr,"sg","n2" | _ -> failwith "process_interp: num acm" in
          let quant = ["inumber",ge (),[];"igender",ge (),[];"iperson",ge (),[];"plemma",ge (),[];"ctype",ge (),[ctype];"number",d.e.number,expand_numbers numbers;"case",d.e.case,expand_cases cases;"gender",d.e.gender,expand_genders genders;"person",d.e.person,["ter"]] in
          let t = ["cp"; "ctype"; lemma] in
          let sem_mods = ["CTYPE",SubstVar "ctype"] in
          let batrs = make_node lemma "num" d.id d.weight 0 [ctype;acm;"number";"case";"gender";"person"] in
          let raised_arg1 = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["nump";num;"case";gend;"person"])] in
          let raised_arg2a = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["prepnp";"plemma";"case"])] in
          let raised_arg2b = [Raised(["prepnp";"plemma";"case"],Forward,["nump";num;"case";gend;"person"])] in
          let raised_arg3a = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["comprepnp";"plemma"])] in
          let raised_arg3b = [Raised(["comprepnp";"plemma"],Forward,["nump";num;"case";gend;"person"])] in
          let schema_list = [[num_arg_schema_field [Phrase ProNG; Phrase phrase]];[schema_field RAISED "" Forward raised_arg1]] in
          let frame_nump = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[num_arg_schema_field [Phrase ProNG; Phrase phrase]];[schema_field RAISED "" Backward raised_arg2b];[schema_field RAISED "" Forward raised_arg2a]] in
          let frame_prepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[num_arg_schema_field [Phrase ProNG; Phrase phrase]];[schema_field RAISED "" Backward raised_arg3b];[schema_field RAISED "" Forward raised_arg3a]] in
          let frame_comprepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          [frame_nump;frame_prepnp;frame_comprepnp])))) else []) @
      make_nump numbers cases genders ["ter"] acm d lemma "num"
  | _,"numc",[] -> []
  | lemma,"intnum",[] ->
      let batrs = make_node lemma "intnum" d.id d.weight 0 [] in
      let numbers,acms =
        if lemma = "1" || lemma = "-1" then ["sg"],["congr"] else
        let s = String.get lemma (String.length lemma - 1) in
        ["pl"],if s = '2' || s = '3' || s = '4' then ["rec";"congr"] else ["rec"] in
      [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase(Lex "hyphen")]]] ["adja"] d batrs] @
      make_nump numbers ["_"] ["_"] ["ter"] acms d lemma "intnum" (* FIXME: specjalne traktowanie 1 i poza tym liczba mnoga *)
  | lemma,"realnum",[] ->
      let batrs = make_node lemma "realnum" d.id d.weight 0 [] in
      [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase(Lex "hyphen")]]] ["adja"] d batrs] @
      make_nump ["sg"] ["_"] ["_"] ["ter"] ["rec"] d lemma "realnum"
  | lemma,"intnum-interval",[] ->
      let batrs = make_node lemma "intnum-interval" d.id d.weight 0 [] in
      [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase(Lex "hyphen")]]] ["adja"] d batrs] @
      make_nump ["pl"] ["_"] ["_"] ["ter"] ["rec";"congr"] d lemma "intnum-interval"
  | lemma,"realnum-interval",[] ->
      let batrs = make_node lemma "realnum-interval" d.id d.weight 0 [] in
      [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase(Lex "hyphen")]]] ["adja"] d batrs] @
      make_nump ["sg"] ["_"] ["_"] ["ter"] ["rec"] d lemma "realnum-interval"
  | lemma,"symbol",[] ->
      make_np ["sg"] ["_"] ["_"] ["ter"] d lemma "symbol"
  | lemma,"ordnum",[] ->
      make_adjp ["_"] ["_"] ["_"] ["pos"] d lemma "ordnum"
  | lemma,"date",[] -> make_np_symbol d lemma "date"
  | lemma,"date-interval",[] -> make_np_symbol d lemma "date-interval"
  | lemma,"hour-minute",[] -> make_np_symbol d lemma "hour-minute"
  | lemma,"hour",[] -> make_np_symbol d lemma "hour"
  | lemma,"hour-minute-interval",[] -> make_np_symbol d lemma "hour-minute-interval"
  | lemma,"hour-interval",[] -> make_np_symbol d lemma "hour-interval"
  | lemma,"year",[] -> make_np_symbol d lemma "year"
  | lemma,"year-interval",[] -> make_np_symbol d lemma "year-interval"
  | lemma,"day",[] -> make_day d lemma "day"
  | lemma,"day-interval",[] -> make_day d lemma "day-interval"
  | lemma,"day-month",[] -> make_np_symbol d lemma "day-month"
  | lemma,"day-month-interval",[] -> make_np_symbol d lemma "day-month-interval"
  | lemma,"month-interval",[] -> make_np_symbol d lemma "month-interval"
  | lemma,"roman",[] -> (* "Aranżuje XIX struś." *)
      let batrs = make_node lemma "roman" d.id d.weight 0 [] in
      [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase(Lex "hyphen")]]] ["adja"] d batrs] @
      (make_np_symbol d lemma "roman") @
      (make_adjp ["_"] ["_"] ["_"] ["pos"] d lemma "roman-adj")
  | lemma,"roman-interval",[] ->
      let batrs = make_node lemma "roman-interval" d.id d.weight 0 [] in
      [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase(Lex "hyphen")]]] ["adja"] d batrs] @
      (make_np_symbol d lemma "roman-interval")
  | lemma,"match-result",[] -> make_np_symbol d lemma "match-result"
  | lemma,"url",[] -> make_np_symbol d lemma "url"
  | lemma,"email",[] -> make_np_symbol d lemma "email"
  | lemma,"obj-id",[] -> make_np_symbol d lemma "obj-id"
  | lemma,"adj",[numbers;cases;genders;grads] ->
      (if lemma = "czyj" || lemma = "jaki" || lemma = "który" then
        List.flatten (Xlist.map ["int"] (fun ctype ->
          let _ = match grads with ["pos"] -> () | _ -> failwith "process_interp adj: grad" in
          let quant = ["inumber",ge (),[];"igender",ge (),[];"iperson",ge (),[];"nperson",ge (),[];"plemma",ge (),[];"ctype",ge (),[ctype];"number",d.e.number,expand_numbers numbers;"case",d.e.case,expand_cases cases;"gender",d.e.gender,expand_genders genders] in
          let t = ["cp"; "ctype"; lemma] in
          let sem_mods = ["CTYPE",SubstVar "ctype"] in
          let batrs = make_node lemma "adj" d.id d.weight 0 [ctype;"number";"case";"gender"] in
          let raised_arg0 = [Raised(["np";"number";"case";"gender";"nperson"],Backward,["adjp";"number";"case";"gender"])] in
          let raised_arg1 = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["np";"number";"case";"gender";"nperson"])] in
          let raised_arg2a = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["prepnp";"plemma";"case"])] in
          let raised_arg2b = [Raised(["prepnp";"plemma";"case"],Forward,["np";"number";"case";"gender";"nperson"])] in
          let raised_arg3a = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["comprepnp";"plemma"])] in
          let raised_arg3b = [Raised(["comprepnp";"plemma"],Forward,["np";"number";"case";"gender";"nperson"])] in
          let schema_list = [[schema_field RAISED "" Forward raised_arg0];[schema_field RAISED "" Forward raised_arg1]] in
          let frame_np = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[schema_field RAISED "" Forward raised_arg0];[schema_field RAISED "" Backward raised_arg2b];[schema_field RAISED "" Forward raised_arg2a]] in
          let frame_prepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[schema_field RAISED "" Forward raised_arg0];[schema_field RAISED "" Backward raised_arg3b];[schema_field RAISED "" Forward raised_arg3a]] in
          let frame_comprepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          [frame_np;frame_prepnp;frame_comprepnp])) else []) @
      (if lemma = "jaki" || lemma = "który" then
        List.flatten (Xlist.map ["rel"] (fun ctype ->
          let _ = match grads with ["pos"] -> () | _ -> failwith "process_interp adj: grad" in
          let quant = ["inumber",ge (),[];"igender",ge (),[];"iperson",ge (),[];"plemma",ge (),[];"ctype",ge (),[ctype];"number",d.e.number,expand_numbers numbers;"case",d.e.case,expand_cases cases;"gender",d.e.gender,expand_genders genders; "person",d.e.person,["ter"]] in
          let t = ["cp"; "ctype"; lemma] in
          let sem_mods = ["CTYPE",SubstVar "ctype"] in
          let batrs = make_node lemma "adj" d.id d.weight 0 [ctype;"number";"case";"gender";"person"] in
          let raised_arg = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["np";"number";"case";"gender";"person"])] in
          let raised_arg1 = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["prepnp";"plemma";"case"])] in
          let raised_arg2 = [Raised(["prepnp";"plemma";"case"],Forward,["np";"number";"case";"gender";"person"])] in
          let raised_arg3 = [Raised(["ip";"inumber";"igender";"iperson"],Forward,["comprepnp";"plemma"])] in
          let raised_arg4 = [Raised(["comprepnp";"plemma"],Forward,["np";"number";"case";"gender";"person"])] in
          let schema_list = [[schema_field RAISED "" Forward raised_arg]] in
          let frame_np = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[schema_field RAISED "" Backward raised_arg2];[schema_field RAISED "" Forward raised_arg1]] in
          let frame_prepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          let schema_list = [[schema_field RAISED "" Backward raised_arg4];[schema_field RAISED "" Forward raised_arg3]] in
          let frame_comprepnp = LCGrenderer.make_frame_raised quant schema_list t d batrs sem_mods in
          [frame_np;frame_prepnp;frame_comprepnp])) else []) @
      if lemma = "czyj" || lemma = "jaki" || lemma = "który" then [] else
      (if lemma = "jakiś" || lemma = "ten" || lemma = "taki" then
        make_np numbers cases genders ["ter"] d lemma "adj" else []) @
      make_adjp numbers cases genders grads d lemma "adj"
  | lemma,"adjc",[] -> make_adjp ["sg"] ["pred"] ["m1";"m2";"m3"] ["pos"] d lemma "adjc" (* np: gotów *) (* FIXME: czy to na pewno ma zwykłą walencję przymiotnika? *)
  | lemma,"adjp",[] -> make_adjp all_numbers ["postp"] all_genders ["pos"] d lemma "adjp"
  | lemma,"adja",[] ->
      let batrs = make_node lemma "adja" d.id d.weight 0 [] in
      [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase(Lex "hyphen")]]] (["adja"]) d batrs]
  | lemma,"adv",[grads] ->
      make_advp grads d lemma
  | lemma,"adv",[] ->
      make_advp ["pos"] d lemma
  | lemma,"ger",[numbers;cases;genders;aspects;negations] ->
      make_ger numbers cases genders ["ter"] aspects negations d lemma "ger"
  | lemma,"pact",[numbers;cases;genders;aspects;negations] ->
      make_padj numbers cases genders aspects negations d lemma "pact"
  | lemma,"ppas",[numbers;cases;genders;aspects;negations] ->
      make_padj numbers cases genders aspects negations d lemma "ppas"
  | lemma,"fin",[numbers;persons;aspects] ->  (* FIXME: genders bez przymnogich *)
      let persons2 = Xlist.fold persons [] (fun l -> function "sec" -> l | s -> s :: l) in
      (make_ip numbers ["_"] persons aspects false false d lemma "fin") @
      (if persons2 = [] then [] else
       make_ip numbers ["_"] persons2 aspects false true d lemma "fin")
  | lemma,"bedzie",[numbers;persons;aspects] ->
      (if lemma = "być" then
        let quant = ["number",d.e.number,expand_numbers numbers;"gender",d.e.gender,all_genders; "person", d.e.person,persons] in
        let t = ["aux-fut"; "number"; "gender"; "person"] in
        [LCGrenderer.make_frame_simple quant t d ( (make_node "być" "bedzie" d.id d.weight 0 [])(*[Dot;Dot;Dot;Dot]*))] else []) @
      (make_ip numbers ["_"] persons aspects false false d lemma "bedzie")
  | lemma,"praet",[numbers;genders;aspects;nagl] ->
      (if lemma = "być" then
        let quant = ["number",d.e.number,expand_numbers numbers;"gender",d.e.gender,expand_genders genders; "person",d.e.person, all_persons] in
        let t = ["aux-past"; "number"; "gender"; "person"] in
        [LCGrenderer.make_frame_simple quant t d ( (make_node "być" "praet" d.id d.weight 0 [])(*[Dot;Dot;Dot;Dot]*))] else []) @
      (make_ip numbers genders ["ter"] aspects false false d lemma "praet") @
      (make_ip numbers genders ["pri";"sec"] aspects true false d lemma "praet") @
      (make_ip numbers genders ["pri";"sec";"ter"] aspects false true d lemma "praet")
  | lemma,"praet",[numbers;genders;aspects] ->
      (if lemma = "być" then
        let quant = ["number",d.e.number,expand_numbers numbers;"gender",d.e.gender,expand_genders genders; "person",d.e.person, all_persons] in
        let t = ["aux-past"; "number"; "gender"; "person"] in
        [LCGrenderer.make_frame_simple quant t d ( (make_node "być" "praet" d.id d.weight 0 [])(*[Dot;Dot;Dot;Dot]*))] else []) @
      (make_ip numbers genders ["ter"] aspects false false d lemma "praet") @
      (make_ip numbers genders ["pri";"sec"] aspects true false d lemma "praet") @
      (make_ip numbers genders ["pri";"sec";"ter"] aspects false true d lemma "praet")
  | lemma,"winien",[numbers;genders;aspects] ->
      (make_ip numbers genders ["ter"] aspects false false d lemma "winien") @
      (make_ip numbers genders ["ter"] aspects false true d lemma "winien") @
      (make_ip numbers genders ["pri";"sec"] aspects true false d lemma "winien") @
      (make_ip numbers genders ["pri";"sec"] aspects true true d lemma "winien")
  | lemma,"impt",[numbers;persons;aspects] -> (* FIXME: genders bez przymnogich *)
      make_ip numbers ["_"] persons aspects false false d lemma "impt"
  | lemma,"imps",[aspects] ->
      make_ip ["_"] ["_"] all_persons aspects false false d lemma "imps"
  | lemma,"pred",[] -> (* FIXME: czy predykatyw zawsze jest niedokonany? *)
      (make_ip ["sg"] ["n2"] ["ter"] ["imperf"] false false d lemma "pred") @
      (make_ip ["sg"] ["n2"] ["ter"] ["imperf"] false true d lemma "pred")
  | "być","aglt",[numbers;persons;aspects;wok] ->
      let numbers = expand_numbers numbers in
      let quant = ["number",d.e.number,numbers; "person", d.e.person,persons] in
      let t = ["aglt"; "number"; "person"] in
      [LCGrenderer.make_frame_simple quant t d ( (make_node "być" "aglt" d.id d.weight 0 [])(*[Dot;Dot;Dot]*))]
  | lemma,"inf",[aspects] ->  (* FIXME: wielopoziomowe InfP *)
      make_infp aspects d lemma
  | lemma,"pcon",[aspects] ->
      make_padvp aspects d lemma "pcon"
  | lemma,"pant",[aspects] ->
      make_padvp aspects d lemma "pant"
  | "się","qub",[] -> [LCGrenderer.make_frame_simple [] ["się"] {d with orth=""} ( (make_node "się" "qub" d.id d.weight 0 [])) (* FIXME: dodać make_np *)]
  | "nie","qub",[] -> [LCGrenderer.make_frame_simple [] ["nie"] {d with orth=""} (make_node "nie" "qub" d.id d.weight 0 [])]
  | "by","qub",[] -> [LCGrenderer.make_frame_simple [] ["by"] {d with orth=""} (make_node "by" "qub" d.id d.weight 0 [])]
  | "niech","qub",[] -> [LCGrenderer.make_frame_simple [] ["aux-imp"] d (make_node "niech" "qub" d.id d.weight 0 [])]
  | "niechaj","qub",[] -> [LCGrenderer.make_frame_simple [] ["aux-imp"] d (make_node "niechaj" "qub" d.id d.weight 0 [])]
  | "niechże","qub",[] -> [LCGrenderer.make_frame_simple [] ["aux-imp"] d (make_node "niechże" "qub" d.id d.weight 0 [])]
  | "niechajże","qub",[] -> [LCGrenderer.make_frame_simple [] ["aux-imp"] d (make_node "niechajże" "qub" d.id d.weight 0 [])]
  | "czy","qub",[] -> (* FIXME: poprawić semantykę *)
          let quant = [] in
          let t = ["cp"; "int"; "czy"] in
          let batrs = make_node "czy" "qub" d.id d.weight 0 ["int"] in
          let schema_list = [[comp_arg_schema_field [Phrase IP]]] in
          [LCGrenderer.make_frame quant schema_list t d batrs]
  | "gdyby","qub",[] -> (* FIXME: poprawić semantykę *) (* FIXME: poprawić tryb przypuszczający *) (* FIXME: problem z interpretacją jako 'gdy' *)
          let quant = [] in
          let t = ["cp"; "rel"; "gdyby"] in
          let batrs = make_node "gdyby" "qub" d.id d.weight 0 ["rel"] in
          let schema_list = [[comp_arg_schema_field [Phrase IP]]] in
          [LCGrenderer.make_frame quant schema_list t d batrs]
  | lemma,"qub",[] -> [LCGrenderer.make_frame_simple [] ["qub"] d ( (make_node lemma "qub" d.id d.weight 0 []))] (* FIXME: semantyka i rodzaje kublików *)
  | lemma,"comp",[] -> make_conjunct d lemma "comp"
  | "i","conj",[] -> make_conj true d "i" @ (make_conjunct d "i" "conj")
  | "lub","conj",[] -> make_conj true d "lub" @ (make_conjunct d "lub" "conj")
  | "czy","conj",[] -> make_conj true d "czy" @ (make_conjunct d "czy" "conj")
  | "bądź","conj",[] -> make_conj true d "bądź" @ (make_conjunct d "bądź" "conj")
  | lemma,"conj",[] -> make_conjunct d lemma "conj"
(*  | "interp",[] -> []
  | "brev",[pun] -> []*)
  | lemma,"interj",[] -> [LCGrenderer.make_frame_simple [] ["interj"] d (make_node lemma "interj" d.id d.weight 0 [])]
  | lemma,"burk",[] -> [] (* FIXME *)
(*  | "dig",[] -> []
  | "romandig",[] -> []
  | "ign",[] -> []
  | "xxx",[] -> [] (* to występuje w słowniku skrótów *)*)
(*  | ".","interp",[] -> []
  | "%","interp",[] -> []*)
  | "-","interp",[] -> [LCGrenderer.make_frame_simple [] ["hyphen"] d (make_node "-" "interp" d.id d.weight 0 [])]
(*  | ":","interp",[] -> [LCGrenderer.make_frame_simple [] ["colon"] ":" beg len [Dot] [Dot]]*)
  | "?","interp",[] -> [LCGrenderer.make_frame_simple [] ["int"] d (make_node "?" "interp" d.id d.weight 0 [])] (*FIXME: zdanie nadrzędne powinno mieć atrybut pytajności(Attr("INT",Val "+"))] *)
  | ",","interp",[] -> make_conj false d "," (*@ [LCGrenderer.make_frame_simple [] ["comma"] "," beg len [Dot] [Dot]]*)
  | ";","interp",[] -> [](*[LCGrenderer.make_frame_simple [] ["comma"] ";" beg len [Dot] [Dot]]*)
  | "„","interp",[] -> [(* FIXME: zaznaczyć niesemantyczność quotów *)
          LCGrenderer.make_quot_frame
            ["number",d.e.number,[];"case",d.e.case,[];"gender",d.e.gender,[];"person",d.e.person,[]]
            (Tensor[Atom "np"; AVar "number"; AVar "case"; AVar "gender"; AVar "person"]) (Tensor[Atom "rquot"])
            ["np";"number";"case";"gender";"person"] d
            (make_node "„" "interp" d.id d.weight 0 [])]
  | "”","interp",[] -> [LCGrenderer.make_frame_simple [] ["rquot"] d (make_node "”" "interp" d.id d.weight 0 [])]
  | "«","interp",[] -> [LCGrenderer.make_frame_simple [] ["rquot3"] d (make_node "«" "interp" d.id d.weight 0 []);
          LCGrenderer.make_quot_frame
            ["number",d.e.number,[];"case",d.e.case,[];"gender",d.e.gender,[];"person",d.e.person,[]]
            (Tensor[Atom "np"; AVar "number"; AVar "case"; AVar "gender"; AVar "person"]) (Tensor[Atom "rquot2"])
            ["np";"number";"case";"gender";"person"] d
            (make_node "«" "interp" d.id d.weight 0 [])]
  | "»","interp",[] -> [LCGrenderer.make_frame_simple [] ["rquot2"] d (make_node "»" "interp" d.id d.weight 0 []);
          LCGrenderer.make_quot_frame
            ["number",d.e.number,[];"case",d.e.case,[];"gender",d.e.gender,[];"person",d.e.person,[]]
            (Tensor[Atom "np"; AVar "number"; AVar "case"; AVar "gender"; AVar "person"]) (Tensor[Atom "rquot3"])
            ["np";"number";"case";"gender";"person"] d
            (make_node "»" "interp" d.id d.weight 0 [])]
  | "(","interp",[] -> [LCGrenderer.make_inclusion_frame (Tensor[Atom "rparen"]) d (make_node "(" "interp" d.id d.weight 0 [])]
  | ")","interp",[] -> [LCGrenderer.make_frame_simple [] ["rparen"] d (make_node ")" "interp" d.id d.weight 0 [])]
  | "[","interp",[] -> [LCGrenderer.make_inclusion_frame (Tensor[Atom "rparen"]) d (make_node "[" "interp" d.id d.weight 0 [])]
  | "]","interp",[] -> [LCGrenderer.make_frame_simple [] ["rparen"] d (make_node "]" "interp" d.id d.weight 0 [])]
  | lemma,"unk",[] ->
     let quant = ["number",d.e.number,all_numbers;"case",d.e.case,all_cases; "gender",d.e.gender,all_genders; "person",d.e.person, ["ter"]] in
     let t = ["np"; "number"; "case"; "gender"; "person"] in
     let batrs = make_node lemma "unk" d.id d.weight 0 ["number"; "case"; "gender"; "person"] in
     [LCGrenderer.make_frame_simple quant t d ( batrs)]
  | _,"xxx",[] -> [] (* FIXME *)
  | x,c,l -> failwith ("process_interp: " ^ (String.concat ":" (Xlist.map ([x] :: [c] :: l) (String.concat "."))))

let process_bracket_lemma (d:PreTypes.token_record) = function
    "<query>" ->
       [LCGrenderer.make_frame [] [[schema_field NOSEM "" Forward [Phrase Null;Phrase (Lex "<dummy>")]];[arg_schema_field Forward [Phrase (Lex "</query>")]]] (["<query>"]) {d with orth=""} (make_node "<query1>" "interp" d.id d.weight 0 []);
        LCGrenderer.make_frame [] [[schema_field SENTENCE "" Forward [Phrase (Lex "<ors>")]]] (["<query>"]) {d with orth=""} (make_node "<query2>" "interp" d.id d.weight 0 []);
        LCGrenderer.make_frame [] [[(*nosem*)arg_schema_field Forward [Phrase (Lex "<speaker>")]];[nosem_schema_field Forward [Phrase (Lex "<colon>")]];[(*nosem*)arg_schema_field Forward [Phrase (Lex "<ors>")]];[(*nosem*)arg_schema_field Forward [Phrase (Lex "</query>")]]] (["<query>"]) {d with orth=""} (make_node "<query3>" "interp" d.id d.weight 0 []);
        LCGrenderer.make_frame [] [[schema_field SENTENCE "" Forward [Phrase (Lex "<colon>")]]] (["<query>"]) {d with orth=""} (make_node "<query4>" "interp" d.id d.weight 0 []);
        LCGrenderer.make_frame [] [[schema_field SENTENCE "" Forward [Phrase (Lex "<colon>")]];[schema_field SENTENCE "" Forward [Phrase (Lex "<ors>")]]] (["<query>"]) {d with orth=""} (make_node "<query5>" "interp" d.id d.weight 0 []); (* FIXME: zdania w odwróconej kolejności *)
        LCGrenderer.make_frame [] [[schema_field SENTENCE "Sentence" Forward [Phrase (Lex "<sentence>")]];[schema_field SENTENCE "" Forward [Phrase (Lex "<ors>")]]] (["<query>"]) {d with orth=""}  (make_node "<query6>" "interp" d.id d.weight 0 [])] (* FIXME: zdania w odwróconej kolejności *)
  | "</query>" ->
       let t = (["</query>"]) in
       let batrs = (make_node "</query>" "interp" d.id d.weight 0 []) in
       let schema_list = [[schema_field NOSEM "" Backward [Phrase Null;Phrase (Lex "<dummy>")]];[schema_field SENTENCE "Sentence" Backward [Multi[Lex "<sentence>"](*Phrase(Lex "s")*)]]] in
       [LCGrenderer.make_frame [] schema_list t d batrs]
  | "„s" ->
       let batrs = make_node "pro-komunikować" "pro" d.id d.weight 0 [] in
       [LCGrenderer.make_frame [] [[schema_field OBJ "Theme" Forward [Phrase (Lex "</or1>")]]] (["<sentence>"(*"or"*)]) {d with orth=""} batrs;
        LCGrenderer.make_frame_simple [] ["<dummy>"] d ( (make_node "„s" "interp" d.id d.weight 0 []))]
  | "”s" ->
       let t = (["</or1>"]) in
       let batrs = (make_node "”s" "interp" d.id d.weight 0 []) in
       let schema_list = [[schema_field SENTENCE "Sentence" Backward [Multi[Lex "<sentence>"](*Phrase(Lex "s")*)]]] in
       [LCGrenderer.make_frame [] schema_list t d batrs;
        LCGrenderer.make_frame_simple [] ["<dummy>"] d ( (make_node "”s" "interp" d.id d.weight 0 []))]
  | "«s" -> [] (* FIXME *)
  | "»s" -> [] (* FIXME *)
  | ":" ->
       [LCGrenderer.make_frame_simple [] ["or"] d (match LCGrenderer.make_pro () with Node t -> {t with pred="pro-komunikat"; weight=10.} | _ -> failwith "process_bracket_lemma")]
  | ":s" ->
       let batrs = make_node "pro-komunikować" "pro" d.id d.weight 0 [] in
       [LCGrenderer.make_frame [] [[schema_field SUBJ "Initiator" Backward [Phrase (Lex "<speaker>")]]] (["<colon>"]) {d with orth=""} batrs;
        LCGrenderer.make_frame [] [[schema_field SUBJ "Initiator" Backward [Phrase (Lex "<speaker>")]];[schema_field OBJ "Theme" Forward [Phrase (Lex "</query>")]]] (["<colon>"]) {d with orth=""} batrs]
  | "<or>" -> [LCGrenderer.make_frame [] [[nosem_schema_field Forward [Phrase (Lex "</or>")]]] (["or"]) {d with orth=""} (make_node "<or>" "interp" d.id d.weight 0 [])]
  | "<ors>" ->
       let batrs = make_node "pro-komunikować" "pro" d.id d.weight 0 [] in
       [LCGrenderer.make_frame [] [[schema_field OBJ "Theme" Forward [Phrase (Lex "</query>")]]] (["<ors>"]) {d with orth=""} batrs]
  | "</or>" ->
       let t = (["</or>"]) in
       let batrs = (make_node "</or>" "interp" d.id d.weight 0 []) in
       let schema_list = [[schema_field SENTENCE "Sentence" Backward [Multi[Lex "<sentence>"](*Phrase(Lex "s")*)]]] in
       [LCGrenderer.make_frame [] schema_list t d batrs]  (* FIXME: semantyka *)
  | "<sentence>" ->
       [LCGrenderer.make_frame [] [[arg_schema_field Forward [Phrase (Lex "s")]]] (["<sentence>"]) {d with orth=""} (make_node "<sentence>" "interp" d.id d.weight 0 []);
        LCGrenderer.make_frame [] [[arg_schema_field Forward [Phrase (NP(Case "nom"))]];[nosem_schema_field Forward [Phrase (Lex "</speaker>")]]] (["<speaker>"]) {d with orth=""} (make_node "<speaker>" "interp" d.id d.weight 0 [])]
  | "</sentence>" ->
         let t = ["s"] in
         let batrs = (make_node "</sentence>" "interp" d.id d.weight 0 []) in
         let schema_list = [[schema_field CLAUSE "Clause" Backward [Multi[IP;CP(Int,CompUndef);NP(Case "voc");Lex "interj"](*Phrase IP;Phrase(CP(Int,CompUndef));Phrase(NP(Case "voc"))*)]](*;[WalFrames.schema_field NOSEM "" Backward [Phrase(Lex "<sentence>")]]*)] in
         [LCGrenderer.make_frame_simple [] ["</speaker>"] d ( (make_node "</speaker>" "interp" d.id d.weight 0 []));
          LCGrenderer.make_frame [] schema_list t d batrs]
  | lemma -> raise Not_found

let get_labels () = {
  number=ge ();
  case=ge ();
  gender=ge ();
  person=ge ();
  aspect=ge ();
  }

let create_entries (d:PreTypes.token_record) = function
    {token = Interp "<clause>"} -> [BracketSet(Forward),Dot]
  | {token = Interp "</clause>"} -> [BracketSet(Backward),Dot]
  | {token = Interp lemma} ->
    (try
      Xlist.fold (process_bracket_lemma d lemma) [] (fun l (symbol,sem) -> (Bracket(true,true,symbol),sem) :: l)
    with Not_found ->
          let entries = process_interp d (lemma,"interp",[]) in
          Xlist.map entries (fun (symbol,sem) -> Bracket(false,false,symbol),sem))
  | {token = Lemma(lemma,"sinterj",[[]])} ->
          let t = ["interj"] in
          let batrs = make_node lemma "sinterj" d.id d.weight 0 [] in
          let symbol,sem = LCGrenderer.make_frame_simple [] t d ( batrs) in
          [Bracket(true,true,symbol),sem]
  | {token = Lemma(lemma,pos,interp)} ->
        Xlist.fold interp [] (fun l tags ->
          let d = {d with e=get_labels (); valence=LCGrenderer.make_controll d.valence} in
          let entries = process_interp d (lemma,pos,tags) in
          Xlist.map entries (fun (symbol,sem) -> Bracket(false,false,symbol),sem) @ l)
  | _ -> []

module OrderedIntInt = struct

  type t = int * int

  let compare = compare

end

module IntIntSet = Xset.Make(OrderedIntInt)


let create query (paths,last,next_id) =
  uni_weight := 0.;
  LCGrenderer.pro_id_counter := next_id;
  let graph = LCGchart.make last in
  let graph = Xlist.fold paths graph (fun graph (t:PreTypes.token_record) ->
(*     if t.weight < -0.9 || Xlist.mem t.attrs "notvalidated proper" || Xlist.mem t.attrs "lemmatized as lowercase" then graph else *)
    let graph = LCGchart.add_inc graph t.lnode t.rnode (Tensor[Atom ("[" ^ t.orth ^ "]")], Dot) 0 in
    LCGchart.add_inc_list graph t.lnode t.rnode (create_entries (t:PreTypes.token_record) (t:PreTypes.token_record)) 0) in
  let set = Xlist.fold paths IntIntSet.empty (fun set t -> IntIntSet.add set (t.lnode,t.rnode)) in
  let graph = IntIntSet.fold set graph (fun graph (i,j) -> LCGchart.make_unique graph i j) in
  graph