; [ʞ] verb.scm
; ~ lexi hale <lexi@hale.su>
; © affero general public license
; > (load "lib/lisp-macro.scm")
; (load "lib/fn-struct.scm")
; (load "lib/verb.scm")
; macros, functions, and rules for conjugating verbs and
; generating verb phrases. this library rules was written
; specifically for english verbs and cannot be used as a
; "drop-in" library for other languages; however, the
; structured and functions used are sufficiently generic
; that it should be portable to other languages with
; minimal effort.
;;;; section i. generic functions & structures
; struct verb
; fields contain conjugation functions for the specified
; tense. ((v 'inf) object) will generate a verb phrase string
; with `object` as the direct object and in the bare form
; 'inf: bare infinitive / subjunctive / 1.PRS, 2.PRS, 3PL.PRS
; 'prs: 3SG.PRS
; 'ger: gerund (-ing form)
; 'pst: past (-ed form)
; 'ppl: past participle (often -ed or -en)
; * l10n note: the fields mentioned in the last line of the
; (verb-form) macro must always match the fields listed in
(define verb (struct 'inf 'prs 'ger 'adj 'pst 'ppl))
; takes a list of individual strings and joins them with
; spaces. occurrences of "a" are automatically replace by
; "an" if the word following them appears to start with a
; vowel. this can be forcibly induced by preceeding that
; word with the symbol 'vowel in the list
; TODO: make it handle initialisms. yes, everything about
; this is horrible. yes, this *is* the wrong way to do it.
; yes, i *am* ashamed. why do you ask
(define (word-append . body)
(define (vowel? c) (member c '("a" "e" "i" "o" "u")))
(define (vowel-onset? w)
(if (equal? w 'vowel) #t
(vowel? (substring w 0 1))))
(define (join acc lst)
(if (eq? lst '()) acc
(let ([word (car lst)]
[tail (cdr lst)])
(if (or (eq? word '()) (eq? word 'vowel)) (join acc tail)
(join (string-append acc (if (equal? acc "") "" " ")
(if (not (equal? word "a")) word
(if (eq? tail '()) "a"
(if (vowel-onset? (car tail)) "an" "a")))) tail)))))
(join "" body))
; make it easier to define repetitive verb forms
(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 prs ger adj pst ppl))))
; create a phrasal verb from a normal verb
; - vb: root verb
; - pp: preposition or pp phrase to append
(define (phrase vb pp)
(lambda (form)
(if (or (equal? form 'ppl) (equal? form 'adj))
(lambda (*o*)
(word-append (string-append ((vb form) '()) "-" pp) *o*))
(lambda (*o*)
(word-append ((vb form) *o*) pp)))))
; create a compound form a verb that already exists
; - prefix: prefix to append (e.g. up, out, over, un)
; - vb: final, "stem" verb
(define (compound prefix vb) (lambda (form) (lambda (*o*)
(word-append (string-append prefix ((vb form) *o*))))))
; create a verb where another string interposes between
; the root verb and the object. this can be used to
; implement object incorporation or prepositional verbs
; such as "get off on" (not to be confused with phrasal
; verbs) a phrasal verb.
; - vb: the root (leftmost) verb
; - pps: the preposition complex immediately following
; the verb.
(define (postpositive vb post) (lambda (form) (lambda (*o*)
(if (or (equal? form 'ppl) (equal? form 'adj))
(word-append
(string-append ((vb form) '()) "-" post)
*o*)
(word-append ((vb form) '()) post *o*)))))
;;; section ii. english-specific verb classes
(verb-form (weak stem)
; e.g. suck → sucking
(inf [stem] *o*)
(prs [stem "s"] *o*)
(ger [stem "ing"] *o*)
(adj [stem "ing"] *o*)
(pst [stem "ed"] *o*)
(ppl [stem "ed"] *o*))
(verb-form (es stem)
; e.g. suck → sucking
(inf [stem] *o*)
(prs [stem "es"] *o*)
(ger [stem "ing"] *o*)
(adj [stem "ing"] *o*)
(pst [stem "ed"] *o*)
(ppl [stem "ed"] *o*))
(verb-form (e stem)
; e.g. vape → vaping
(inf [stem "e"] *o*)
(prs [stem "es"] *o*)
(ger [stem "ing"] *o*)
(adj [stem "ing"] *o*)
(pst [stem "ed"] *o*)
(ppl [stem "ed"] *o*))
(verb-form (y stem)
; e.g. try → trying
(inf [stem "y"] *o*)
(prs [stem "ies"] *o*)
(ger [stem "ing"] *o*)
(adj [stem "ing"] *o*)
(pst [stem "ed"] *o*)
(ppl [stem "ed"] *o*))
(verb-form (heavy stem final)
; e.g. plug → plugging
(inf [stem] *o*)
(prs [stem "s"] *o*)
(ger [stem final "ing"] *o*)
(adj [stem final "ing"] *o*)
(pst [stem final "ed"] *o*)
(ppl [stem final "ed"] *o*))
(verb-form (strong stem ipst ippl)
; e.g. drink → drank
(inf [stem] *o*)
(prs [stem "s"] *o*)
(ger [stem "ing"] *o*)
(adj [stem "ing"] *o*)
(pst [ipst] *o*)
(ppl [ippl] *o*))
(verb-form (strong-heavy stem final ipst ippl)
; e.g. drink → drank
(inf [stem] *o*)
(prs [stem "s"] *o*)
(ger [stem final "ing"] *o*)
(adj [stem final "ing"] *o*)
(pst [ipst] *o*)
(ppl [ippl] *o*))
(verb-form (irregular iinf iprs iger ipst ippl)
; e.g. have → has → had
(inf [iinf] *o*)
(prs [iprs] *o*)
(ger [iger] *o*)
(adj [iger] *o*)
(pst [ipst] *o*)
(ppl [ippl] *o*))
(verb-form (strong! stem ipst)
; e.g. shoot → shot → shot
(inf [stem] *o*)
(prs [stem "s"] *o*)
(ger [stem "ing"] *o*)
(adj [stem "ing"] *o*)
(pst [ipst] *o*)
(ppl [ipst] *o*))