procgen  Check-in [275f19cd9e]

	(i " is an ideological descendent of " (ideology) (: (" and " (ideology))))
	(i (@
		 (" was " (one-of "developed" "designed" "created" )
		  	(@ (" by ")
			   (" for ")
			   ( (: (" by " (group)))
				(one-of " to address the needs of "
						" in the class interests of "))))
		 (" only " (one-of "centers" "uplifts" "liberates"
						   "cares about" "addresses the needs of"))
		 ((one-of " only" "") (one-of " centers " " cares about ")
							  (? "the " (one-of "needs"
												"struggles"
												"voices"
												"experiences"
................................................................................
								(" " (cause-provoke) " the defeat of " i)))
	  ((problem) " cannot be distinguished from " i)
	  (i " and " (ideology) " cannot be distinguished")
	  (i " and " (ideology) " will produce the same result")

	  ((group) " " (modal) (@ (" be exploited")
							  (" still be exploited")
							  (" be exploited under " i)
							  (" still be exploited under " i)
							  (" face " (problem))))

	  ((group) " " (modal-rnd) " " (action))

	  (i " " (modal) " kill " (group))

	  ((thing) " is " (adjfor (adjective) " for " (group)))
	  ((things) " are " (adjfor (adjective) " for " (group)))

	(i " is an ideological descendent of " (ideology) (: (" and " (ideology))))
	(i (@
		 (" was " (one-of "developed" "designed" "created" )
		  	(@ (" by ")
			   (" for ")
			   ( (: (" by " (group)))
				(one-of " to address the needs of "
						" in the class interest of "))))
		 (" only " (one-of "centers" "uplifts" "liberates"
						   "cares about" "addresses the needs of"))
		 ((one-of " only" "") (one-of " centers " " cares about ")
							  (? "the " (one-of "needs"
												"struggles"
												"voices"
												"experiences"
................................................................................
								(" " (cause-provoke) " the defeat of " i)))
	  ((problem) " cannot be distinguished from " i)
	  (i " and " (ideology) " cannot be distinguished")
	  (i " and " (ideology) " will produce the same result")

	  ((group) " " (modal) (@ (" be exploited")
							  (" still be exploited")
							  (" be subjected to " (problem))

							  (" face " (problem))) (? " under " i))

	  ((group) " " (modal-rnd) " " (action))

	  (i " " (modal) " kill " (group))

	  ((thing) " is " (adjfor (adjective) " for " (group)))
	  ((things) " are " (adjfor (adjective) " for " (group)))

    Plain "prayed for";             Plain "prayed away";
    Plain "snacked";             Plain "snacked up";
    Plain "snacked out";             Plain "snacked away";
|]
let roas = [| "on"; "shooting up"; "using"; "mainlining"; "snorting"; "vaping"; "smoking"; "cybering";
    "sucking down"; "gargling"; "doing"; "trying"; "slurping"; "guzzling"; "popping"; "downing"; "chewing"; "pooping"; "shitting"; "pissing";
    "crunching"; "sniffing"; "zapping"; "downloading"; "dropping"; "cooking up"; "freebasing"; "hooting"; "tooting"; "blasting"; "blazing";
    "tweeting"; "honking"; "plugging"; "plugging in"; "hooking up"; "turning on"; "boofing"; "whacking"; "choking"; "ravishing"; "looting"; "slaughtering";
    "drinking"; "eating"; "slugging"; "ghouling" |]
let vroas = [| "shoot up"; "mainline"; "snort"; "vape"; "smoke"; "slurp"; 
    "suck down"; "gargle"; "do"; "try"; "guzzle"; "pop"; "down"; "chew"; "crunch"; "poop"; "shit"; "piss"; "blast"; "blaze";
    "sniff"; "zap"; "download"; "drop"; "cyber"; "cook up"; "toot"; "hoot"; "plug"; "plug in";
    "hook up"; "turn on"; "boof"; "whack"; "choke"; "drink"; "eat"; "slug"; "ghoul"; "freebase"; "ravish"; "loot"; "slaughter";|]
module Pronoun = struct
	type t = {
		nom : string; obl : string; gen : string;
		refl : string; cop : string; brevcop : string;
		pl : bool;
	}
	let you = {nom = "you"; obl = "you"; gen = "your"; refl = "yourself";

    Plain "prayed for";             Plain "prayed away";
    Plain "snacked";             Plain "snacked up";
    Plain "snacked out";             Plain "snacked away";
|]
let roas = [| "on"; "shooting up"; "using"; "mainlining"; "snorting"; "vaping"; "smoking"; "cybering";
    "sucking down"; "gargling"; "doing"; "trying"; "slurping"; "guzzling"; "popping"; "downing"; "chewing"; "pooping"; "shitting"; "pissing";
    "crunching"; "sniffing"; "zapping"; "downloading"; "dropping"; "cooking up"; "freebasing"; "hooting"; "tooting"; "blasting"; "blazing";
    "tweeting"; "honking"; "plugging"; "plugging in"; "hooking up"; "turning on"; "boofing"; "whacking"; "choking"; "ravishing"; "looting"; "slaughtering"; "drinking"; "eating"; "slugging"; "ghouling"; "scrobbling"; |]

let vroas = [| "shoot up"; "mainline"; "snort"; "vape"; "smoke"; "slurp"; 
    "suck down"; "gargle"; "do"; "try"; "guzzle"; "pop"; "down"; "chew"; "crunch"; "poop"; "shit"; "piss"; "blast"; "blaze";
    "sniff"; "zap"; "download"; "drop"; "cyber"; "cook up"; "toot"; "hoot"; "plug"; "plug in";
    "hook up"; "turn on"; "boof"; "whack"; "choke"; "drink"; "eat"; "slug"; "ghoul"; "freebase"; "ravish"; "loot"; "slaughter"; "scrobble";|]
module Pronoun = struct
	type t = {
		nom : string; obl : string; gen : string;
		refl : string; cop : string; brevcop : string;
		pl : bool;
	}
	let you = {nom = "you"; obl = "you"; gen = "your"; refl = "yourself";

(include "lib/lisp-macro.scm")
(include "lib/interlace.scm")
(include "lib/bot.scm")

(define (fail . msg)
	(display (string-append "\x1b[1;31m - err.\x1b[0m " 
							(apply string-append msg)))
	(exit 1))
(define (fail:sym s)
  (fail "bad form \x1b[3;36m'" (symbol->string s) "\x1b[0m"))

(define-macro (fn . b) (cons 'lambda b)) ; your honor, they made me do it

(define (verb inf ger pst ppl)
  (fn (form)
	  (define (is f) (equal? form f))
	  (cond 
		((is 'inf) inf) ((is 'ger) ger)
		((is 'pst) pst) ((is 'ppl) ppl)
		(else (fail:sym form)))))

(define (word-append . body)
  (define (vowel? c) (member c '("a" "e" "i" "o" "u")))
  (define (join acc lst)
	(if (eq? lst '()) acc
		(let ([word (car lst)]
			  [tail (cdr lst)])
		  (if (eq? word '()) (join acc tail)
			  (join (string-append acc (if (equal? acc "") "" " ")
				 (if (not (equal? word "a")) word
					 (if (eq? tail '()) "a"
						 (let* ([next-word (car tail)]
								[onset (substring next-word 0 1)])
						   (if (vowel? onset) "an" "a"))))) tail)))))
  (join "" body))


(define-macro (verb-form . body)
			  (define (make-id . body)
				(string->symbol (apply string-append body)))

			  (define (finalize-rule r)
				(define (finalize-sub-rule s)
				  (if (list? s) `(string-append ,@s) s))
				(let* ([rule-name (car r)]
					   [rule-body (cdr r)])
				  `(define (,rule-name *o*)
					 (word-append ,@(map finalize-sub-rule rule-body)))))

			  (let* ([proc-def  (car body)]
					 [proc-name (symbol->string (car proc-def))]
					 [proc-args (cdr proc-def)]
					 [defs      (cdr body)])

			  `(define (,(make-id "verb:" proc-name) ,@proc-args)
				 ,@(map finalize-rule defs) (verb inf ger pst ppl))))

(link-vector 'words
			   fuck: (verb:weak "fuck")  
			 clench: (verb:weak "clench") 
			 '(verb:weak "download")
			 '(verb:weak "cyber"))
 
(define (phrase vb pp)
  (lambda (form)
	(if (equal? form 'ppl)
		(lambda (*o*)
		  (word-append (string-append ((vb 'ppl) '()) "-" pp) *o*))
		(lambda (*o*)
		  (word-append ((vb form) *o*) pp)))))

(verb-form (weak stem)
		   ; e.g. suck → sucking
		   (inf [stem]       *o*)
		   (ger [stem "ing"] *o*)
		   (pst [stem "ed"]  *o*)
		   (ppl [stem "ed"]  *o*))

(verb-form (e stem)
		   ; e.g. vape → vaping
		   (inf [stem "e"]   *o*)
		   (ger [stem "ing"] *o*)
		   (pst [stem "ed"]  *o*)
		   (ppl [stem "ed"]  *o*))

(verb-form (heavy stem final)	; e.g. plug → plugging
		   (inf [stem final]       *o*)
		   (ger [stem final "ing"] *o*)
		   (pst [stem final "ed"]  *o*)
		   (ppl [stem final "ed"]  *o*))

(verb-form (strong stem pst ppl)	; e.g. drink → drank
		   (inf [stem]       *o*)
		   (ger [stem "ing"] *o*)
		   (pst [pst]        *o*)
		   (ppl [ppl]        *o*))

(verb-form (strong! stem pst)	; e.g. shoot → shot → shot
		   (inf [stem]       *o*)
		   (ger [stem "ing"] *o*)
		   (pst [pst]        *o*)
		   (ppl [pst]        *o*))



				(verb:weak		"crunch")
				(verb:weak	 	"snort" "snorting")
				(verb:heavy	 	"stab" "b")
				(verb:strong	"drink" "drank" "drunk")
				(verb:strong	"eat"   "ate"	"eaten")
				(verb:strong	"bite"	"bit"	"bitten")
				(verb:strong!	"shoot" "shot")
				
				))

(define verbs (interlace vector
	crunch. (verb:weak "crunch")
	(phrasal crunch "up")
	(phrasal crunch "off")
	(phrasal crunch "out")
	(phrasal crunch "away")

	fuck. (verb:weak "fuck")
	(phrasal fuck "up")
	(phrasal fuck "out")
	(phrasal fuck "off")))

; ʞ / interlace.scm
;   a scheme library by lexi hale
;
; (interlace) solves an age-old problem. what kind of data structure
; do you use when you need both an aggregate (a list, a vector) of
; items but also to be able to individually refer to those items by
; name? this problem is effectively unsolvable in C and C++ without
; inordinate runtime overhead, and there's no native syntax for it
; in Scheme. however, by rewriting the AST, we can implement a clean,
; performant, low-cost solution ourselves, thanks to the fact that
; (let*) bindings are expressions.
;
; interlace takes a constructor function, e.g. (vector) or (list),
; a list of items, and returns an expression calling that constructor
; on a list of all items defined in it. if an item is proceded by
; an atom that ends in a period (e.g. “name.”), it is defined within
; a (let*) expression, and its name is then included among the
; arguments passed to the constructor function.
;
; the upshot of this is that items can reference other items by name
; *as they are being defined*. for instance:
;
;	(define verbs (interlace vector
;	                         talk. (verb "talk" "talking" "talked")
;		                         (phrasal-verb talk "to")
;		                         (phrasal-verb talk "about")
;		                     (verb "say" "saying" "said)))
;
; here, the function to generate a phrasal verb exhibits backreference
; to an existing verb contained alongside it in the vector. note that 
; the name bindings are ephemeral; they do not survive the immediate
; context of the constructor.

(define-macro (interlace . body)
  ; given a list with both named and nameless members, identify
  ; which is which and instate the vector.
  (define (name? term)
	(define (coda str) (substring str
								  (- (string-length str) 1)
								  (string-length str)))
	(if (not (symbol? term)) #f
		(let* ([term-string (symbol->string term)]
			   [final-char (coda term-string)])
		  (print "TERMSTRING:" term-string)
		  (print "CHAR:" final-char)
		  (if (not (equal? final-char ".")) #f
			  (substring term-string 0 (- (string-length term-string) 1))))))

  (define (divide-entries lst @named @nameless)
	; given a list, return a pair [ x . y ] such that x is a list
	; of named terms ( name . term ) and y is a list of nameless
	; terms.
	(if (eq? lst '()) (cons @named @nameless)
		(let* ([head (car lst)]
			   [tail (cdr lst)]
			   [name (name? head)])
		  (if (eqv? name #f)
			  ; there's no name term; add this to the nameless
			  ; list and move on the next iteration
			  (divide-entries tail @named (cons head @nameless))

			  ; head is a name, so determine its value, cons them
			  ; together, and add that cons to the list of named
			  ; lists
			  (let* ([val (car tail)]
					 [new-tail (cdr tail)]
					 [named (list name val)])
				(divide-entries new-tail
					(cons named @named) @nameless))))))
  (let* ([structure          (car body)]
		 [-structure-entries (cdr body)]
		 [-divided-lists     (divide-entries -structure-entries '() '())]
		 [named-terms        (car -divided-lists)]
		 [nameless-terms     (cdr -divided-lists)])
	`(let* ,(reverse named-terms)
	  (,structure ,@nameless-terms
				  ,@(map car named-terms)))))