procgen  Check-in [6822b7d006]

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

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

(define (forms fn vb . args)
  (list->vector (map (lambda (a) (fn vb a)) args)))

(define (flexprep vb . args)
		  (list->vector
			(append (map (lambda (x) postpositive vb x) args)
					(map (lambda (x) phrase vb x) args))))


(define intransitive-verbs (interlace vector
	(forms phrase
		   (verb:strong "get" "got" "gotten") "up" "off" "out")
	(verb:weak "leak")
	(verb:weak "scream")
	(verb:weak "fear")
	hurt. (verb:strong! "hurt" "hurt")
	(forms postpositive
		   hurt "bad" "real bad" "like hell"
		   "something awful" "something fierce"
		   "something terrible" "real good")

	(forms postpositive
		   (verb:weak "jerk") "it" "off")

	(forms phrase (verb:strong "throw" "threw" "thrown")
			"up" "down")
	))

(define vocab:roa-verbs (interlace vector
	get. (verb:strong "get" "got" "gotten")
		(forms phrase
			get "up" "off" "out" "in")
		(forms postpositive
		   get "in" "in on" "out of" "up in" "into"
		   "off on" "over" "over to")
	crunch. (verb:weak "crunch")
		(flexprep crunch "up" "off" "out" "away")
		(postpositive crunch "on")
	cyber. (verb:weak "cyber")
		(flexprep cyber "up")
	slurp. (verb:weak "slurp")
		(flexprep "up")
	suck. (verb:weak "suck")
		(flexprep suck "up" "off" "down")
	throw. (verb:strong "throw" "threw" "thrown")
		(flexprep throw "up")
		(postpositive throw "back")
	chew. (verb:weak 	"chew")
		(flexprep chew "up")
		(postpositive chew "on")
	have. (verb:irregular "have" "has" "having" "had" "had")
	do. (verb:irregular "do" "does" "doing" "did" "done")
	poop. (verb:weak "poop")
		(flexprep poop "out")
		(postpositive poop "on")
	piss. (verb:weak "piss")
		(postpositive piss "on")
		(flexprep piss "out" "away" "off")
	cook. (verb:weak "cook")
		(phrase cook "up")
	tweet. (verb:weak "tweet")
		(forms phrase tweet "up" "at")
	plug. (verb:heavy "plug" "g")
		(phrase plug "in")
	(postpositive (verb:weak "laugh") "at")
	(flexprep (verb:weak "hook") "up" "in")
	(flexprep (verb:weak "turn") "on" "in")

	(verb:weak	"download")
	(verb:weak	"snort")
	(verb:weak	"sniff")
	(verb:weak 	"down")
	(verb:weak 	"hoot")
	(verb:weak 	"toot")
	(verb:weak 	"boof")
	(verb:weak 	"blast")
	(verb:weak 	"honk")
	(verb:weak 	"whack")
	(verb:weak 	"loot")
	(verb:weak 	"slaughter")
	(verb:weak 	"ghoul")
	(verb:es 	"ravish")
	(verb:es	"piss")
	(verb:es	"crunch")
	(verb:e	 	"scrobbl")
	(verb:e	 	"chok")
	(verb:e	 	"blaz")
	(verb:e	 	"freebas")
	(verb:e	 	"us")
	(verb:e		"vap")
	(verb:e	 	"smoke")
	(verb:e	 	"gargle")
	(verb:e	 	"guzzle")
	(verb:e		"mainlin")
	(verb:y 	"tr")
	(verb:heavy	"stab" "b")
	(verb:heavy "pop" "p")
	(verb:heavy	"zap" "p")
	(verb:heavy	"slug" "g")
	(verb:strong "drink" "drank"	"drunk")
	(verb:strong "eat"   "ate"		"eaten")
	(verb:strong "bite"  "bit"		"bitten")

	shoot. (verb:strong!	"shoot" "shot")
	(phrase shoot "up")))

