@@ -1,22 +1,62 @@ -(include "bot.scm") +(include "lib/lisp-macro.scm") +(include "lib/bot.scm") -(define actors - '#(me you thou they him her myself "your mother" "your mom" "your father" - "your dad" "your aunt" "your uncle" "your dog")) +(rule (maybe x) (x) ("")) +(rule (maybe_ x) (x " ")) +(rule (maybe* x) ((x)) ("")) +(rule (maybe_* x) ((x) " ") ("")) +(bank pronoun 'me 'you 'thou 'they 'him 'her 'myself) (define pronouns '( - (you (nom . "you") (acc . "you") (gen . "your") (poss . "yours") ) - (thou (nom . "thou") (acc . "thee") (gen . "thy") (poss . "thine") ) - (they (nom . "they") (acc . "them") (gen . "their") (poss . "theirs") ) - (him (nom . "he") (acc . "him") (gen . "his") (poss . "his") ) - (her (nom . "her") (acc . "her") (gen . "hers") (poss . "hers") ) - (me (nom . "I") (acc . "me") (gen . "my") (poss . "mine") ) - (myself (nom . "I") (acc . "myself") (gen . "my own") (poss . "my own")))) + (you (nom . "you") (acc . "you") (gen . "your") (poss . "yours") (cop . "you're")) + (thou (nom . "thou") (acc . "thee") (gen . "thy") (poss . "thine") (cop . "thou art")) + (they (nom . "they") (acc . "them") (gen . "their") (poss . "theirs") (cop . "they're")) + (her (nom . "her") (acc . "her") (gen . "her") (poss . "hers") (cop . "she's")) + (him (nom . "he") (acc . "him") (gen . "his") (poss . "his") (cop . "he's")) + (me (nom . "I") (acc . "me") (gen . "my") (poss . "mine") (cop . "I'm")) + (myself (nom . "I") (acc . "myself") (gen . "my own") (poss . "my own") (cop . "I'm")))) + +(define (thy x) (string-append (inflect 'gen (pronoun)) " " x)) + +(bank article 'def 'indef 'dem-prox 'dem-dist) +(define (decline art nm n) + ; art = (def indef dem-prox dem-dist) + (let* ([sg (if (pair? (cdr n)) (cadr n) (cdr n))] + [pl (if (pair? (cdr n)) (cddr n) (string-append sg "s"))] + [vwl (car n)] + [sel (if (eq? nm 'sg) sg pl)]) + (apply string-append (case art + ((def) (list "the " sel)) + ((indef) (case nm + ((sg) (case vwl + ((a) (list "a " sel)) + ((an) (list "an " sel)))) + ((pl) (list sel)))) + ((dem-prox) (case nm + ((sg) (list "this " sel)) + ((pl) (list "these " sel)))) + ((dem-dist) (case nm + ((sg) (list "that " sel)) + ((pl) (list "those " sel)))))))) + +(bank relatives + "mother" "mom" "father" "dad" "aunt" "uncle" "dog" "friend" "granny" + "grandma" "grandfather" "grandpa" "grandmother") +(bank jobs + '(a . "banker") '(a ."porn star") '(a . "general") '(a . "president") + '(a . "janitor") '(an ."executive") '(a . ("sheep" . "sheep")) '(a . ("spy" . "spies")) + '(a . "fed") '(a . "war criminal")) + +(rule (actors) + ((pronoun)) + ((thy (relatives))) + ((decline (article) (one-of 'sg 'pl) (jobs))) + ((inflect 'gen (pronoun)) " " (relatives))) (define (conjugate v t n) (if (eq? v 'cop) - (case (cons t n) + (case (cons t n) ))) (define (inflect c n) (if (string? n) @@ -23,20 +63,35 @@ (case c ((nom acc) n) ((gen poss cop) (string-append n "'s"))) ; else - (cdr (assq c (cdr (assq n pronouns)))))) + (cdr (assq c (cdr (assq n pronouns)))))) + +(bank organ + "balls" "gut" "face" "head" "nose" "brain" "heart" + "ass" "tits" "duodenum" "kidneys" "pooper") (rule (action victim) - ("port " victim " to lisp") - ("rain on " victim "'s parade")) + ("port " (inflect 'acc victim) " to lisp") + ("rain on " (inflect 'gen victim) " parade") + ((one-of "shoot" "stab") " " (inflect 'acc victim) " in the " (organ)) + ("impale " (inflect 'acc victim) + (@ ("") (" on " (one-of "the flagpole" "a spike" "the terrorspike")))) + ("demolish " (inflect 'gen victim) " house") + ("have " (inflect 'acc victim) " " (one-of "sent" "deported") " " + (maybe "straight ") "to " + (one-of "Siberia" "the north pole" "Betelgeuse" "the moon" "Cleveland"))) (rule (subject actor) ((inflect 'cop actor) " gonna") - ((inflect 'nom actor) " swear")) + ((inflect 'cop actor) " " (one-of "fixing" "plotting" "planning" "scheming") " to")) + ; ((inflect 'nom actor) " swear to")) + +(rule (clause actor victim) + ((subject actor) " " (action victim))) -(print - (inflect - (pick '#(nom acc gen poss)) - (pick actors))) +(print (clause (actors) (actors))) + ; ((inflect + ; (pick '#(nom acc gen poss)) + ; (pick actors))) ;(print (action "you"))