Wojciech Jaworski / ENIAM

(*
 *  ENIAMwalenty, an interface for Polish Valence Dictionary "Walenty".
 *  Copyright (C) 2016 Wojciech Jaworski <wjaworski atSPAMfree mimuw dot edu dot pl>
 *  Copyright (C) 2016 Institute of Computer Science Polish Academy of Sciences
 *
 *  This library is free software: you can redistribute it and/or modify
 *  it under the terms of the GNU Lesser General Public License as published by
 *  the Free Software Foundation, either version 3 of the License, or
 *  (at your option) any later version.
 *
 *  This library 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 Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU Lesser General Public License
 *  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open ENIAMwalTypes

(*let rec token = function
    Text s -> s
  | Paren l -> "(" ^ String.concat "" (Xlist.map l token) ^ ")"
  | Bracet l -> "{" ^ String.concat "" (Xlist.map l token) ^ "}"
  | SqBra l -> "[" ^ String.concat "" (Xlist.map l token) ^ "]"
  | LParen -> "("
  | RParen -> ")"
  | LBracet -> "{"
  | RBracet -> "}"
  | LSqBra -> "["
  | RSqBra -> "]"
  | Semic -> ";"
  | Plus -> "+"
  | Comma -> ","
  | Quot  -> "'"

let token_list l =
  String.concat "" (Xlist.map l token)*)

let opinion = function
    Pewny -> "pewny"
  | Potoczny -> "potoczny"
  | Watpliwy -> "wątpliwy"
  | Archaiczny -> "archaiczny"
  | Zly -> "zły"
  | Wulgarny -> "wulgarny"
  | Domyslny -> "domyślny"
  | Dobry -> "dobry"
  | OpinionUndef -> "_"

let negation = function
    Negation -> "neg"
  | Aff -> "aff"
  | NegationUndef -> "_"
  | NegationNA -> ""

let pred = function
    PredNA -> ""
  | PredTrue -> "pred"
  | PredFalse -> "nopred"
  | PredUndef -> "_"

let aspect = function
    Aspect s -> s
  | AspectUndef -> "_"
  | AspectNA -> ""

let case = function
    Case s -> s
  | Str -> "str"
  | Part -> "part"
  | CaseAgr -> "agr"
  | CaseUAgr -> "uagr"
  | NomAgr -> "nomagr"
  | GenAgr -> "genagr"
  | AllAgr -> "allagr"
  | AllUAgr -> "alluagr"
  | CaseUndef -> "_"

let rec comp = function
    Comp s -> s
  | Zeby -> "żeby2"
  | Gdy -> "gdy"
  | CompUndef -> "_"

let rec comp_type = function
   Int -> "int"
 | Rel -> "rel"
 (* | Sub -> "sub"
 | Coord -> "coord" *)
 | CompTypeUndef -> "_"
 (* | CompTypeAgr -> "agr" *)

let number = function
    Number s -> s
  | NumberAgr -> "agr"
  | NumberUndef -> "_"

let gender = function
    Gender s -> s
  | GenderUndef -> "_"
  | GenderAgr -> "agr"
  | Genders l -> String.concat "." l

let grad = function
    Grad s -> s
  | GradUndef -> "_"

let refl = function
    ReflEmpty -> ""
  | ReflTrue -> "się"
  | ReflFalse -> "nosię"
  | ReflUndef -> "_"

let acm = function
    Acm s -> s
  | AcmUndef -> "_"

(* let sem = function
    Sem -> "sem"
  | NoSem -> "nosem" *)

(*let req = function
    Req -> ",req"
  | NReq -> ",nreq"
  | ReqUndef -> ""*)

let gf = function
    SUBJ -> "subj"
  | OBJ -> "obj"
  | ARG -> "arg"(*""*)
  (* | CORE -> "core"
  | NOSEM -> "nosem"
  | NOGF -> "nogf"
  | ADJUNCT -> "adjunct"
  | RAISED -> "raised"
  | CLAUSE -> "clause"
  | SENTENCE -> "sentence" *)

let pos = function
    SUBST(n,c) -> "SUBST(" ^ number n ^ "," ^ case c ^ ")"
  | PREP(c) -> "PREP(" ^ case c ^ ")"
  | NUM(c,g,a) -> "NUM(" ^ case c ^ "," ^ gender g ^ "," ^ acm a ^ ")"
  | ADJ(n,c,g,gr) -> "ADJ(" ^ number n ^ "," ^ case c ^ "," ^ gender g ^ "," ^ grad gr ^ ")"
  | ADV(gr) -> "ADV(" ^ grad gr ^ ")"
  | GER(n,c,g,a,neg,r) -> "GER(" ^ number n ^ "," ^ case c ^ "," ^ gender g ^ "," ^ aspect a ^ "," ^ negation neg ^ "," ^ refl r ^ ")"
  | PACT(n,c,g,a,neg,r) -> "PACT(" ^ number n ^ "," ^ case c ^ "," ^ gender g ^ "," ^ aspect a ^ "," ^ negation neg ^ "," ^ refl r ^ ")"
  | PPAS(n,c,g,a,neg) -> "PPAS(" ^ number n ^ "," ^ case c ^ "," ^ gender g ^ "," ^ aspect a ^ "," ^ negation neg ^ ")"
  | INF(a,n,r) -> "INF(" ^ aspect a ^ "," ^ negation n ^ "," ^ refl r ^ ")"
  | QUB -> "QUB"
  | COMPAR -> "COMPAR"
  | COMP(c) -> "COMP(" ^ comp_type c ^ ")"
  | PERS(n,r) -> "PERS(" ^ negation n ^ "," ^ refl r ^ ")"
  | FIXED -> "FIXED"

let phrase = function
    NP c -> "np(" ^ case c ^ ")"
  | PrepNP(prep,c) -> "prepnp(" ^ prep ^ "," ^ case c ^ ")"
  | AdjP c -> "adjp(" ^ case c ^ ")"
  | PrepAdjP(prep,c) -> "prepadjp(" ^ prep ^ "," ^ case c ^ ")"
  | NumP(c) -> "nump(" ^ case c ^ ")"
  | PrepNumP(prep,c) -> "prepnump(" ^ prep ^ "," ^ case c ^ ")"
  | ComprepNP(prep) -> "comprepnp(" ^ prep ^ ")"
  (* | ComparNP(prep,c) -> "comparnp(" ^ prep ^ "," ^ case c ^ ")" *)
  | ComparP(prep) -> "comparp(" ^ prep ^ ")"
  | CP(ct,co) -> "cp(" ^ comp_type ct ^ "," ^ comp co ^ ")"
  | NCP(c,ct,co) -> "ncp(" ^ case c ^ "," ^ comp_type ct ^ "," ^ comp co ^ ")"
  | PrepNCP(prep,c,ct,co) -> "prepncp(" ^ prep ^ "," ^ case c ^ "," ^ comp_type ct ^ "," ^ comp co ^ ")"
  | InfP(a) -> "infp(" ^ aspect a (*^ req r*) ^ ")"
  | AdvP -> "advp"
  | FixedP s -> "fixed(" ^ s ^ ")"
  | Num(c,a) -> "num(" ^ case c ^ "," ^ acm a ^ ")"
  | Or -> "or"
  | Refl -> "refl"
  | Recip -> "recip"
  | Qub -> "qub"
  | Pro -> "pro"
  | ProNG -> "prong"
  | Null -> "null"
  | GerP c -> "gerp(" ^ case c ^ ")"
  | PrepGerP(prep,c) -> "prepgerp(" ^ prep ^ "," ^ case c ^ ")"
  | PpasP c -> "ppasp(" ^ case c ^ ")"
  | PrepPpasP(prep,c) -> "prepppasp(" ^ prep ^ "," ^ case c ^ ")"
  | PactP c -> "pactp(" ^ case c ^ ")"


let phrase_abbr = function
    Xp(m) -> "xp(" ^ m ^ ")"
  | Advp(m) -> "advp(" ^ m ^ ")"
  (* | ComparP prep -> "compar(" ^ prep ^ ")" *)
  | Nonch -> "nonch"
  | Distrp -> "distrp"
  | Possp -> "possp"

let phrase_comp = function
    Cp -> "cp"
  | Ncp(c) -> "ncp(" ^ case c ^ ")"
  | Prepncp(prep,c) -> "prepncp(" ^ prep ^ "," ^ case c ^ ")"

let rec lex = function
    Lexeme s -> "'" ^ s ^ "'"
  | ORconcat l -> "OR(" ^ String.concat "," (Xlist.map l lex) ^ ")"
  | ORcoord l -> "OR(" ^ String.concat ";" (Xlist.map l lex) ^ ")"
  | XOR l -> "XOR(" ^ String.concat "," (Xlist.map l lex) ^ ")"
  | Elexeme g -> "'E(" ^ gender g ^ ")"

let restr = function
    Natr -> "natr"
  | Atr -> "atr"
  | Ratr -> "ratr"
  | Ratrs -> "ratrs"
  | Atr1 -> "atr1"
  | Ratr1 -> "ratr1"
(*  | Ratr1,s -> "ratr1(" ^ schema s ^ ")"
  | Atr1,s -> "atr1(" ^ schema s ^ ")"
  | Ratr,s -> "ratr(" ^ schema s ^ ")"
  | Atr,s -> "atr(" ^ schema s ^ ")"
  | Ratrs,s -> "ratrs(" ^ schema s ^ ")"
 *) | NoRestr -> ""
(*   | NoRestr,s -> schema s *)

let controllers l =
  Xlist.map l (function
      "1" -> "controller"
    | n -> "controller" ^ n)

let controllees l =
  Xlist.map l (function
      "1" -> "controllee"
    | n -> "controllee" ^ n)

(*let lex_specs = function
    NSpecs num -> number num
  | AdvSpecs gr -> grad gr
  | AdjSpecs(num,g,gr) -> number num ^ "," ^ gender g ^ "," ^ grad gr
  | PpasSpecs(num,g,neg) -> number num ^ "," ^ gender g ^ "," ^ negation neg
  | PactSpecs(num,g,neg,r) -> number num ^ "," ^ gender g ^ "," ^ negation neg ^ "," ^ refl r
  | GerSpecs(num,neg,r) -> number num ^ "," ^ negation neg ^ "," ^ refl r
  | CSpecs(neg,r) -> negation neg ^ "," ^ refl r
  | NumSpecs g -> gender g
  | EmptySpecs -> ""*)

let mood = function
    (*Mood*) s -> s
  (*| MoodUndef -> "_"*)

let tense t = t

let aux = function
    NoAux -> "-"
  | PastAux -> "aux-past"
  | FutAux -> "aux-fut"
  | ImpAux -> "aux-imp"

let nsem = function
    Common s -> s
  | Time -> "time"

(* let direction = function
    Forward -> "/"
  | Backward  -> "\\"
  | Both -> "|" *)

let rec schema schema =
  String.concat "+" (Xlist.map schema (fun s ->
    String.concat "," (
      (if s.gf = ARG then [] else [gf s.gf])@
      (if s.role = "" then [] else [s.role])@
      (if s.role_attr = "" then [] else [s.role_attr])@
      (*s.sel_prefs@*)(controllers s.cr)@(controllees s.ce)) ^ "{" ^  String.concat ";" (Xlist.map s.morfs morf) ^ "}"))

(*and schema_role schema =
  String.concat "+" (Xlist.map schema (fun (r,role,cr,ce,morfs) ->
    String.concat "," ((if r = "" then [] else [r])@(if role = "" then [] else [role])@(controllers cr)@(controllees ce)) ^ "{" ^  String.concat ";" (Xlist.map morfs morf) ^ "}"))   *)

and morf = function
    Phrase p -> phrase p
  (* | PhraseMode(m,p) -> m ^ ":" ^ phrase p *)
  | E p -> "E(" ^ phrase p ^ ")"
  | LexPhrase(pos_lex,(r,s)) -> "lex([" ^ String.concat ";" (Xlist.map pos_lex (fun (p,le) -> pos p ^ "," ^ lex le)) ^ "]," ^ restr r ^ "[" ^ schema s ^ "])"
  (* | LexRPhrase(pos_lex,(r,s)) -> "lex([" ^ String.concat ";" (Xlist.map pos_lex (fun (p,le) -> pos p ^ "," ^ lex le)) ^ "]," ^ restr r ^ "[" ^ schema s ^ "])" *)
  (* | LexPhraseMode(m,pos_lex,(r,s)) -> "lex([" ^ m ^ "," ^ String.concat ";" (Xlist.map pos_lex (fun (p,le) -> pos p ^ "," ^ lex le)) ^ "]," ^ restr r ^ "[" ^ schema s ^ "])" *)
  (* | LexRPhraseMode(m,pos_lex,(r,s)) -> "lex([" ^ m ^ "," ^ String.concat ";" (Xlist.map pos_lex (fun (p,le) -> pos p ^ "," ^ lex le)) ^ "]," ^ restr r ^ "[" ^ schema s ^ "])" *)
  | PhraseAbbr(p,ml) -> phrase_abbr p ^ "[" ^ String.concat ";" (Xlist.map ml morf) ^ "]"
  | PhraseComp(p,(ct,l)) -> phrase_comp p ^ "," ^ comp_type ct ^ "[" ^ String.concat ";" (Xlist.map l comp) ^ "]"
  | LexPhraseId(id,p,le) -> "lex(" ^ id ^ "," ^ pos p ^ "," ^ lex le ^ ")"
  | LexArg(id,p,le) -> "lex(" ^ id ^ "," ^ pos p ^ "," ^ le ^ ")"
  | MorfId id -> Printf.sprintf "id(%d)" id
(*  | LexRealization(mrf,le) -> "lex(" ^ morf mrf ^ "," ^ le ^ ")"*)
  (* | Raised(mrf1,dir,mrf2) -> "raised([" ^ String.concat ";" mrf1 ^ "]," ^ direction dir ^ "[" ^ String.concat ";" mrf2 ^ "])"
  | Multi l -> "multi(" ^ String.concat ";" (Xlist.map l phrase) ^ ")" *)

(*and mode = function
    Mode(s,[]) -> s
  | Mode(s,l) -> s ^ "[" ^ "..."(*String.concat ";" (Xlist.map l morf)*) ^ "]"
(*   | Mod l -> "mod[...]"  *)
  | Pron [] -> "pron"
  | Pron l -> "pron" ^ "[" ^ "..."(*String.concat ";" (Xlist.map l morf)*) ^ "]"
  | Misc -> "misc"*)

let meaning m =
  m.name ^ "-" ^ m.variant

let frame_atrs = function
    DefaultAtrs(m,r,o,neg,p,a) -> Printf.sprintf "%s: %s: %s: %s: %s: %s" (String.concat "; " (Xlist.map m meaning)) (refl r) (opinion o) (negation neg) (pred p) (aspect a)
  | EmptyAtrs m -> Printf.sprintf "%s" (String.concat "; " (Xlist.map m meaning))
  | NounAtrs(m,nsyn,s(*,typ*)) -> Printf.sprintf "%s: %s: %s" (String.concat "; " (Xlist.map m meaning)) nsyn (nsem s) (*(String.concat ";" typ)*)
  | AdjAtrs(m,c,adjsyn(*,adjsem,typ*)) -> Printf.sprintf "%s: %s: %s" (String.concat "; " (Xlist.map m meaning)) (case c) adjsyn (*adjsem (String.concat ";" typ)*)
  | PersAtrs(m,le,neg,mo,t,au,a) -> Printf.sprintf "%s: %s: %s: %s: %s: %s: %s" (String.concat "; " (Xlist.map m meaning)) le (negation neg) (mood mo) (tense t) (aux au) (aspect a)
  | GerAtrs(m,le,neg,a) -> Printf.sprintf "%s: %s: %s: %s" (String.concat "; " (Xlist.map m meaning)) le (negation neg) (aspect a)
  | NonPersAtrs(m,le,role,role_attr,neg,a) -> Printf.sprintf "%s: %s: %s,%s: %s: %s" (String.concat "; " (Xlist.map m meaning)) le role role_attr (negation neg) (aspect a)
  | _ -> failwith "WalStringOf.frame_atrs"

let frame lexeme = function
    Frame(atrs,s) ->
      Printf.sprintf "%s: %s: %s" lexeme (frame_atrs atrs) (schema s)
  | LexFrame(id,p,r,s) ->
      Printf.sprintf "%s: %s: %s: %s: %s" lexeme id (pos p) (restr r) (schema s)
  | ComprepFrame(le,p,r,s) ->
      Printf.sprintf "%s: %s: %s: %s: %s" lexeme le (pos p) (restr r) (schema s)
(*  | FrameR(atrs,s) ->
      Printf.sprintf "%s: %s: %s" lexeme (frame_atrs atrs) (schema_role s)
  | LexFrameR(id,p,r,s) ->
      Printf.sprintf "%s: %s: %s: %s: %s" lexeme id (pos p) (restr r) (schema_role s)
  | ComprepFrameR(le,p,r,s) ->
      Printf.sprintf "%s: %s: %s: %s: %s" lexeme le (pos p) (restr r) (schema_role s)*)
(*   | _ -> failwith "WalStringOf.frame" *)

let fnum_frame lexeme = function
    fnum,Frame(atrs,s) ->
      Printf.sprintf "%d: %s: %s: %s" fnum lexeme (frame_atrs atrs) (schema s)
  | fnum,LexFrame(id,p,r,s) ->
      Printf.sprintf "%d: %s: %s: %s: %s: %s" fnum lexeme id (pos p) (restr r) (schema s)
  | fnum,ComprepFrame(le,p,r,s) ->
      Printf.sprintf "%d: %s: %s: %s: %s: %s" fnum lexeme le (pos p) (restr r) (schema s)

let unparsed_frame lexeme (r,o,neg,p,a,s) = lexeme ^ " " ^ String.concat ": " [r;o;neg;p;a;s]