(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")))