Will Anderson
1432c56cf7
Implements a complete natural language generation stack in El: - morphology.el: English pluralization, verb conjugation (40+ irregulars), determiner agreement - vocabulary.el: inline seed lexicon (~100 entries: pronouns, nouns, verbs, adjectives, etc.) - grammar.el: CFG rules (S/NP/VP/PP), slot-map driven tree generator, s-expression renderer - realizer.el: semantic form -> English text with tense/aspect/agreement, do-support for questions - nlg.el: JSON-driven public API tying all modules together - tests/run.sh: acceptance corpus runner (6 tests, all passing)
496 lines
18 KiB
EmacsLisp
496 lines
18 KiB
EmacsLisp
// grammar.el - Context-free grammar for English.
|
|
//
|
|
// Grammar rules are stored as lists: [id, lhs, rhs_part0, rhs_part1, ...]
|
|
// Tree nodes are stored as lists: [label, word, child0, child1, ...]
|
|
// where child slots are also lists (nested tree nodes).
|
|
//
|
|
// This module provides:
|
|
// - A catalog of English grammar rules (S, NP, VP, PP)
|
|
// - A generator that fills a rule skeleton with semantic slots
|
|
//
|
|
// Slots are passed as a flat string map encoded as a list:
|
|
// ["key1", "val1", "key2", "val2", ...]
|
|
//
|
|
// Depends on: nothing (standalone)
|
|
|
|
// ── Slot map helpers ──────────────────────────────────────────────────────────
|
|
// Slot maps are [String] lists: [key, val, key, val, ...]
|
|
|
|
fn slots_get(slots: [String], key: String) -> String {
|
|
let n: Int = native_list_len(slots)
|
|
let i: Int = 0
|
|
while i < n - 1 {
|
|
let k: String = native_list_get(slots, i)
|
|
if str_eq(k, key) {
|
|
return native_list_get(slots, i + 1)
|
|
}
|
|
let i = i + 2
|
|
}
|
|
return ""
|
|
}
|
|
|
|
fn slots_set(slots: [String], key: String, val: String) -> [String] {
|
|
let n: Int = native_list_len(slots)
|
|
let result: [String] = native_list_empty()
|
|
let found: Bool = false
|
|
let i: Int = 0
|
|
while i < n - 1 {
|
|
let k: String = native_list_get(slots, i)
|
|
let v: String = native_list_get(slots, i + 1)
|
|
if str_eq(k, key) {
|
|
let result = native_list_append(result, k)
|
|
let result = native_list_append(result, val)
|
|
let found = true
|
|
} else {
|
|
let result = native_list_append(result, k)
|
|
let result = native_list_append(result, v)
|
|
}
|
|
let i = i + 2
|
|
}
|
|
if !found {
|
|
let result = native_list_append(result, key)
|
|
let result = native_list_append(result, val)
|
|
}
|
|
return result
|
|
}
|
|
|
|
fn make_slots(k0: String, v0: String) -> [String] {
|
|
let r: [String] = native_list_empty()
|
|
let r = native_list_append(r, k0)
|
|
let r = native_list_append(r, v0)
|
|
return r
|
|
}
|
|
|
|
fn make_slots2(k0: String, v0: String, k1: String, v1: String) -> [String] {
|
|
let r: [String] = make_slots(k0, v0)
|
|
let r = native_list_append(r, k1)
|
|
let r = native_list_append(r, v1)
|
|
return r
|
|
}
|
|
|
|
fn make_slots3(k0: String, v0: String, k1: String, v1: String, k2: String, v2: String) -> [String] {
|
|
let r: [String] = make_slots2(k0, v0, k1, v1)
|
|
let r = native_list_append(r, k2)
|
|
let r = native_list_append(r, v2)
|
|
return r
|
|
}
|
|
|
|
fn make_slots4(k0: String, v0: String, k1: String, v1: String, k2: String, v2: String, k3: String, v3: String) -> [String] {
|
|
let r: [String] = make_slots3(k0, v0, k1, v1, k2, v2)
|
|
let r = native_list_append(r, k3)
|
|
let r = native_list_append(r, v3)
|
|
return r
|
|
}
|
|
|
|
fn make_slots5(k0: String, v0: String, k1: String, v1: String, k2: String, v2: String, k3: String, v3: String, k4: String, v4: String) -> [String] {
|
|
let r: [String] = make_slots4(k0, v0, k1, v1, k2, v2, k3, v3)
|
|
let r = native_list_append(r, k4)
|
|
let r = native_list_append(r, v4)
|
|
return r
|
|
}
|
|
|
|
// ── Grammar rule catalog ──────────────────────────────────────────────────────
|
|
//
|
|
// Rules:
|
|
// S-DECL S -> NP VP declarative sentence
|
|
// S-QUEST S -> Aux NP VP yes/no question
|
|
// S-IMP S -> VP imperative
|
|
// NP-DET-N NP -> Det N the cat
|
|
// NP-DET-ADJ-N NP -> Det Adj N the big cat
|
|
// NP-PRON NP -> Pron she/he/they
|
|
// NP-N NP -> N proper noun / bare noun
|
|
// VP-V VP -> V intransitive
|
|
// VP-V-NP VP -> V NP transitive
|
|
// VP-V-PP VP -> V PP locative
|
|
// VP-V-NP-PP VP -> V NP PP ditransitive+pp
|
|
// VP-AUX-V VP -> Aux V modal
|
|
// VP-AUX-V-NP VP -> Aux V NP modal transitive
|
|
// PP-P-NP PP -> P NP prepositional phrase
|
|
|
|
fn rule_id(rule: [String]) -> String {
|
|
return native_list_get(rule, 0)
|
|
}
|
|
|
|
fn rule_lhs(rule: [String]) -> String {
|
|
return native_list_get(rule, 1)
|
|
}
|
|
|
|
fn rule_rhs_len(rule: [String]) -> Int {
|
|
let n: Int = native_list_len(rule)
|
|
return n - 2
|
|
}
|
|
|
|
fn rule_rhs(rule: [String], idx: Int) -> String {
|
|
return native_list_get(rule, idx + 2)
|
|
}
|
|
|
|
fn make_rule(id: String, lhs: String, r0: String) -> [String] {
|
|
let r: [String] = native_list_empty()
|
|
let r = native_list_append(r, id)
|
|
let r = native_list_append(r, lhs)
|
|
let r = native_list_append(r, r0)
|
|
return r
|
|
}
|
|
|
|
fn make_rule2(id: String, lhs: String, r0: String, r1: String) -> [String] {
|
|
let r: [String] = make_rule(id, lhs, r0)
|
|
let r = native_list_append(r, r1)
|
|
return r
|
|
}
|
|
|
|
fn make_rule3(id: String, lhs: String, r0: String, r1: String, r2: String) -> [String] {
|
|
let r: [String] = make_rule2(id, lhs, r0, r1)
|
|
let r = native_list_append(r, r2)
|
|
return r
|
|
}
|
|
|
|
fn make_rule4(id: String, lhs: String, r0: String, r1: String, r2: String, r3: String) -> [String] {
|
|
let r: [String] = make_rule3(id, lhs, r0, r1, r2)
|
|
let r = native_list_append(r, r3)
|
|
return r
|
|
}
|
|
|
|
fn build_rules() -> [[String]] {
|
|
let rules: [[String]] = native_list_empty()
|
|
|
|
// Sentence rules
|
|
let rules = native_list_append(rules, make_rule2("S-DECL", "S", "NP", "VP"))
|
|
let rules = native_list_append(rules, make_rule3("S-QUEST", "S", "Aux", "NP", "VP"))
|
|
let rules = native_list_append(rules, make_rule("S-IMP", "S", "VP"))
|
|
|
|
// NP rules
|
|
let rules = native_list_append(rules, make_rule2("NP-DET-N", "NP", "Det", "N"))
|
|
let rules = native_list_append(rules, make_rule3("NP-DET-ADJ-N","NP","Det", "Adj", "N"))
|
|
let rules = native_list_append(rules, make_rule("NP-PRON", "NP", "Pron"))
|
|
let rules = native_list_append(rules, make_rule("NP-N", "NP", "N"))
|
|
|
|
// VP rules
|
|
let rules = native_list_append(rules, make_rule("VP-V", "VP", "V"))
|
|
let rules = native_list_append(rules, make_rule2("VP-V-NP", "VP", "V", "NP"))
|
|
let rules = native_list_append(rules, make_rule2("VP-V-PP", "VP", "V", "PP"))
|
|
let rules = native_list_append(rules, make_rule3("VP-V-NP-PP", "VP", "V", "NP", "PP"))
|
|
let rules = native_list_append(rules, make_rule2("VP-AUX-V", "VP", "Aux", "V"))
|
|
let rules = native_list_append(rules, make_rule3("VP-AUX-V-NP","VP", "Aux", "V", "NP"))
|
|
|
|
// PP rules
|
|
let rules = native_list_append(rules, make_rule2("PP-P-NP", "PP", "P", "NP"))
|
|
|
|
return rules
|
|
}
|
|
|
|
fn get_rules() -> [[String]] {
|
|
return build_rules()
|
|
}
|
|
|
|
fn find_rule(rule_id_str: String) -> [String] {
|
|
let rules: [[String]] = get_rules()
|
|
let n: Int = native_list_len(rules)
|
|
let i: Int = 0
|
|
while i < n {
|
|
let rule: [String] = native_list_get(rules, i)
|
|
let id: String = native_list_get(rule, 0)
|
|
if str_eq(id, rule_id_str) {
|
|
return rule
|
|
}
|
|
let i = i + 1
|
|
}
|
|
let empty: [String] = native_list_empty()
|
|
return empty
|
|
}
|
|
|
|
// ── Tree node construction ────────────────────────────────────────────────────
|
|
// A tree node is a [String]: [label, word, num_children, c0_size, c0..., c1_size, c1..., ...]
|
|
// Since El lists only hold one element type, we serialize tree nodes as
|
|
// flattened string lists using a simple s-expression encoding.
|
|
//
|
|
// Format: "(LABEL WORD CHILD1 CHILD2 ...)"
|
|
// Leaf node: "(LABEL WORD)"
|
|
// Non-terminal: "(LABEL _ CHILD1 CHILD2)"
|
|
|
|
fn make_leaf(label: String, word: String) -> String {
|
|
return "(" + label + " " + word + ")"
|
|
}
|
|
|
|
fn make_node1(label: String, child0: String) -> String {
|
|
return "(" + label + " _ " + child0 + ")"
|
|
}
|
|
|
|
fn make_node2(label: String, child0: String, child1: String) -> String {
|
|
return "(" + label + " _ " + child0 + " " + child1 + ")"
|
|
}
|
|
|
|
fn make_node3(label: String, child0: String, child1: String, child2: String) -> String {
|
|
return "(" + label + " _ " + child0 + " " + child1 + " " + child2 + ")"
|
|
}
|
|
|
|
fn make_node4(label: String, child0: String, child1: String, child2: String, child3: String) -> String {
|
|
return "(" + label + " _ " + child0 + " " + child1 + " " + child2 + " " + child3 + ")"
|
|
}
|
|
|
|
// ── Tree rendering: extract the terminal words in order ───────────────────────
|
|
//
|
|
// Walk the s-expression and collect all leaf words.
|
|
|
|
fn nlg_is_ws(c: String) -> Bool {
|
|
if str_eq(c, " ") { return true }
|
|
if str_eq(c, "\t") { return true }
|
|
if str_eq(c, "\n") { return true }
|
|
return false
|
|
}
|
|
|
|
// Scan forward past whitespace; return new position.
|
|
fn skip_ws(s: String, pos: Int) -> Int {
|
|
let n: Int = str_len(s)
|
|
let i: Int = pos
|
|
let running: Bool = true
|
|
while running {
|
|
if i >= n {
|
|
let running = false
|
|
} else {
|
|
let c: String = str_slice(s, i, i + 1)
|
|
if nlg_is_ws(c) {
|
|
let i = i + 1
|
|
} else {
|
|
let running = false
|
|
}
|
|
}
|
|
}
|
|
return i
|
|
}
|
|
|
|
// Scan a token (non-whitespace, non-paren run); return [token_string, end_pos].
|
|
fn scan_token(s: String, start: Int) -> [String] {
|
|
let n: Int = str_len(s)
|
|
let i: Int = start
|
|
let running: Bool = true
|
|
while running {
|
|
if i >= n {
|
|
let running = false
|
|
} else {
|
|
let c: String = str_slice(s, i, i + 1)
|
|
if nlg_is_ws(c) {
|
|
let running = false
|
|
} else {
|
|
if str_eq(c, "(") {
|
|
let running = false
|
|
} else {
|
|
if str_eq(c, ")") {
|
|
let running = false
|
|
} else {
|
|
let i = i + 1
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
let tok: String = str_slice(s, start, i)
|
|
let result: [String] = native_list_empty()
|
|
let result = native_list_append(result, tok)
|
|
let result = native_list_append(result, int_to_str(i))
|
|
return result
|
|
}
|
|
|
|
// Collect terminal words from a tree s-expression.
|
|
// Words are the second token in each "(LABEL WORD)" pair where WORD != "_".
|
|
// render a tree to a flat string by collecting leaf words.
|
|
// We walk the s-expression character by character.
|
|
|
|
fn render_tree(tree: String) -> String {
|
|
let words: [String] = native_list_empty()
|
|
let n: Int = str_len(tree)
|
|
let i: Int = 0
|
|
// Track depth: after opening paren, the first non-_ token at depth 1
|
|
// that is followed by a closing paren (or more tokens) is a leaf word.
|
|
// Strategy: extract all tokens, skip labels (first after '(') and '_'.
|
|
// All other tokens that aren't '(' or ')' are leaf words.
|
|
let prev_was_open: Bool = false
|
|
let is_first_after_open: Bool = false
|
|
while i < n {
|
|
let c: String = str_slice(tree, i, i + 1)
|
|
if str_eq(c, "(") {
|
|
let prev_was_open = true
|
|
let i = i + 1
|
|
} else {
|
|
if str_eq(c, ")") {
|
|
let prev_was_open = false
|
|
let i = i + 1
|
|
} else {
|
|
if nlg_is_ws(c) {
|
|
let i = i + 1
|
|
} else {
|
|
// Start of a token
|
|
let tok_info: [String] = scan_token(tree, i)
|
|
let tok: String = native_list_get(tok_info, 0)
|
|
let new_i: Int = str_to_int(native_list_get(tok_info, 1))
|
|
let i = new_i
|
|
// If this is the first token after '(' it is a label - skip
|
|
if prev_was_open {
|
|
let prev_was_open = false
|
|
// skip label
|
|
} else {
|
|
// It's a word or '_' placeholder
|
|
if !str_eq(tok, "_") {
|
|
let words = native_list_append(words, tok)
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return str_join(words, " ")
|
|
}
|
|
|
|
// ── Tree generator ────────────────────────────────────────────────────────────
|
|
//
|
|
// generate_tree(rule_id, slots) -> tree s-expression string
|
|
// slots: a [String] list of [key, val, key, val, ...] pairs
|
|
//
|
|
// Known slot keys:
|
|
// "agent" - NP subject (pronoun or noun phrase string)
|
|
// "predicate" - verb base form
|
|
// "patient" - NP object (noun phrase string, optional)
|
|
// "location" - PP location (e.g. "in the park")
|
|
// "tense" - "present" | "past" | "future"
|
|
// "aspect" - "simple" | "progressive" | "perfect"
|
|
// "det" - determiner for subject NP
|
|
// "aux" - auxiliary for questions
|
|
// "verb_surf" - pre-conjugated verb surface form
|
|
// "aux_surf" - pre-conjugated auxiliary surface form
|
|
|
|
fn generate_tree(rule_id_str: String, slots: [String]) -> String {
|
|
let rule: [String] = find_rule(rule_id_str)
|
|
let n: Int = native_list_len(rule)
|
|
if n == 0 {
|
|
return make_leaf("ERR", "unknown-rule")
|
|
}
|
|
|
|
let lhs: String = native_list_get(rule, 1)
|
|
let rhs_n: Int = n - 2
|
|
|
|
// ── S rules ───────────────────────────────────────────────────────────────
|
|
if str_eq(rule_id_str, "S-DECL") {
|
|
let agent: String = slots_get(slots, "agent")
|
|
let np_tree: String = build_np(agent, slots)
|
|
let vp_tree: String = build_vp_from_slots(slots)
|
|
return make_node2("S", np_tree, vp_tree)
|
|
}
|
|
|
|
if str_eq(rule_id_str, "S-QUEST") {
|
|
let agent: String = slots_get(slots, "agent")
|
|
let np_tree: String = build_np(agent, slots)
|
|
let vp_tree: String = build_vp_body(slots)
|
|
let aux_surf: String = slots_get(slots, "aux_surf")
|
|
return make_node3("S", make_leaf("Aux", aux_surf), np_tree, vp_tree)
|
|
}
|
|
|
|
if str_eq(rule_id_str, "S-IMP") {
|
|
let vp_tree: String = build_vp_from_slots(slots)
|
|
return make_node1("S", vp_tree)
|
|
}
|
|
|
|
return make_leaf(lhs, "?")
|
|
}
|
|
|
|
// Build an NP tree from a referent string.
|
|
// If the referent is a pronoun (I, you, he, she, it, we, they, me, him, her, us, them),
|
|
// use NP-PRON. If it looks like "the X" or "a X", parse accordingly.
|
|
// Otherwise treat as a proper noun.
|
|
|
|
fn is_pronoun(word: String) -> Bool {
|
|
if str_eq(word, "I") { return true }
|
|
if str_eq(word, "you") { return true }
|
|
if str_eq(word, "he") { return true }
|
|
if str_eq(word, "she") { return true }
|
|
if str_eq(word, "it") { return true }
|
|
if str_eq(word, "we") { return true }
|
|
if str_eq(word, "they") { return true }
|
|
if str_eq(word, "me") { return true }
|
|
if str_eq(word, "him") { return true }
|
|
if str_eq(word, "her") { return true }
|
|
if str_eq(word, "us") { return true }
|
|
if str_eq(word, "them") { return true }
|
|
return false
|
|
}
|
|
|
|
fn build_np(referent: String, slots: [String]) -> String {
|
|
if is_pronoun(referent) {
|
|
return make_node1("NP", make_leaf("Pron", referent))
|
|
}
|
|
// Try to parse "DET NOUN" or "DET ADJ NOUN" from the referent string
|
|
let parts: [String] = str_split(referent, " ")
|
|
let np: Int = native_list_len(parts)
|
|
if np == 1 {
|
|
// Single word - proper noun or bare noun
|
|
return make_node1("NP", make_leaf("N", referent))
|
|
}
|
|
if np == 2 {
|
|
// DET NOUN
|
|
let det: String = native_list_get(parts, 0)
|
|
let noun: String = native_list_get(parts, 1)
|
|
return make_node2("NP", make_leaf("Det", det), make_leaf("N", noun))
|
|
}
|
|
if np == 3 {
|
|
// DET ADJ NOUN
|
|
let det: String = native_list_get(parts, 0)
|
|
let adj: String = native_list_get(parts, 1)
|
|
let noun: String = native_list_get(parts, 2)
|
|
return make_node3("NP", make_leaf("Det", det), make_leaf("Adj", adj), make_leaf("N", noun))
|
|
}
|
|
// Fallback: treat the whole thing as a name
|
|
return make_node1("NP", make_leaf("N", referent))
|
|
}
|
|
|
|
fn build_pp(loc: String) -> String {
|
|
// loc is expected as "PREP NP" e.g. "in the park"
|
|
let parts: [String] = str_split(loc, " ")
|
|
let n: Int = native_list_len(parts)
|
|
if n < 2 {
|
|
return make_leaf("PP", loc)
|
|
}
|
|
let prep: String = native_list_get(parts, 0)
|
|
// Rest is the NP
|
|
let np_parts: [String] = native_list_empty()
|
|
let i: Int = 1
|
|
while i < n {
|
|
let np_parts = native_list_append(np_parts, native_list_get(parts, i))
|
|
let i = i + 1
|
|
}
|
|
let np_str: String = str_join(np_parts, " ")
|
|
let np_tree: String = build_np(np_str, native_list_empty())
|
|
return make_node2("PP", make_leaf("P", prep), np_tree)
|
|
}
|
|
|
|
fn build_vp_body(slots: [String]) -> String {
|
|
let verb_surf: String = slots_get(slots, "verb_surf")
|
|
let patient: String = slots_get(slots, "patient")
|
|
let loc: String = slots_get(slots, "location")
|
|
if !str_eq(patient, "") {
|
|
let obj_np: String = build_np(patient, slots)
|
|
if !str_eq(loc, "") {
|
|
let pp: String = build_pp(loc)
|
|
return make_node3("VP", make_leaf("V", verb_surf), obj_np, pp)
|
|
}
|
|
return make_node2("VP", make_leaf("V", verb_surf), obj_np)
|
|
}
|
|
if !str_eq(loc, "") {
|
|
let pp: String = build_pp(loc)
|
|
return make_node2("VP", make_leaf("V", verb_surf), pp)
|
|
}
|
|
return make_node1("VP", make_leaf("V", verb_surf))
|
|
}
|
|
|
|
fn build_vp_from_slots(slots: [String]) -> String {
|
|
let aux_surf: String = slots_get(slots, "aux_surf")
|
|
if !str_eq(aux_surf, "") {
|
|
let verb_surf: String = slots_get(slots, "verb_surf")
|
|
let patient: String = slots_get(slots, "patient")
|
|
let loc: String = slots_get(slots, "location")
|
|
if !str_eq(patient, "") {
|
|
let obj_np: String = build_np(patient, slots)
|
|
return make_node3("VP", make_leaf("Aux", aux_surf), make_leaf("V", verb_surf), obj_np)
|
|
}
|
|
return make_node2("VP", make_leaf("Aux", aux_surf), make_leaf("V", verb_surf))
|
|
}
|
|
return build_vp_body(slots)
|
|
}
|