Differences From
Artifact [6e5900594d]:
1 1 (include "lib/lisp-macro.scm")
2 +(include "lib/fail.scm")
2 3 (include "lib/interlace.scm")
3 4 (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
5 +(include "lib/struct.scm")
6 +(include "lib/verb.scm")
7 +
8 +(define (forms fn vb . args)
9 + (list->vector (map (lambda (a) (fn vb a)) args)))
10 +
11 +(define (flexprep vb . args)
12 + (list->vector
13 + (append (map (lambda (x) postpositive vb x) args)
14 + (map (lambda (x) phrase vb x) args))))
15 +
16 +
17 +(define intransitive-verbs (interlace vector
18 + (forms phrase
19 + (verb:strong "get" "got" "gotten") "up" "off" "out")
20 + (verb:weak "leak")
21 + (verb:weak "scream")
22 + (verb:weak "fear")
23 + hurt. (verb:strong! "hurt" "hurt")
24 + (forms postpositive
25 + hurt "bad" "real bad" "like hell"
26 + "something awful" "something fierce"
27 + "something terrible" "real good")
28 +
29 + (forms postpositive
30 + (verb:weak "jerk") "it" "off")
31 +
32 + (forms phrase (verb:strong "throw" "threw" "thrown")
33 + "up" "down")
34 + ))
35 +
36 +(define vocab:roa-verbs (interlace vector
37 + get. (verb:strong "get" "got" "gotten")
38 + (forms phrase
39 + get "up" "off" "out" "in")
40 + (forms postpositive
41 + get "in" "in on" "out of" "up in" "into"
42 + "off on" "over" "over to")
117 43 crunch. (verb:weak "crunch")
118 - (phrasal crunch "up")
119 - (phrasal crunch "off")
120 - (phrasal crunch "out")
121 - (phrasal crunch "away")
44 + (flexprep crunch "up" "off" "out" "away")
45 + (postpositive crunch "on")
46 + cyber. (verb:weak "cyber")
47 + (flexprep cyber "up")
48 + slurp. (verb:weak "slurp")
49 + (flexprep "up")
50 + suck. (verb:weak "suck")
51 + (flexprep suck "up" "off" "down")
52 + throw. (verb:strong "throw" "threw" "thrown")
53 + (flexprep throw "up")
54 + (postpositive throw "back")
55 + chew. (verb:weak "chew")
56 + (flexprep chew "up")
57 + (postpositive chew "on")
58 + have. (verb:irregular "have" "has" "having" "had" "had")
59 + do. (verb:irregular "do" "does" "doing" "did" "done")
60 + poop. (verb:weak "poop")
61 + (flexprep poop "out")
62 + (postpositive poop "on")
63 + piss. (verb:weak "piss")
64 + (postpositive piss "on")
65 + (flexprep piss "out" "away" "off")
66 + cook. (verb:weak "cook")
67 + (phrase cook "up")
68 + tweet. (verb:weak "tweet")
69 + (forms phrase tweet "up" "at")
70 + plug. (verb:heavy "plug" "g")
71 + (phrase plug "in")
72 + (postpositive (verb:weak "laugh") "at")
73 + (flexprep (verb:weak "hook") "up" "in")
74 + (flexprep (verb:weak "turn") "on" "in")
75 +
76 + (verb:weak "download")
77 + (verb:weak "snort")
78 + (verb:weak "sniff")
79 + (verb:weak "down")
80 + (verb:weak "hoot")
81 + (verb:weak "toot")
82 + (verb:weak "boof")
83 + (verb:weak "blast")
84 + (verb:weak "honk")
85 + (verb:weak "whack")
86 + (verb:weak "loot")
87 + (verb:weak "slaughter")
88 + (verb:weak "ghoul")
89 + (verb:es "ravish")
90 + (verb:es "piss")
91 + (verb:es "crunch")
92 + (verb:e "scrobbl")
93 + (verb:e "chok")
94 + (verb:e "blaz")
95 + (verb:e "freebas")
96 + (verb:e "us")
97 + (verb:e "vap")
98 + (verb:e "smoke")
99 + (verb:e "gargle")
100 + (verb:e "guzzle")
101 + (verb:e "mainlin")
102 + (verb:y "tr")
103 + (verb:heavy "stab" "b")
104 + (verb:heavy "pop" "p")
105 + (verb:heavy "zap" "p")
106 + (verb:heavy "slug" "g")
107 + (verb:strong "drink" "drank" "drunk")
108 + (verb:strong "eat" "ate" "eaten")
109 + (verb:strong "bite" "bit" "bitten")
110 +
111 + shoot. (verb:strong! "shoot" "shot")
112 + (phrase shoot "up")))
113 +
114 +(define person (struct '1sg '1pl '2 '3sg.f '3sg.m '3pl 'inan))
115 +(define declension (struct 'nom 'acc 'gen 'poss 'refl 'cop))
116 +(define pronoun (apply person (map declension '(
117 + ("i" "me" "my" "mine" "myself" "i'm"
118 + ("we" "us" "our" "our" "ourself" "we're")
119 + ("you" "you" "your" "yours" "yourself" "you're")
120 + ("she" "her" "her" "hers" "herself" "she's")
121 + ("he" "him" "his" "his" "himself" "he's")
122 + ("they" "them" "their" "theirs" "themselves" "they're" )
123 + ("it" "it" "its" "its" "itself" "it's" ))))))
124 +
125 +(define (look-up st . path)
126 + (if (eq? '() (cdr path)) (st (car path))
127 + (look-up (st (car path)) (cdr path))))
128 +
129 +
130 +(define collapse-person (person '1sg 'pl '3sg '3sg 'pl))
131 +; not all person forms are contrastive in english; this
132 +; way we only have to encode the ones that contrast
133 +
134 +; state: a function that is called on a person, a tense
135 +; (one of 'pst 'prs 'fut 'perf 'imperf), an aspect
136 +; ('stat 'inch), and returns a string of text describing
137 +; the person in that state
138 +; e.g. (outta-mind '3sg.f 'prs 'stat) → "is outta her mind"
139 +; (suicidal '3sg.m 'fut 'stat) → "is gonna want to die"
140 +
141 +(define (adjective pers tense aspect)
142 +
143 +
144 +(define (pick-rec top-list) ; note: do not expose to
145 + (let ([e (pick top-list)]) ; empty vectors
146 + (if (vector? e) (pick-rec e) e)))
147 +
148 +(define verb:be (let ([t (struct 'inf 'pst)]
149 + [p (struct '1sg '3sg 'pl)])
150 + (t (p "am" "is" "are")
151 + (p "was" "was" "were"))))
152 +
153 +
154 +(define noun:sg (vector "a" "the" "this"))
155 +(define noun:pl (vector "" "the" "these"))
156 +(define noun:mass (vector "" "the" "this"))
157 +(define noun:pn (vector ""))
158 +
159 +(define nouns
160 + (let* ([$ string-append] [: cons] [@ list]
161 + [~ (lambda (str lst) (list->vector (map (lambda (fn) (fn str)) lst)))]
162 + [sg (lambda (n) (: n noun:sg))]
163 + [pl (lambda (n) (: ($ n "s") noun:pl))]
164 + [pl/s (lambda (n) (: ($ n "es") noun:pl))]
165 + [pl/i (lambda (p) (lambda (_) (: p noun:pl)))]
166 + [pl/iso(lambda (n) (: n noun:pl))]
167 + [mass (lambda (n) (: n noun:mass))]
168 + [mass/i(lambda (m) (lambda (_) (: m noun:mass)))]
169 + [pn (lambda (n) (: n noun:pn))])
170 + (vector
171 + (~ "water" [@ mass pl])
172 + (~ "shoe" [@ sg pl])
173 + (~ "man" [@ sg (pl/i "men") (mass/i "Man")])
174 + (~ "mouth" [@ sg pl])
175 + (~ "ass" [@ sg pl/s])
176 + (~ "dick" [@ sg pl mass])
177 + (~ "cock" [@ sg pl mass])
178 + (~ "cunt" [@ sg pl mass])
179 + (~ "pussy" [@ sg mass (pl/i "pussies")])
180 + (~ "eyeball" [@ sg pl])
181 + (~ "bed" [@ sg pl])
182 + (~ "house" [@ sg pl])
183 + (~ "home" [@ mass pl])
184 + (~ "pants" [@ pl/iso])
185 + (~ "face" [@ sg pl])
186 + (~ "friend" [@ sg pl])
187 + (~ "pal" [@ sg pl])
188 + (~ "buddy" [@ sg (pl/i "buddies")])
189 + (~ "vomit" [@ mass])
190 + (~ "phone" [@ sg pl])
191 + (~ "pig" [@ sg pl])
192 + (~ "cop" [@ sg pl])
193 + (~ "human" [@ sg pl])
194 + (~ "God" [@ pn])
195 + (~ "god" [@ sg pl])
196 + (~ "goddess" [@ sg pl/s])
197 + (~ "asshole" [@ sg pl])
198 + (~ "clown" [@ sg pl])
199 + (~ "fear" [@ mass])
200 + (~ "person" [@ sg (pl/i "people")]))))
201 +; TODO: second-order verbs
202 +#|
203 +(define (verb-phrase tense noun)
204 + (let* ([verb (pick-rec transitive-verbs)]
205 + [noun-form (pick noun)]
206 + [det (pick (cdr noun-form))]
207 + [bare-noun (car noun-form)])
208 + ((verb tense) (word-append det bare-noun))))
209 +
210 +(define (mod-noun noun)
211 + (let* ([mode (one-of (cons transitive-verbs 'ppl)
212 + (cons intransitive-verbs 'adj))]
213 + [noun-form (pick noun)]
214 + [bare-noun (car noun-form)]
215 + [verb (pick-rec (car mode))]
216 + [vbd-noun ((verb (cdr mode)) bare-noun)])
217 + (vector (cons vbd-noun (cdr noun-form)))))
122 218
123 - fuck. (verb:weak "fuck")
124 - (phrasal fuck "up")
125 - (phrasal fuck "out")
126 - (phrasal fuck "off")))
219 +(print "in this house, we " (verb-phrase 'inf (mod-noun (pick nouns))))
220 +(exit 0)
221 +|#