Overview
| Comment: | add interlace.scm, update some shit |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
275f19cd9e17311f52e571a9d1d89876 |
| User & Date: | lexi on 2019-03-28 05:14:48 |
| Other Links: | manifest | tags |
Context
|
2019-03-30
| ||
| 03:45 | add libs check-in: 6822b7d006 user: lexi tags: trunk | |
|
2019-03-28
| ||
| 05:14 | add interlace.scm, update some shit check-in: 275f19cd9e user: lexi tags: trunk | |
|
2019-03-26
| ||
| 03:18 | mroe udptaes check-in: eda537ae1e user: lexi tags: trunk | |
Changes
Modified botsoc.scm from [670bc1717b] to [ebe2f71c7d].
300 300 (i " is an ideological descendent of " (ideology) (: (" and " (ideology)))) 301 301 (i (@ 302 302 (" was " (one-of "developed" "designed" "created" ) 303 303 (@ (" by ") 304 304 (" for ") 305 305 ( (: (" by " (group))) 306 306 (one-of " to address the needs of " 307 - " in the class interests of ")))) 307 + " in the class interest of ")))) 308 308 (" only " (one-of "centers" "uplifts" "liberates" 309 309 "cares about" "addresses the needs of")) 310 310 ((one-of " only" "") (one-of " centers " " cares about ") 311 311 (? "the " (one-of "needs" 312 312 "struggles" 313 313 "voices" 314 314 "experiences" ................................................................................ 351 351 (" " (cause-provoke) " the defeat of " i))) 352 352 ((problem) " cannot be distinguished from " i) 353 353 (i " and " (ideology) " cannot be distinguished") 354 354 (i " and " (ideology) " will produce the same result") 355 355 356 356 ((group) " " (modal) (@ (" be exploited") 357 357 (" still be exploited") 358 - (" be exploited under " i) 359 - (" still be exploited under " i) 360 - (" face " (problem)))) 358 + (" be subjected to " (problem)) 359 + (" face " (problem))) (? " under " i)) 361 360 362 361 ((group) " " (modal-rnd) " " (action)) 363 362 364 363 (i " " (modal) " kill " (group)) 365 364 366 365 ((thing) " is " (adjfor (adjective) " for " (group))) 367 366 ((things) " are " (adjfor (adjective) " for " (group)))
Modified drug.ml from [ed24373eb4] to [153c05522d].
261 261 Plain "prayed for"; Plain "prayed away"; 262 262 Plain "snacked"; Plain "snacked up"; 263 263 Plain "snacked out"; Plain "snacked away"; 264 264 |] 265 265 let roas = [| "on"; "shooting up"; "using"; "mainlining"; "snorting"; "vaping"; "smoking"; "cybering"; 266 266 "sucking down"; "gargling"; "doing"; "trying"; "slurping"; "guzzling"; "popping"; "downing"; "chewing"; "pooping"; "shitting"; "pissing"; 267 267 "crunching"; "sniffing"; "zapping"; "downloading"; "dropping"; "cooking up"; "freebasing"; "hooting"; "tooting"; "blasting"; "blazing"; 268 - "tweeting"; "honking"; "plugging"; "plugging in"; "hooking up"; "turning on"; "boofing"; "whacking"; "choking"; "ravishing"; "looting"; "slaughtering"; 269 - "drinking"; "eating"; "slugging"; "ghouling" |] 268 + "tweeting"; "honking"; "plugging"; "plugging in"; "hooking up"; "turning on"; "boofing"; "whacking"; "choking"; "ravishing"; "looting"; "slaughtering"; "drinking"; "eating"; "slugging"; "ghouling"; "scrobbling"; |] 270 269 let vroas = [| "shoot up"; "mainline"; "snort"; "vape"; "smoke"; "slurp"; 271 270 "suck down"; "gargle"; "do"; "try"; "guzzle"; "pop"; "down"; "chew"; "crunch"; "poop"; "shit"; "piss"; "blast"; "blaze"; 272 271 "sniff"; "zap"; "download"; "drop"; "cyber"; "cook up"; "toot"; "hoot"; "plug"; "plug in"; 273 - "hook up"; "turn on"; "boof"; "whack"; "choke"; "drink"; "eat"; "slug"; "ghoul"; "freebase"; "ravish"; "loot"; "slaughter";|] 272 + "hook up"; "turn on"; "boof"; "whack"; "choke"; "drink"; "eat"; "slug"; "ghoul"; "freebase"; "ravish"; "loot"; "slaughter"; "scrobble";|] 274 273 module Pronoun = struct 275 274 type t = { 276 275 nom : string; obl : string; gen : string; 277 276 refl : string; cop : string; brevcop : string; 278 277 pl : bool; 279 278 } 280 279 let you = {nom = "you"; obl = "you"; gen = "your"; refl = "yourself";
Added drug.scm version [6e5900594d].
1 +(include "lib/lisp-macro.scm") 2 +(include "lib/interlace.scm") 3 +(include "lib/bot.scm") 4 + 5 +(define (fail . msg) 6 + (display (string-append "\x1b[1;31m - err.\x1b[0m " 7 + (apply string-append msg))) 8 + (exit 1)) 9 +(define (fail:sym s) 10 + (fail "bad form \x1b[3;36m'" (symbol->string s) "\x1b[0m")) 11 + 12 +(define-macro (fn . b) (cons 'lambda b)) ; your honor, they made me do it 13 + 14 +(define (verb inf ger pst ppl) 15 + (fn (form) 16 + (define (is f) (equal? form f)) 17 + (cond 18 + ((is 'inf) inf) ((is 'ger) ger) 19 + ((is 'pst) pst) ((is 'ppl) ppl) 20 + (else (fail:sym form))))) 21 + 22 +(define (word-append . body) 23 + (define (vowel? c) (member c '("a" "e" "i" "o" "u"))) 24 + (define (join acc lst) 25 + (if (eq? lst '()) acc 26 + (let ([word (car lst)] 27 + [tail (cdr lst)]) 28 + (if (eq? word '()) (join acc tail) 29 + (join (string-append acc (if (equal? acc "") "" " ") 30 + (if (not (equal? word "a")) word 31 + (if (eq? tail '()) "a" 32 + (let* ([next-word (car tail)] 33 + [onset (substring next-word 0 1)]) 34 + (if (vowel? onset) "an" "a"))))) tail))))) 35 + (join "" body)) 36 + 37 + 38 +(define-macro (verb-form . body) 39 + (define (make-id . body) 40 + (string->symbol (apply string-append body))) 41 + 42 + (define (finalize-rule r) 43 + (define (finalize-sub-rule s) 44 + (if (list? s) `(string-append ,@s) s)) 45 + (let* ([rule-name (car r)] 46 + [rule-body (cdr r)]) 47 + `(define (,rule-name *o*) 48 + (word-append ,@(map finalize-sub-rule rule-body))))) 49 + 50 + (let* ([proc-def (car body)] 51 + [proc-name (symbol->string (car proc-def))] 52 + [proc-args (cdr proc-def)] 53 + [defs (cdr body)]) 54 + 55 + `(define (,(make-id "verb:" proc-name) ,@proc-args) 56 + ,@(map finalize-rule defs) (verb inf ger pst ppl)))) 57 + 58 +(link-vector 'words 59 + fuck: (verb:weak "fuck") 60 + clench: (verb:weak "clench") 61 + '(verb:weak "download") 62 + '(verb:weak "cyber")) 63 + 64 +(define (phrase vb pp) 65 + (lambda (form) 66 + (if (equal? form 'ppl) 67 + (lambda (*o*) 68 + (word-append (string-append ((vb 'ppl) '()) "-" pp) *o*)) 69 + (lambda (*o*) 70 + (word-append ((vb form) *o*) pp))))) 71 + 72 +(verb-form (weak stem) 73 + ; e.g. suck → sucking 74 + (inf [stem] *o*) 75 + (ger [stem "ing"] *o*) 76 + (pst [stem "ed"] *o*) 77 + (ppl [stem "ed"] *o*)) 78 + 79 +(verb-form (e stem) 80 + ; e.g. vape → vaping 81 + (inf [stem "e"] *o*) 82 + (ger [stem "ing"] *o*) 83 + (pst [stem "ed"] *o*) 84 + (ppl [stem "ed"] *o*)) 85 + 86 +(verb-form (heavy stem final) ; e.g. plug → plugging 87 + (inf [stem final] *o*) 88 + (ger [stem final "ing"] *o*) 89 + (pst [stem final "ed"] *o*) 90 + (ppl [stem final "ed"] *o*)) 91 + 92 +(verb-form (strong stem pst ppl) ; e.g. drink → drank 93 + (inf [stem] *o*) 94 + (ger [stem "ing"] *o*) 95 + (pst [pst] *o*) 96 + (ppl [ppl] *o*)) 97 + 98 +(verb-form (strong! stem pst) ; e.g. shoot → shot → shot 99 + (inf [stem] *o*) 100 + (ger [stem "ing"] *o*) 101 + (pst [pst] *o*) 102 + (ppl [pst] *o*)) 103 + 104 + 105 + 106 + (verb:weak "crunch") 107 + (verb:weak "snort" "snorting") 108 + (verb:heavy "stab" "b") 109 + (verb:strong "drink" "drank" "drunk") 110 + (verb:strong "eat" "ate" "eaten") 111 + (verb:strong "bite" "bit" "bitten") 112 + (verb:strong! "shoot" "shot") 113 + 114 + )) 115 + 116 +(define verbs (interlace vector 117 + crunch. (verb:weak "crunch") 118 + (phrasal crunch "up") 119 + (phrasal crunch "off") 120 + (phrasal crunch "out") 121 + (phrasal crunch "away") 122 + 123 + fuck. (verb:weak "fuck") 124 + (phrasal fuck "up") 125 + (phrasal fuck "out") 126 + (phrasal fuck "off")))
Added lib/interlace.scm version [a8f59872e4].
1 +; ʞ / interlace.scm 2 +; a scheme library by lexi hale 3 +; 4 +; (interlace) solves an age-old problem. what kind of data structure 5 +; do you use when you need both an aggregate (a list, a vector) of 6 +; items but also to be able to individually refer to those items by 7 +; name? this problem is effectively unsolvable in C and C++ without 8 +; inordinate runtime overhead, and there's no native syntax for it 9 +; in Scheme. however, by rewriting the AST, we can implement a clean, 10 +; performant, low-cost solution ourselves, thanks to the fact that 11 +; (let*) bindings are expressions. 12 +; 13 +; interlace takes a constructor function, e.g. (vector) or (list), 14 +; a list of items, and returns an expression calling that constructor 15 +; on a list of all items defined in it. if an item is proceded by 16 +; an atom that ends in a period (e.g. “name.”), it is defined within 17 +; a (let*) expression, and its name is then included among the 18 +; arguments passed to the constructor function. 19 +; 20 +; the upshot of this is that items can reference other items by name 21 +; *as they are being defined*. for instance: 22 +; 23 +; (define verbs (interlace vector 24 +; talk. (verb "talk" "talking" "talked") 25 +; (phrasal-verb talk "to") 26 +; (phrasal-verb talk "about") 27 +; (verb "say" "saying" "said))) 28 +; 29 +; here, the function to generate a phrasal verb exhibits backreference 30 +; to an existing verb contained alongside it in the vector. note that 31 +; the name bindings are ephemeral; they do not survive the immediate 32 +; context of the constructor. 33 + 34 +(define-macro (interlace . body) 35 + ; given a list with both named and nameless members, identify 36 + ; which is which and instate the vector. 37 + (define (name? term) 38 + (define (coda str) (substring str 39 + (- (string-length str) 1) 40 + (string-length str))) 41 + (if (not (symbol? term)) #f 42 + (let* ([term-string (symbol->string term)] 43 + [final-char (coda term-string)]) 44 + (print "TERMSTRING:" term-string) 45 + (print "CHAR:" final-char) 46 + (if (not (equal? final-char ".")) #f 47 + (substring term-string 0 (- (string-length term-string) 1)))))) 48 + 49 + (define (divide-entries lst @named @nameless) 50 + ; given a list, return a pair [ x . y ] such that x is a list 51 + ; of named terms ( name . term ) and y is a list of nameless 52 + ; terms. 53 + (if (eq? lst '()) (cons @named @nameless) 54 + (let* ([head (car lst)] 55 + [tail (cdr lst)] 56 + [name (name? head)]) 57 + (if (eqv? name #f) 58 + ; there's no name term; add this to the nameless 59 + ; list and move on the next iteration 60 + (divide-entries tail @named (cons head @nameless)) 61 + 62 + ; head is a name, so determine its value, cons them 63 + ; together, and add that cons to the list of named 64 + ; lists 65 + (let* ([val (car tail)] 66 + [new-tail (cdr tail)] 67 + [named (list name val)]) 68 + (divide-entries new-tail 69 + (cons named @named) @nameless)))))) 70 + (let* ([structure (car body)] 71 + [-structure-entries (cdr body)] 72 + [-divided-lists (divide-entries -structure-entries '() '())] 73 + [named-terms (car -divided-lists)] 74 + [nameless-terms (cdr -divided-lists)]) 75 + `(let* ,(reverse named-terms) 76 + (,structure ,@nameless-terms 77 + ,@(map car named-terms)))))