type word = A of string | An of string
type root = Edy of word | Xy of word | Ation of word | Le of word | A of word | Cy of word
| Rous of word | Ics of word | Ics2 of word | Sis of word | X of word | Ality of word | Ty of word
| Ication of word | Tion of word | Arity of word | Sm of word
type prefix = Inv of word | Vf of word * string
let prefixes = [|
Vf(A "mult","i"); Inv (A "pre"); Vf(An "ex","o"); Vf(A "retr","o");
Inv (A "hyper"); Vf(A "hem","i"); Inv (A "eu"); Vf(A "par","a");
Vf(A "gastr","o"); Vf(A "bell","i"); Inv (An "an"); Vf(A "mes","o");
Vf(A "therm","o"); Vf(A "copr","o"); Vf(A "pleb","i"); Vf(An "ant","i");
Vf(A "pseud","o"); Vf(A "quas", "i"); Vf(A "crypt","o"); Vf(A "bronch","o");
Vf(A "hydr","o"); Vf(A "psych","o"); Vf(A "tel","e"); Vf(An "arachn","o");
Vf(A "nyct","o"); Inv(A "dys"); Inv(A "mis"); Vf(A "mis","o"); Vf(A "the","o");
Vf(A "terr","a"); Vf(An "astr","a"); Vf(An "astr","o"); Vf(An "archae","o");
Vf(An "erot","o"); Vf(A "proct","o"); Vf(An "atm","o"); Vf(A "strat","o");
Inv(A "geo"); Vf(An "omn","i"); Inv(A "poly"); Vf(A "malign","o");
Vf(A "micr","o"); Vf(A "macr","o"); Vf(A "nan","o"); Vf(A "femt","o");
Vf(A "kil","o"); Vf(A "pet","a"); Inv(A "tri"); Vf(A "tetr","a");
Vf(A "yoct","o"); Vf(A "meg","a"); Vf(A "un","i"); Inv(A "bi"); Vf(A "dec","a");
Vf(A "pent","a"); Inv(An "endo"); Vf(An "electr","o"); Vf(A "pat","a");
Vf(A "hem","o"); Inv(An "arch"); Vf(A "mesm","o"); Vf(A "card","io");
Vf(A "necr","o"); Inv(An "un"); Vf(An "ultr","a"); Inv(A "trans");
Inv(A "post"); Inv(A "sub"); Inv(A "pro"); Vf(A "ben","e"); Inv(An "ab");
Inv(An "inter"); Vf(An "intr","a"); Inv(A "non"); Inv(A "counter");
Vf(A "contr","a"); Vf(A "path","o"); Vf(A "phon","o"); Inv(A "pan");
Vf(A "zo","o"); Vf(A "chron","o"); Inv(A "re"); Inv(A "con"); Vf(A "volcan","o");
Inv(A "tech"); Vf(A "plasm","o"); Vf(A "megal","o"); Inv(A "cyber");
Vf(A "met","a"); Inv(A "neo"); Vf(An "ocul","o"); Vf(A "strangul","o");
Vf(A "dendr","o"); Vf(A "matr","i"); Vf(A "patr","i"); Vf(A "lesb","o");
Vf(A "hom","o"); Vf(A "heter","o"); Vf(A "prot","o"); Vf(An "ect","o");
Vf(A "weeb","o"); Vf(A "fung","i"); Vf(A "per","i"); Vf(A "petr","i");
Vf(A "sad","o"); Vf(A "femin","i"); Vf(A "mascul","o"); Vf(A "claustr","o");
Vf(A "neur","o"); Vf(A "norm","o"); Inv (A "eu");
Vf(An "agor","a"); Vf(A "thanat","o"); Vf(A "vagin","o"); Vf(A "bi","o");
Vf(A "blog","o"); Vf(A "prometh","eo"); Vf(An "anesthes", "io");
Vf(A "din","o"); Vf(A "medic","o");
|]
let roots = [|
Edy (A "com");
Edy (A "trag");
Xy (A "gala");
Ation (A "lact");
Le (A "mirac");
Rous (A "fib");
A (An "arcan");
Cy (A "poli");
Ty (A "poli");
Ics (A "polit");
Ics (A "mathemat");
Ics2 (A "memet");
Sis (A "mime");
Ics (A "linguist");
Ics2 (A "linguist");
Ics2 (A "therm");
Ics (A "cosmet");
Ics (A "anesthet");
Ics (A "techn");
Sis (A "synthe");
X (An "appendi");
Ication (A "prognost");
Ality (A "lachrym");
Tion (A "prohibi");
Ation (A "not");
Ality (A "lingu");
Arity (A "pulmon");
Sis (A "sta");
Sis (A "kine");
Ality (A "lexic");
Ality (A "mort");
Ation (A "gener");
Ality (A "nocturn");
Cy (A "delica");
Ation (A "masturb");
Sm (An "orga");
Sm (A "cla");
Cy (A "malignan");
Tion (A "func");
Ics (A "dialect");
Ics (A "pedant");
Ation (A "form");
Ation (A "dict");
Tion (A "construc");
Tion (A "trac");
Tion (A "cep");
Ation (A "port");
Tion (A "scrip");
Tion (A "junc");
Ation (A "spir");
Ation (A "coloniz");
Ation (A "fornic");
Ics (A "disastr");
Ics (A "theatr");
Ality (A "sexu");
Ation (A "transl");
Sm (A "sadi");
Sm (A "masochi");
Ation (An "ejacul");
Ation (A "jacul");
Ality (A "vagin");
Ality (A "mystic");
Sm (A "mystici");
Ty (A "normativi");
Ality (A "norm");
Ality (A "typic");
Xy (A "do");
Ality (A "leg");
Sm (A "legali");
Ation (A "leg");
A (A "pragmat");
A (A "stigmat");
|]
let nsuffixes = [|
An "ite";
An "ate";
An "itis";
A "sis";
A "rrhea";
A "tion";
An "icon";
A "phoria";
A "cide";
An "ology";
An "ologics";
An "ologer";
An "ologist";
A "phobia";
A "sphere";
A "spherics";
A "gon";
A "tron";
A "metry";
A "meter";
A "noia";
A "noiac";
A "noid";
A "cracy";
A "crat";
A "mancy";
An "ism";
An "ist";
An "ary";
An "ory";
A "scope";
A "jection";
A "mission";
A "ception";
A "ceptor";
An "arch";
An "archy";
A "turbation";
A "turbator";
A "plasm";
A "mania";
A "maniac";
A "dendron";
A "gasm";
A "philia";
A "philiac";
A "phile";
A "sexuality";
A "romance";
A "net";
An "ium";
A "saur";
An "odon";
A "normativity";
A "typicality";
A "doxy";
|]
let adjsuffixes = [|
An "itic";
An "ose";
An "id";
A "tic";
A "rrheic";
A "tive";
An "iconic";
A "phoric";
A "cidal";
An "ologic";
An "ological";
An "ologistic";
A "phobic";
A "spheric";
A "gonal";
A "tronic";
A "metric";
A "metrical";
A "noiac";
A "noid";
A "cratic";
A "mantic";
An "ist";
An "istic";
An "ismic";
An "ismatic";
A "scopic";
A "ject";
A "jective";
A "missive";
A "ceptive";
An "archic";
A "turbatory";
A "plasmic";
A "plastic";
A "manic";
A "maniacal";
An "ish";
A "dendrite";
A "gasmic";
A "philic";
A "sexual";
A "romantic";
A "legal";
A "normative";
A "typical";
|]
let (^^) w s = match w with
An x -> An (x^s) | A x -> A (x^s);;
let pick (r : 'a array) : 'a = r.(Random.int(Array.length r))
let chance i = (Random.int i) = 0
let cform root = match root with
| Edy x -> x^^"edo" | Xy x -> x^^"cto" | Ation x -> x^^"o"
| Rous x -> x^^"ro" | Le x -> x^^"ulo" | A x -> x^^"o"
| Cy x -> x^^"tico" | Ics x | Ics2 x -> x^^(if chance 2 then "i" else "o")
| Sis x -> x^^"to"
| X x -> x^^"co" | Ality x -> x^^"o" | Ty x -> x^^"to"
| Ication x -> x^^"o" | Tion x -> x^^"to" | Arity x -> x^^"a"
| Sm x -> x^^(if chance 2 then "smo" else "sto")
let bareform root = match root with
| Edy x -> (if chance 2 then x else x^^"ed") | Xy x -> x^^"ct" | Ation x -> x
| Rous x -> x^^"r" | Le x -> x^^"ul" | A x -> x
| Cy x -> x^^"tic" | Ics x -> x^^"ic" | Ics2 x -> x | Sis x -> x^^"t"
| X x -> x^^"c" | Ality x -> x | Ty x -> x^^"t"
| Ication x -> x | Tion x -> x^^"t" | Arity x -> x
| Sm x -> x^^"st"
let adjform root = match root with
| Edy x -> x^^"ic" | Xy x -> x^^"ctic" | Ation x -> x^^"ic"
| Rous x -> x^^"rous" | Le x -> x^^"ulous" | A x -> x^^"e"
| Cy x -> x^^"tical" | Ics x -> x^^"ical" | Ics2 x -> x^^"ic" | Sis x -> x^^"tic"
| X x -> x^^"cal" | Ality x -> x^^"al" | Ty x -> x^^"tical"
| Ication x -> x^^(if chance 3 then "itious" else "icate")
| Tion x -> x^^(match Random.int 4 with
| 0 -> "tive" | 1 -> "ted" | 2 -> "cious" | 3 -> "tory" | _ -> assert false)
| Arity x -> x^^"ary" | Sm x -> x^^(if chance 2 then "stic" else "smic")
let nform root = if chance 7 then (adjform root) ^^ "ness" else match root with
| Edy x -> x^^"edy" | Xy x -> x^^"xy" | Ation x -> x^^(if chance 3 then "itor" else "ation")
| Rous x -> x^^"er" | Le x -> x^^"le" | A x -> x^^"a"
| Cy x -> x^^"cy" | Ics x -> x^^(if chance 3 then "ician" else "ics") | Sis x -> x^^"sis"
| Ics2 x -> x^^(if chance 3 then "ician" else "ics")
| X x -> x^^"x" | Ality x -> x^^"ality" | Ty x -> x^^"ty"
| Ication x -> x^^"ication" | Tion x -> x^^"tion" | Arity x -> x^^"arity"
| Sm x -> x^^(if chance 2 then "st" else "sm")
let abs (w:word) = match w with A x | An x -> x
let append pref w = match pref with
| Inv x -> x ^^ (abs w)
| Vf(body,v) -> match w with
| An x -> body^^x
| A x -> (body^^v)^^x
let rec word () : word = match Random.int 7 with
| 0 -> nform (pick roots)
| 1 -> (match pick nsuffixes with
| An x -> (bareform (pick roots)) ^^ x
| A x -> (cform (pick roots)) ^^ x)
| 2 -> ((adjform (pick roots)) ^^ " ") ^^ (abs(word ()))
| 3 -> ((match pick adjsuffixes with
| An x -> (bareform (pick roots)) ^^ x
| A x -> (cform (pick roots)) ^^ x) ^^ " ") ^^ (abs(word ()))
| 4 -> append (pick prefixes) (word ())
| 5 -> append (pick prefixes) (pick nsuffixes)
| 6 -> ((append (pick prefixes) (pick adjsuffixes)) ^^ " ") ^^ (abs (word()))
| _ -> assert false
let () = Random.self_init (); print_string (abs (word ())); ()