type word = A of string | An of string | Article | Punctuation of string
type node = T of string | Tv of string | P of string | B of node list | N of node | R of node array | Indef | O of node | Fn of (unit -> word) | C of node
let wconcat x y = match x, y with
| (A(x),An(y)) | (A(x),A(y)) -> A(x^" "^y)
| (An(x),An(y)) | (An(x),A(y)) -> An(x^" "^y)
| _ -> assert false
let wprefix x y = match x, y with
| (A(x),An(y)) | (A(x),A(y)) -> A(x^y)
| (An(x),An(y)) | (An(x),A(y)) -> An(x^y)
| _ -> assert false
let range min max = (Random.int (max-min)) + min
let chance n = range 0 n = 0
let pick (r: 'a array) : 'a = r.(range 0 (Array.length r));;
module CrimeDrug = struct
let frics = [| "f"; "sh"; "th"; |]
let vfrics = [| "z"; "v"; "zh"; |]
let stops = [| "t"; "p"; "k"; "c"; |]
let vstops = [| "d"; "b"; "g"; "gh"; |]
let withglide r f = Array.map (fun i -> i^f) r
let withonset r o = Array.map (fun i -> o^i) r
let consonants = Array.concat [
frics; vfrics; stops; vstops;
withonset stops "s";
[| "w"; "r"; "rh"; "s"; "l"; "ch"; "n"; "m"; |];
]
let initials = Array.concat [
consonants;
withglide frics "r"; withglide frics "l"; withglide frics "w";
withglide stops "r"; withglide vstops "r"; withglide vstops "w";
[| "qu"; "spr"; "spl"; "str"; "scr"; "scl"; "squ"; "bl"; "gl"; "sn"; "sm"; "j"; "h"; "sph"; "ph";|];
]
let nuclei = [| "e"; "ee"; "i"; "a"; "ou"; "u"; "oo"; "ea"; "oa"; "ai"; "oi"; "ie";|]
let finals = Array.concat [
vstops;
withonset stops "s"; withonset stops "r"; withonset stops "l";
withonset vstops "r"; withonset vstops "l";
[| "gh"; "ck"; "ce"; "ss"; "se"; "nd"; "mb"; "mph"; "nk"; "tch"; "ke"; "ght";
"ff"; "ll"; "zz"; "t"; "p"; "th"; "rth"; "lth"; "dge"; "nge"; "ng"; "ft"; "ckle"; "ngle"; "rkle";
"scht"; "ze"; "x"; "sh"; "rsh"; "lsh"; "ggle"; "ddle"; "bble"; "pple"; "rge"; "lge"; "ve"; "rve";
"lve"; "ffle"; "ttle"; "kle"; "sch"; "m"; "n"; "rm"; "lm"; "rn"; "ln";|]
]
let prefixes = [| A "crack"; A "crystal"; A "powdered"; A"raw"; A "pure"; A "liquid";
A"street"; A "super"; An "electric"; A "diced"; A "homemade"; A "traditional";
An "old-school"; A "purified"; A "high-caliber"; A "high-octane"; An "old-fashioned";
A "good old"; A "honest-to-god"; A "weapons-grade"; A "soviet"; An "american";
A "canadian"; A "british"; A "russian"; A "synthetic"; A "french"; A "cyber"; |]
let makeA i x = A(i ^ x)
let makeAn x = An x
let maybeConcat x y = match x with
| Some t -> wconcat t y
| None -> y
let gen () : word = maybeConcat (if chance 3 then Some (pick prefixes) else None)
((if chance 5 then makeAn else makeA (pick initials))
((pick nuclei) ^ (pick finals)))
end
let rec crime = R [|
Tv "arson";
T "murder";
T "jaywalking";
T "larceny";
T "sex";
T "intercourse";
T "acts unspeakable";
T "public indecency";
T "software piracy";
T "piracy";
T "theft";
T "regicide";
Tv "assault";
T "battery";
T "treason";
T "bribery";
T "manslaughter";
T "bestiality";
T "assault and battery";
T "corruption";
T "corruption of a minor";
T "highway robbery";
T "banditry";
T "cattle rustling";
T "looting";
T "war crimes";
T "crimes against humanity";
T "breach of contract";
T "crime";
T "crimes";
T "burglary";
T "vandalism";
T "robbery";
T "forgery";
T "counterfeiting";
T "stalking";
T "sabotage";
T "sedition";
T "shoplifting";
T "corrupt practices";
T "fire-raising";
T "genocide";
T "desertion";
T "defamation";
T "embezzlement";
T "immigration";
T "emigration";
T "illegal immigration";
T "illegal emigration";
T "endangerment";
T "extortion";
T "failure to appear in court";
T "abduction";
T "kidnapping";
T "fraud";
T "tax fraud";
T "homicide";
T "extortion";
T "mutiny";
T "extortion";
T "perverting the course of justice";
T "perversion";
T "tweeting";
T "blogging";
T "mommyblogging";
T "vlogging";
T "posting";
T "posts";
T "trespass";
T "broadcasting";
T "assembly";
T "war profiteering";
T "blackmail";
T "cybercrime";
T "espionage";
T "hijacking";
T "hooliganism";
T "perjury";
T "snakes";
T "perpetuation of a ruckus";
T "perpetuation of a nuisance";
T "perpetuation of a public nuisance";
T "refusal to serve in a public office";
B [ T "failure to appear before"; Indef; profession ];
B [ T "refusal to serve as"; Indef; profession ];
B [ T "stalking"; O(T"of"); Indef; profession ];
B [ T "solicitation of"; Indef; profession ];
B [ T "bribery of"; Indef; profession; ];
B [ T "cruelty to"; Indef; profession; ];
B [ T "fraudulent"; practice; ];
B [ T "misuse of"; Indef; thing; ];
B [ thing; T "forging"; ];
B [ T "obtaining"; Indef; thing; T "by deception"; ];
B [ T "detonation of"; R[|B[Indef; thing];thingp|]; ];
B [ T "conspiracy to commit"; O prefix; crime; ];
B [ T "conspiracy to practice"; O prefix; practice ];
B [ T "possession of";
R[|
B[Indef; thing];
thingp;
Fn CrimeDrug.gen;
|];
O(T "with intent to distribute")
];B [ T "use of";
R[|
B[Indef; thing];
thingp;
Fn CrimeDrug.gen;
|];
];
B [ T "conspiracy to misuse"; Indef; thing ];
T "tax evasion";
T "fare evasion";
B [ T "conduct unbecoming"; Indef; profession ];
B [ T "deployment of"; Indef; thing ];
B [ R[|T "provision of"; T "distribution of"|]; R[|
B[Indef; thing];
thingp;
Fn CrimeDrug.gen;
|];
O(R[|T"to minors"; T"to a minor"|]);
];
B [ Tv "purchase of"; Indef; thing ];
B [ Tv "delivery of"; Indef; thing; T "to"; Indef; profession];
|] and gerundcrime = R [|
B [ T "impersonating"; Indef; profession ];
B [ T "breaking and"; doing; ];
B [ T "practicing"; O prefix; practice; ];
B [ T "practicing the"; instrument; ];
B [ Tv "approaching"; Indef; profession ];
B [ T "receiving stolen"; thingp ];
B [ T "deploying"; Indef; thing ];
T "being horny";
T "marketing";
T "advertising";
T "unlawful restraint";
T "trespassing";
T "creating a nuisance";
T "creating a public nuisance";
T "causing a ruckus";
|] and doing = R [|
Tv "entering";
T "decorating";
Tv "invoking";
Tv "evoking";
Tv "insulting";
Tv "advertising";
T "mentoring";
T "bantering";
T "yiffing";
T "posting";
T "tweeting";
T "blogging";
T "hollering";
T "yelling";
T "bartering";
T "matriculating";
T "berating";
T "bothering";
T "irritating";
T "copulating";
T "titillating";
T "aggravating";
|] and practice = R [|
T "falconry";
T "dentistry";
T "philosophy";
T "linguistics";
T "conjuration";
Tv "illusion";
T "mathematics";
T "set theory";
T "math";
T "physics";
Tv "astrophysics";
T "natural philosophy";
T "chemistry";
T "engineering";
T "marketing";
T "advertising";
T "blogging";
T "tweeting";
T "posting";
B[T "forensic"; practice];
|] and instrument = R [|
T "clarinet";
T "piano";
Tv "oboe";
T "flute";
T "violin";
|] and thing = R [|
T "clarinet";
T "piano";
T "deadly weapon";
T "dread weapon";
T "firearm";
T "weapon";
T "sex doll";
T "rhinocerous";
T "farm animal";
T "landmine";
T "rocket launcher";
T "rocket-propelled grenade";
T "grenade";
T "ballistic missile";
T "ICBM";
T "rifle";
T "vibrator";
Tv "assault rifle";
Tv "assault weapon";
Tv "automatic weapon";
Tv "artifact";
Tv "dread artifact";
Tv "cursed artifact";
Tv "orb";
T "cursed object";
Tv "infectious disease";
T "nuclear weapon";
T "bioweapon";
T "chemical weapon";
T "memetic hazard";
T "metaphor";
T "simile";
Tv "analogy";
T "turkey baster";
T "rolling pin";
T "household item";
Tv "appliance";
T "blog";
T "post";
T "tweet";
T "snake";
|] and thingp = R [|
T "clarinets";
T "pianos";
T "deadly weapons";
T "dread weapons";
T "firearms";
T "weapons";
T "sex dolls";
T "rhinoceri";
T "farm animals";
T "landmines";
T "rocket launchers";
T "rocket-propelled grenades";
T "grenades";
T "ballistic missiles";
T "ICBMs";
T "rifles";
T "vibrator";
T "handcuffs";
Tv "assault rifles";
Tv "assault weapons";
Tv "automatic weapons";
Tv "artifacts";
Tv "dread artifacts";
Tv "cursed artifacts";
Tv "orbs";
T "hazardous materials";
T "gender";
T "cursed objects";
Tv "infectious diseases";
Tv "internet access";
T "nuclear material";
T "nuclear weapons";
T "bioweapons";
T "chemical weapons";
T "memetic hazards";
T "cognitohazardous materials";
T "propaganda";
T "metaphors";
T "similes";
Tv "analogies";
T "turkey basters";
T "rolling pins";
T "household items";
Tv "appliances";
T "stolen property";
T "blogs";
T "posts";
T "tweets";
T "snakes";
|] and profession = R [|
T "public official";
Tv "officer of the law";
T "justice of the peace";
T "locksmith";
T "blacksmith";
T "silversmith";
T "magician";
T "conjurer";
Tv "illusionist";
T "criminal";
T "career criminal";
T "drug dealer";
T "schoolteacher";
T "con artist";
T "conman";
T "burglar";
T "poet";
Tv "artisan";
Tv "artist";
T "courtesan";
T "street artist";
T "bartender";
T "cattle rustler";
T "celebrity";
T "blogger";
T "mommyblogger";
B [ T "professor of"; practice ];
B [ T "master of"; practice ];
B [ practice; T "master" ];
B [ practice; T "professor" ];
B [ practice; T "expert" ];
B [ thing; T "expert" ];
|] and prefix = R [|
Tv "unjustified";
Tv "unjustifiable";
T "justifiable";
Tv "unspeakable";
T "tactless";
Tv "indecent";
Tv "intemperate";
Tv "attempted";
Tv "unlawful";
T "malicious";
Tv "aggravated";
T "dread";
T "horny";
T "erotic";
T "sexual";
T "careless";
T "negligent";
T "first-degree";
T "second-degree";
T "third-degree";
T "culpable and reckless";
T "criminal";
T "illegal";
T "forcible";
T "fractal";
T "obnoxious";
|] and suffix = R [|
B [ T "with intent to commit"; crime ];
T "in a public place";
T "in a court of law";
T "on public transit";
T "on the high seas";
Tv "in anger";
T "without a license";
T "without lawful cause";
B [ T "in the commission of"; crime ];
B [ T "with"; Indef; thing ];
B [ T "with"; thingp ];
B [ T "with multiple"; thingp ];
T "with intent to provoke a breach of the peace";
T "with intent to commit a breach of the peace";
B [ T "while acting in an official capacity"; O(B[T"as"; Indef; profession])];
B [ T "in the presence of"; Indef; profession ];
T "in the first degree";
T "in the second degree";
T "in the third degree";
T "in the vicinity of a school";
T "with malice aforethought";
T "with malicious intent";
T "with violent intent";
B [ T "unbecoming"; Indef; profession ];
T "under false pretenses";
|]
let charge = R [|
B[ O prefix; crime; O suffix; ];
B[ prefix; practice; O suffix; ];
B[ gerundcrime; O suffix; ];
|]
let rec eval node : word list = match node with
| T x -> [A x]
| Tv x -> [An x]
| B l -> List.fold_left (fun (a:word list) (n:node) : word list -> a @ (eval n)) [] l
| P p -> [Punctuation p]
| R a -> eval(pick a)
| O n -> if chance 2 then eval n else []
| Fn f -> [f ()]
| Indef -> [Article]
| N n -> eval n (* unnecessary? *)
| C n -> match eval n with
| A i :: rs-> A(String.capitalize_ascii i) :: rs
| An i :: rs-> An(String.capitalize_ascii i) :: rs
| _ as i -> i
(* TODO: make tail-recursive *)
let rec flatten (s : word list) : string = match s with
| Article :: A w :: rs -> " a "^w^(flatten rs)
| Article :: An w :: rs -> " an "^w^(flatten rs)
| Punctuation p :: rs -> p^(flatten rs)
| A w :: rs | An w :: rs -> " "^w^(flatten rs)
| [] -> ""
| _ -> assert false
let numbers = R [| T "two"; T "three"; T "four"; T "five"; T "six"; T "seven";
Tv "eight"; T "nine"; T "ten"; |]
let court = B[
R[|T "the"; T "this"; |];
O(R[|T "august"; T "noble"; T "glorious"; T "honorable"; T "grand";
T "eminent"; T "splendid"; T "superb"; T "infallible"; T "holy";
T "supreme";|]);
R[|T "court"; T "tribunal"; T "court of law"; T "committee";
Tv "inquisition"; |];
]
let accusation = C(B [
Tv "you";
R [|
R[|
B[
T "stand";
R[|
T "here";
B[T "before"; court;];
|];
O(T "today");
]
|];
Tv "are";
|];
R[|
B[T "to face justice for"; O(B[numbers; T "counts of"])];
B[
R[|
Tv "accused";
T "to face charges";
T "to answer charges";
|];
R[|
B[Tv "on"; numbers; T "counts of"];
Tv "of";
|]
];
|];
charge;
P ".";
O(R[|
T "How do you plead?";
T "What say you?";
T "How do you answer the charges?";
T "What is your plea?";
T "Explain yourself!";
|]);
])
let sentence = B[
R[|
B[
R[| T "You are"; T "The defendant is"; T "The accused party is"; |];
O(T "hereby");
O(T "stripped of all rank and");
R[|T "sentenced"; T "condemned"|];
];
B[
Tv "I";
O(T "hereby");
R[|T "sentence"; T "condemn"|];
R[| T "you"; T "the defendant"; T "the accused party";|];
];
|];
T "to";
]
let determiner = [| T "your"; T "your own"; T "the"; |]
let sdet = R (Array.concat [ determiner; [| T "a"; T "this"; T "that"; |] ])
let pdet = R (Array.concat [ determiner; [| T "these"; T "those"; |] ])
let condemnation = B[
sentence;
R[|
B[ T "die";
O(T "screaming");
O(T "in agony");
O(B[
T "by";
O(T "prolonged");
O(T "ritual");
O(T "public");
R[| T "beheading"; T "strangulation"; T "torture";
T "industrial negligence"; T "slow slicing"; T "lethal injection";
T "disembowelment"; T "drowning"; T "drowning at sea"; T "burning";
T "burning at the stake"; T "emasculation"; T "irradiation";
T "stabbing"; T "poisoning"; T "flaying"; T "roasting";
T "boiling"; T "boiling in oil"; T "boiling in acid";
T "crucifixion"; |]
]);
];
T "hang";
T "hang until dead";
T "hang until you are dead";
T "be drawn and quartered";
T "drown";
T "drown at sea";
T "burn";
T "burn at the stake";
T "be burned";
T "be burned at the stake";
T "be broken on the wheel";
T "be torn apart by wild horses";
T "snakes";
B[ R[|
T "forfeit";
T "be deprived of";
T "be given";
T "be subjected to";
|];
R[|
B[ O(pdet); thingp; ];
B[ sdet; thing; ];
|]
]
|];
O(R[|
B[
T "at";
R[|
T "dawn"; T "dusk"; T "noon"; T "high noon"; T "sunrise"; T "sunset";
|]
];
T "within one week";
T "within the hour";
T "by day's end";
|])
]
let imprisonment = B[
sentence;
O( T "spend" );
R[|
B[
R[|T "two"; T "three"; T "four"; T "five"; T "six"; T "seven";
Tv "eight"; T "nine"; T "ten";|];
R[|T "seconds"; T "minutes"; T "days"; T "weeks"; T "years"; T "decades"; T "millennia";
T "hundred years"; T "thousand years"; Tv "eons"; Tv "ages"; Tv "eras"; T "million years";
T "billion years"; T "trillion years"; |];
];
B[
R[|Indef;Tv "one";|];
R[|T "second"; T "minute"; T "day"; T "week"; T "year"; T "decade"; T "millennium";
T "hundred years"; T "thousand years"; Tv "eon"; Tv "age"; Tv "era"; T "million years";
T "billion years"; T "trillion years"; |];
];
Tv "a lifetime";
Tv "an eternity";
|];
R[|Tv "of community service"; Tv "in state prison"; Tv "in federal prison"; Tv "in prison";
Tv "of jail time"; Tv "of prison time"; B[T "without"; R[|B[Indef; thing];thingp|];];
Tv "alone"; T "in the gulag"; Tv "in a labor camp"; Tv "in the county jail";
T "thinking about what you've done"; Tv "of penance"; Tv "in the Box";
Tv "in the Shame Cube"; Tv "in the nightmares of children";
Tv "in a magic lamp";Tv "in a cursed mirror"; Tv "of indentured servitude"; Tv "of slavery";|];
]
let status = R[|
T "citizenship";
T "rank";
T "all rank";
T "all status";
T "all rights";
T "all privileges";
T "all clearances";
T "all certifications";
|]
let banishment = B [
R[|
B[
T "You are";
O(T "hereby");
O(B[T "stripped of your citizenship and";]);
O(T "forever");
R[|T "exiled"; T "banished";|];
];
B[
R[|T "The defendant is"; T "The accused party is"; |];
O(T "hereby");
O(B[T "stripped of"; R[|T"her"; T"his"; T"its"; T"their";|]; T "citizenship and";]);
O(T "forever");
R[|T "exiled"; T "banished";|];
];
B[
Tv "I";
O(T "hereby");
O(T "strip you of your citizenship and");
R[|T "exile"; T "banish";|];
T "you";
O(T "forever");
];
|];
O(B[
T "from";
R[|
T "the Realm";
T "the Kingdom";
T "the Empire";
T "the Republic";
T "the Federation";
|];
]);
O(B[
T "to";
O(B[O(T"forever"); T "wander"]);
T "the";
R[|
T "howling";
T "dark";
T "empty";
T "abyssal";
T "cursed";
T "abandoned";
T "barbarous";
T "forgotten";
T "lost";
T "forsaken";
T "desert";
|];
R[|
T "marshes";
T "woods";
T "forest";
T "marsh";
T "plain";
T "plains";
T "wastes";
T "pit";
T "shores";
T "desert";
|];
]);
]
let order = B [
R[|
B[
R[| T "You are"; T "The defendant is"; T "The accused party is"; |];
O(T "hereby");
O(B[T "stripped of"; status; Tv "and";]);
R[|T "ordered"; T "commanded"; T "enjoined"; T "required";|];
];
B[
Tv "I";
O(T "hereby");
R[|
B[T "strip you of"; status; T "and";
R[|T "order"; T "command"; T "enjoin"; T "require";|];
T "you";
];
|];
];
|];
T "to";
R[|
B[T "perform"; R[|T "one"; numbers;|]; T "hundred jumping jacks"];
T "make amends";
T "beg for forgiveness";
T "do the right thing";
T "bleed";
T "sacrifice your firstborn";
T "forever quit the land of your birth";
B[
T "pay a fine of";
numbers; (* TODO better numbers *)
O(R[|T "hundred"; T "thousand"; T "hundred thousand"; T "million"; T "billion"; T "trillion";|]);
R[| T "dollars"; T "credits"; T "units"; T "cows"; T "heads of cattle"; T "sand dollars";
T "gold"; T "silver"; T "pounds"; T "pence"; T "pounds stirling"; T "talents";
T "sovereigns"; T "dried yak teeth"; T "cursed fairy coins"; T "ultradollars";|];
];
|];
]
let reduce = B [
R[|
B[
R[| T "You are"; T "The defendant is"; T "The accused party is"; |];
O(T "hereby");
O(B[T "stripped of"; status; Tv "and";]);
R[|T "condemned"; T "reduced"; T "reassigned";|];
];
B[
Tv "I";
O(T "hereby");
R[|
B[T "strip you of"; status; T "and";
R[|T "condemn"; T "reduce"; T "reassign";|];
T "you";
];
B[
T "strip";
R[|T "the defendant"; T "the accused party";|];
Tv "of"; status; T "and";
R[|T "condemn"; T "reduce"; T "reassign";|];
R[|T "her"; T "him"; T "it"; T "them";|];
];
B[
R[|T "condemn"; T "reduce"; T "reassign";|];
R[|T "you"; T "the defendant"; T "the accused party";|];
];
|];
];
|];
T "to";
R[|
T "slavery";
T "undercaste status";
T "prole status";
T "servitude";
T "Infrared Clearance";
T "unskilled labor";
T "kitchen duty";
T "sanitation duty";
T "court jester";
|];
]
let conviction = C(B [
O(B[
R[|
B[Tv "in the";
R[|T"great and terrible";T"tremendous";T"eternal";T"superb and tremendous";
T"solemn";T"unblemished";T"supreme";T"boundless";T"sublime";T"wretched";
T"great and wretched";T"solemn, supreme, eternal, and tremendous"|];
R[|T"name";T"sight";T"name and sight";|]];
B[T "by the";
R[|T"grace";T"power";T"grace and power";T"will";|]];
|];
Tv "of";
R[|
T "the Queen"; T "the King"; T "her Majesty the Queen"; T "his Majesty the King";
T "all that is holy"; T "justice"; T "God"; T "the Lord"; T "the Sultan"; T "the Caliph";
T "the Prince"; T "the Princess"; T "the Realm"; T "the Kingdom"; T "our infernal master";
T "Satan"; T "Lucifer"; T "Heaven"; T "the heavens"; T "the Prophet"; T "Yaldabaoth";
T "Heaven and all its angels"; T "our Creator"; T "the Maker"; T "the spirits";
T "our great and wretched God"; T "the People"; T "the People of the State of Kentucky";
|];
P ",";
]);
R[|
B[court;
O(T "hereby");
R[| T "finds"; T "declares"; T "proclaims"; T "pronounces"; T "judges"; Tv "adjudges";|];
];
B[Tv "I";
O(T "hereby");
R[| T "find"; T "declare"; T "proclaim"; T "pronounce"; T "judge"; Tv "adjudge"|];
]
|];
R[| T "you"; T "the defendant"; T "the accused party";|];
T "guilty";
O(Tv "on all counts");
Tv "of";
charge;
P".";
O(B[
R[|imprisonment; reduce; order; banishment; condemnation; T"Get in the Crime Hole";|];
P".";
]);
])
let global = R[|conviction; accusation;|]
let () = Random.self_init ();
print_string
(String.trim
(flatten
(eval global)))