procgen  crime.ml at [93b72b5a88]

File crime.ml artifact a935c1d4c7 part of check-in 93b72b5a88


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 "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";
|] and doing = R [|
	Tv "entering";
	T "decorating";
	Tv "invoking";
	Tv "evoking";
	Tv "insulting";
	Tv "advertising";
	Tv "mentoring";
	Tv "bantering";
	Tv "yiffing";
	Tv "posting";
	Tv "tweeting";
	Tv "blogging";
|] and practice = R [|
	T "falconry";
	T "dentistry";
	T "philosophy";
	T "linguistics";
	T "conjuration";
	T "illusion";
	T "mathematics";
	T "set theory";
	T "math";
	T "physics";
	T "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 "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 "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";
|] and thingp = R [|
	T "clarinets";
	T "pianos";
	T "deadly 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 "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";
|] 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";
|] 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 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 "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 "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";
	|];
	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;
	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 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"name";T"sight";T"name and sight";T "great and terrible name";|]];
			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";
		|];
		P ",";
	]);
	R[|
		B[court;
			O(T "hereby");
			R[| T "finds"; T "declares"; T "proclaims"; T "pronounces"; T "judges"; Tv "adjuges";|];
		];
		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)))