type root = R of string | I of string*string
type kind = Plain | Vowel | Uncountable
type word = root * kind
let pick a = a.(Random.int (Array.length a))
let words = [|
(R "egret", Vowel); (I("knife","knives"), Plain); (I("child","children"), Plain);
(R "owl", Vowel); (R "dawn", Uncountable); (R "dawn", Plain);
(R "relic", Plain); (R "home", Plain); (R "hope", Plain);
(R "tower", Plain); (R "plain", Plain); (R "fire", Plain);
(R "fire", Uncountable); (R "fear", Plain); (R "fear", Uncountable);
(R "whisper", Plain); (R "furrow", Plain); (R "field", Plain);
(R "regret", Plain); (R "blade", Plain); (R "thing", Plain);
(R "pillar", Plain); (R "fate", Plain); (R "doom", Plain);
(R "candle", Plain); (R "lantern", Plain); (I("sky","skies"), Plain);
(I("grass","grasses"), Plain); (I("ash","ashes"), Vowel); (R "void", Plain);
(R "stranger", Plain); (R "blood", Uncountable); (R "incompetence", Uncountable);
(R "holiness", Uncountable); (R "sorrow", Uncountable); (R "gladness", Uncountable);
(R "unkindness", Uncountable); (I("cruelty","cruelties"), Plain);
(R "cruelty", Uncountable); (R "ember", Vowel); (R "throat", Plain);
|]
let adjs = [|
"sorrowful";"fiery";"unkind";"fallow";"sallow";"hollow";"unending";"wondrous";
"vapid";"dim";"shallow";"glorious";"empty";"failing";"dying";"crawling";"ashen";
"furious";"frightened";"terrible";"awful";"eternal";"silent";"frightful";"timeless";
"golden";"black";"white";"noble";"defunct";
|]
let verbs = [|
R "burn", true; R "fear",true; R "slaughter",true; R "explode",false;
R "interrogate",true; R "sleep",false; R "despair",false; R "dissolve",true;
R "question",true; R "slay",true; R "stay",false; R "fade",false;
I("wonder at", "wonders at"),true; R "linger",false; R "die",false;
I("cry out", "cries out"),false; I("cry out at","cries out at"),true;
I("cry","cries"),false; R "weep", false;
I("cry out to","cries out to"),true;
|]
let compl : root array = [| R "hope"; R "believe"; I("wonder if","wonders if"); |];;
let sg (r:root) : string = match r with
| R x -> x
| I(x,_) -> x;;
let pl (r:root) : string = match r with
| R x -> x^"s"
| I(_,x) -> x;;
let indef (w:word) : string = let (r,k) = w in (match k with
| Plain -> "a "
| Uncountable -> ""
| Vowel -> "an ") ^ (sg r);;
let pron () = pick [|
"it",false; "she",false; "he",false; "they",true;
"we",true; "you",true;
|]
let accpron() = pick [|
"it";"her";"him";"them";"us"
|]
let basenp () : string * bool= let w = pick words in
let (r,k) = w in
let adj = pick [|(pick adjs) ^ " ";""|] in
let rsg = adj ^ (sg r) in
let rpl = adj ^ (pl r) in
let sgs = [|
indef w;
"the " ^ rsg;
"yon " ^ rsg;
"this " ^ rsg;
"that " ^ rsg;
"my " ^ rsg;
"some " ^ rsg;
"your " ^ rsg;
"her " ^ rsg;
"our " ^ rsg;
"its " ^ rsg;
"their " ^ rsg;
"his " ^ rsg;
|] in let pls = [|
pl r;
"the " ^ rpl;
"these " ^ rpl;
"those " ^ rpl;
"my " ^ rpl;
"some " ^ rpl;
"yonder " ^ rpl;
"your " ^ rpl;
"her " ^ rpl;
"our " ^ rpl;
"its " ^ rpl;
"his " ^ rpl;
"their " ^ rpl;
|] in if k = Uncountable then (pick sgs,false) else pick [|(pick sgs,false);(pick pls,true)|]
let rec gp () : string*bool = let (n,p) = np () in (n ^ " of " ^ (let (n,_) = np() in n)), p
and relp () : string*bool = let (n,p) = basenp () in (n ^ " that " ^ (vp p)), p
and np () : string*bool = (pick [| basenp; basenp; basenp; gp; relp |])()
and pvp p = let verb, trans = pick verbs in
let v = (if p then sg else pl) verb in
let n, _ = (pick [| np(); accpron(),false |]) in
v ^ if trans then (" " ^ n) else ""
(* and cvp (p:bool) : string =
let verb = (pick compl) in
let v = (if p then sg else pl) verb in
let n,p = (pick [|np;pron|])() in
let d = decl n p in
v ^ " " ^ d -- THIS IS HORRIBLY BROKEN *)
and vp p = pvp p
and decl n p = n ^ " " ^ (vp p) ^ (pick [|
(fun()->".");
(fun()->", and " ^ (s()));
(fun()->", but " ^ (s()));
|]())
and idques n p = let n2, _ = np() in (if p then "are " else "is ")^n^" "^n2^"?"
and ques n p = (if p then "do " else "does ")^n^" "^(vp true)^"?"
and s () = let (n,p) = pick [|np;pron|] () in (pick [|decl;decl;ques;idques|]) n p;;
let rec times x f = if x > 0 then
(f (); times (x-1) f)
else
();;
(*let () = Random.self_init ();
times 10 (fun () -> let c = string_of_int ((Random.int 6)+1) in
print_string ("\x1b[1;3"^c^"m-\x1b[0;3"^c^"m "^(s ()) ^ "\n"));;*)
let () = Random.self_init (); print_string ((s ()) ^ "\n");;