(* * 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" let negation = function Negation -> "neg" | Aff -> "aff" | NegationUndef -> "_" | NegationNA -> "" let pred = function PredNA -> "" | Pred -> "pred" 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 -> "" | ReflSie -> "się" 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 ^ ")" let phrase = function NP c -> "np(" ^ case c ^ ")" | PrepNP(s,prep,c) -> "prepnp(" ^ sem s ^ "," ^ prep ^ "," ^ case c ^ ")" | AdjP c -> "adjp(" ^ case c ^ ")" | PrepAdjP(s,prep,c) -> "prepadjp(" ^ sem s ^ "," ^ prep ^ "," ^ case c ^ ")" | NumP(c) -> "nump(" ^ case c ^ ")" | PrepNumP(s,prep,c) -> "prepnump(" ^ sem s ^ "," ^ prep ^ "," ^ case c ^ ")" | ComprepNP(s,prep) -> "comprepnp(" ^ sem s ^ "," ^ prep ^ ")" | ComparNP(s,prep,c) -> "comparnp(" ^ sem s ^ "," ^ prep ^ "," ^ case c ^ ")" | ComparPP(s,prep) -> "comparpp(" ^ sem s ^ "," ^ prep ^ ")" | IP -> "ip" | CP(ct,co) -> "cp(" ^ comp_type ct ^ "," ^ comp co ^ ")" | NCP(c,ct,co) -> "ncp(" ^ case c ^ "," ^ comp_type ct ^ "," ^ comp co ^ ")" | PrepNCP(s,prep,c,ct,co) -> "prepncp(" ^ sem s ^ "," ^ prep ^ "," ^ case c ^ "," ^ comp_type ct ^ "," ^ comp co ^ ")" | InfP(a(*,r*)) -> "infp(" ^ aspect a (*^ req r*) ^ ")" | PadvP -> "padvp" | AdvP -> "advp" | FixedP s -> "fixed(" ^ s ^ ")" | PrepP -> "prepp" | Prep(prep,c) -> "prep(" ^ prep ^ "," ^ case c ^ ")" | Num(c,a) -> "num(" ^ case c ^ "," ^ acm a ^ ")" | Measure(c) -> "measure(" ^ case c ^ ")" | Or -> "or" (* | Refl -> "refl" *) (* | Recip -> "recip" *) | Qub -> "qub" | Inclusion -> "inclusion" | Adja -> "adja" | AuxPast -> "aux-past" | AuxFut -> "aux-fut" | AuxImp -> "aux-imp" | Aglt -> "aglt" | Pro -> "pro" | ProNG -> "prong" | Null -> "null" | X -> "x" | Lex s -> "lex(" ^ s ^ ")" 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)) ^ direction s.dir ^ "{" ^ 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 | 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 ^ "])" | 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 ^ "])" | 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 ^ ")" (* | 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 frame_atrs = function DefaultAtrs(m,r,o,neg,p,a) -> Printf.sprintf "%s: %s: %s: %s: %s: %s" (String.concat "; " m) (refl r) (opinion o) (negation neg) (pred p) (aspect a) | EmptyAtrs m -> Printf.sprintf "%s" (String.concat "; " m) | NounAtrs(m,nsyn,s(*,typ*)) -> Printf.sprintf "%s: %s: %s" (String.concat "; " m) nsyn (nsem s) (*(String.concat ";" typ)*) | AdjAtrs(m,c,adjsyn(*,adjsem,typ*)) -> Printf.sprintf "%s: %s: %s" (String.concat "; " m) (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 "; " m) le (negation neg) (mood mo) (tense t) (aux au) (aspect a) | GerAtrs(m,le,neg,a) -> Printf.sprintf "%s: %s: %s: %s" (String.concat "; " m) le (negation neg) (aspect a) | NonPersAtrs(m,le,role,role_attr,neg,a) -> Printf.sprintf "%s: %s: %s,%s: %s: %s" (String.concat "; " m) 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]