(define person     (struct '1sg '1pl '2 '3sg.f '3sg.m '3pl 'inan))
(define declension (struct 'nom 'acc 'gen 'poss 'refl 'cop))
(define pronoun (apply person (map declension '(
	  ("i"    "me"   "my"    "mine"   "myself"	   "i'm"
	  ("we"   "us"   "our"   "our"    "ourself"	   "we're") 
	  ("you"  "you"  "your"  "yours"  "yourself"   "you're")  
	  ("she"  "her"  "her"   "hers"   "herself"	   "she's")   
	  ("he"   "him"  "his"   "his"    "himself"	   "he's")
	  ("they" "them" "their" "theirs" "themselves" "they're" )
	  ("it"   "it"   "its"   "its"    "itself"     "it's" ))))))

(define (look-up st . path)
  (if (eq? '() (cdr path)) (st (car path))
	  (look-up (st (car path)) (cdr path))))
  

(define collapse-person (person '1sg 'pl '3sg '3sg 'pl))
; not all person forms are contrastive in english; this
; way we only have to encode the ones that contrast

; state: a function that is called on a person, a tense
; (one of 'pst 'prs 'fut 'perf 'imperf), an aspect
; ('stat 'inch), and returns a string of text describing
; the person in that state
;  e.g.	(outta-mind '3sg.f 'prs 'stat) → "is outta her mind"
;		(suicidal '3sg.m 'fut 'stat) → "is gonna want to die"

(define (adjective pers tense aspect)


(define (pick-rec top-list)  ; note: do not expose to
  (let ([e (pick top-list)]) ; empty vectors
	(if (vector? e) (pick-rec e) e)))

(define verb:be (let ([t (struct 'inf 'pst)]
					  [p (struct '1sg '3sg 'pl)])
				  (t (p "am"  "is" "are")
					 (p "was" "was" "were"))))


(define noun:sg   (vector "a" "the" "this"))
(define noun:pl   (vector "" "the" "these"))
(define noun:mass (vector "" "the" "this"))
(define noun:pn   (vector ""))

(define nouns
  (let* ([$ string-append] [: cons] [@ list]
		 [~		(lambda (str lst) (list->vector (map (lambda (fn) (fn str)) lst)))]
		 [sg	(lambda (n) (: n				noun:sg))]
		 [pl	(lambda (n) (: ($ n "s")		noun:pl))]
		 [pl/s	(lambda (n) (: ($ n "es")		noun:pl))]
		 [pl/i	(lambda (p) (lambda (_) (: p	noun:pl)))]
		 [pl/iso(lambda (n) (: n				noun:pl))]
		 [mass	(lambda (n) (: n				noun:mass))]
		 [mass/i(lambda (m) (lambda (_) (: m	noun:mass)))]
		 [pn	(lambda (n) (: n				noun:pn))])
	(vector
	  (~ "water"	[@ mass pl])
	  (~ "shoe"		[@ sg pl])
	  (~ "man"		[@ sg (pl/i "men") (mass/i "Man")])
	  (~ "mouth"	[@ sg pl])
	  (~ "ass"		[@ sg pl/s])
	  (~ "dick"		[@ sg pl mass])
	  (~ "cock"		[@ sg pl mass])
	  (~ "cunt"		[@ sg pl mass])
	  (~ "pussy"	[@ sg mass (pl/i "pussies")])
	  (~ "eyeball"	[@ sg pl])
	  (~ "bed"		[@ sg pl])
	  (~ "house"	[@ sg pl])
	  (~ "home"		[@ mass pl])
	  (~ "pants"	[@ pl/iso])
	  (~ "face"		[@ sg pl])
	  (~ "friend"	[@ sg pl])
	  (~ "pal"		[@ sg pl])
	  (~ "buddy"	[@ sg (pl/i "buddies")])
	  (~ "vomit"	[@ mass])
	  (~ "phone"	[@ sg pl])
	  (~ "pig"		[@ sg pl])
	  (~ "cop"		[@ sg pl])
	  (~ "human"	[@ sg pl])
	  (~ "God"		[@ pn])
	  (~ "god"		[@ sg pl])
	  (~ "goddess"	[@ sg pl/s])
	  (~ "asshole"	[@ sg pl])
	  (~ "clown"	[@ sg pl])
	  (~ "fear"		[@ mass])
	  (~ "person"	[@ sg (pl/i "people")]))))
; TODO: second-order verbs
#|
(define (verb-phrase tense noun)
  (let* ([verb (pick-rec transitive-verbs)]
		 [noun-form (pick noun)]
		 [det (pick (cdr noun-form))]
		 [bare-noun (car noun-form)])
	((verb tense) (word-append det bare-noun))))

(define (mod-noun noun)
  (let* ([mode (one-of (cons transitive-verbs 'ppl)
					   (cons intransitive-verbs 'adj))]
		 [noun-form (pick noun)]
		 [bare-noun (car noun-form)]
		 [verb (pick-rec (car mode))]
		 [vbd-noun ((verb (cdr mode)) bare-noun)])
	(vector (cons vbd-noun (cdr noun-form)))))

(print "in this house, we " (verb-phrase 'inf (mod-noun (pick nouns))))
(exit 0)
|#

(define-macro (rule . body)
  (define (make-cases ct body acc)
    (if (eq? body '()) acc
      (make-cases (+ ct 1) (cdr body)
		(cons (list (list ct) (cons 'string-append (car body))) acc))))
  (list 'define (car body)
	(cons 'case (cons (list 'random-integer (length (cdr body)))
	  (make-cases 0 (cdr body) '()) ))))

(define (pick ar)
  (vector-ref ar (random-integer (vector-length ar))))

(define-macro (one-of . body)
	(define (make-cases ct body acc) ; accumulator func
	; this could probably be done much more cleanly through
	; judicious use of fold or whatever it's called but my
	; brain is too broken
		(if (eq? body '()) ; then
			acc 
		; else
			(make-cases (+ 1 ct) (cdr body) ; recurse!
				(cons `((,ct) ,(car body)) acc)))) ; the rule

	`(case (random-integer ,(length body)) ; final output
		,@(make-cases 0 body '()))
)
(random-source-randomize! default-random-source)

  (define (nest-case pair)
	(cons (list (car pair))
		  (cdr pair)))

  (define (wrap pat) 
	(if (eq? (cdr pat) '()) ;then
		pat
		; else
		(list (cons 'string-append pat))))

  (let ([branches (map wrap patterns)])
	(@one-of nest-case branches)))


; exports

  (define (nest-case pair)
	(cons (list (car pair))
		  (cdr pair)))

  (define (wrap pat) 
	(if (eq? (cdr pat) '()) ;then
		pat
	; else
		(list (cons 'string-append pat))))

  (let ([branches (map wrap patterns)])
	(@one-of nest-case branches)))


; exports

; 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)]

; 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)
	; given a symbol, determine wheter it is a name, and if so return
	; that name as a string and without the name-marking suffix ‹.›
	; otherwise, return #f
	(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)])


		  (if (not (equal? final-char ".")) #f
			  (string->symbol(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)]

; ʞ / struct.scm
;
; generates immutable, relatively efficient structs. declare
; a struct type x with
;	(define x (struct 'field1 'field2) 
; create a record y of that type with
;	(define y (x 123 456))
; access field1 of record y with
;	(y 'field1)
; update field2 of record y with
;	(y 'field2 123) → new record (field1 = 123; field2 = 123)
;
; this unit also includes a few utility function that chicken
; scheme conveniently "forgot." i apologize for the implementation
; of (list-head). i was very tired.

; return a sub-list of lst up to ct (inverse of list-tail)
(define (list-head lst ct)
  (let* ([reverse-lst (reverse lst)]
		 [idx (- (length lst) (+ 1 ct))])
	(reverse (list-tail reverse-lst idx))))
	; i'm not proud of this

; search for the first occurence of `term` in list lst.
; equal? is used by default; an alternate predicate may
; be passed after `term`
(define (member-index lst term . opt) 
  (let ([predicate (if (eq? '() opt) equal?
					   (car opt))])
	(define (search idx l)
	  (if (eq? l '()) #f
		  (if (predicate (car l) term) idx
			  (search (+ 1 idx) (cdr l)))))
	  (search 0 lst)))

; generate a new struct type and return it as a function
; that may be called to instantiate that type.
(define (struct . keys)
  (define (generate-record . vals)
  ; the function returned by a (struct) call and called
  ; to generate a new struct by functional-update syntax
	(define (struct-ref key)
	; searches the struct for the named key and if found
	; return its index, otherwise return #f
	  (let ([query-idx (member-index keys key)])
		(if (eq? #f query-idx) #f
			(list-ref vals query-idx))))
	(define (update-record key val)
	; return a new version of this construct with the same
	; field names and values except for { key = val }
		(let* ([field-idx (member-index keys key)]
			   [new-tail (list-tail vals (+ 1 field-idx))]
			   [new-head (list-head vals (- field-idx 1))])
		  (apply generate-record (append new-head (list val) new-tail))))

	; are values specified for every field and no more?
	; TODO: consider loosening the restriction - could
	; there be some use to allowing the used to add fields
	; only accessible through the record->list facility?
	(if (not (= (length vals) (length keys))) #f
		(lambda access
		  ; returned by generate-record, this function is called
		  ; whenever a struct is accessed
		  (case (length access)
			;determine operation to perform
			((0) vals) ; return list of values
			((1) (struct-ref (car access))); search for value
			((2) (update-record (car access) (cadr access)))
			(else #f))))) ; no other functions currently available

	; keys are now stored in the closure; return the
	; (generate-record) function to the user so she can
	; call it to instantiate the defined struct.
	generate-record)

; ʞ / verb.scm
;	(depends lisp-macro.scm struct.scm)
;	a library by lexi hale
;
; 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 (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*))