Will Anderson
556 lines
21 KiB
EmacsLisp
556 lines
21 KiB
EmacsLisp
// grammar.el - Grammar engine: syntactic structure, word order, phrase assembly.
|
|
//
|
|
// Language-specific word order and question strategy are driven by the language
|
|
// profile, not hardcoded. The slot map format (GramSpec) is universal; a "lang"
|
|
// key carries the ISO 639-1 code so every downstream function can resolve the
|
|
// active profile.
|
|
//
|
|
// GramSpec slot keys:
|
|
// intent - "assert" | "question" | "command"
|
|
// agent - subject referent string
|
|
// predicate - verb base form
|
|
// patient - object noun phrase (optional)
|
|
// location - prepositional phrase (optional)
|
|
// tense - "present" | "past" | "future"
|
|
// aspect - "simple" | "progressive" | "perfect"
|
|
// lang - ISO 639-1 code (default "en")
|
|
// verb_surf - conjugated verb surface form (computed)
|
|
// aux_surf - auxiliary surface form (computed)
|
|
//
|
|
// Depends on: language-profile
|
|
|
|
// ── Slot map helpers ──────────────────────────────────────────────────────────
|
|
|
|
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 ──────────────────────────────────────────────────────
|
|
|
|
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()
|
|
|
|
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"))
|
|
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"))
|
|
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"))
|
|
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 ────────────────────────────────────────────────────
|
|
|
|
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 ────────────────────────────────────────────────────────────
|
|
|
|
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
|
|
}
|
|
|
|
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
|
|
}
|
|
|
|
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
|
|
}
|
|
|
|
fn render_tree(tree: String) -> String {
|
|
let words: [String] = native_list_empty()
|
|
let n: Int = str_len(tree)
|
|
let i: Int = 0
|
|
let prev_was_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 {
|
|
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 prev_was_open {
|
|
let prev_was_open = false
|
|
} else {
|
|
if !str_eq(tok, "_") {
|
|
let words = native_list_append(words, tok)
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return str_join(words, " ")
|
|
}
|
|
|
|
// ── Word-order engine ─────────────────────────────────────────────────────────
|
|
|
|
// gram_word_order: returns the word order string from a profile.
|
|
fn gram_word_order(profile: [String]) -> String {
|
|
return lang_word_order(profile)
|
|
}
|
|
|
|
// gram_order_constituents: order Subject, Verb, Object tokens according to the
|
|
// language profile's word_order.
|
|
//
|
|
// subj, verb, obj: surface strings (may be empty).
|
|
// Returns a space-joined string in the correct order.
|
|
//
|
|
// Supported orders: SVO, SOV, VSO, VOS, OVS, OSV, free (defaults to SVO).
|
|
|
|
fn gram_order_constituents(subj: String, verb: String, obj: String, profile: [String]) -> String {
|
|
let order: String = gram_word_order(profile)
|
|
let parts: [String] = native_list_empty()
|
|
|
|
if str_eq(order, "SVO") {
|
|
if !str_eq(subj, "") { let parts = native_list_append(parts, subj) }
|
|
if !str_eq(verb, "") { let parts = native_list_append(parts, verb) }
|
|
if !str_eq(obj, "") { let parts = native_list_append(parts, obj) }
|
|
return str_join(parts, " ")
|
|
}
|
|
|
|
if str_eq(order, "SOV") {
|
|
if !str_eq(subj, "") { let parts = native_list_append(parts, subj) }
|
|
if !str_eq(obj, "") { let parts = native_list_append(parts, obj) }
|
|
if !str_eq(verb, "") { let parts = native_list_append(parts, verb) }
|
|
return str_join(parts, " ")
|
|
}
|
|
|
|
if str_eq(order, "VSO") {
|
|
if !str_eq(verb, "") { let parts = native_list_append(parts, verb) }
|
|
if !str_eq(subj, "") { let parts = native_list_append(parts, subj) }
|
|
if !str_eq(obj, "") { let parts = native_list_append(parts, obj) }
|
|
return str_join(parts, " ")
|
|
}
|
|
|
|
if str_eq(order, "VOS") {
|
|
if !str_eq(verb, "") { let parts = native_list_append(parts, verb) }
|
|
if !str_eq(obj, "") { let parts = native_list_append(parts, obj) }
|
|
if !str_eq(subj, "") { let parts = native_list_append(parts, subj) }
|
|
return str_join(parts, " ")
|
|
}
|
|
|
|
if str_eq(order, "OVS") {
|
|
if !str_eq(obj, "") { let parts = native_list_append(parts, obj) }
|
|
if !str_eq(verb, "") { let parts = native_list_append(parts, verb) }
|
|
if !str_eq(subj, "") { let parts = native_list_append(parts, subj) }
|
|
return str_join(parts, " ")
|
|
}
|
|
|
|
if str_eq(order, "OSV") {
|
|
if !str_eq(obj, "") { let parts = native_list_append(parts, obj) }
|
|
if !str_eq(subj, "") { let parts = native_list_append(parts, subj) }
|
|
if !str_eq(verb, "") { let parts = native_list_append(parts, verb) }
|
|
return str_join(parts, " ")
|
|
}
|
|
|
|
// "free" and unknown: use SVO as the neutral citation order.
|
|
if !str_eq(subj, "") { let parts = native_list_append(parts, subj) }
|
|
if !str_eq(verb, "") { let parts = native_list_append(parts, verb) }
|
|
if !str_eq(obj, "") { let parts = native_list_append(parts, obj) }
|
|
return str_join(parts, " ")
|
|
}
|
|
|
|
// gram_build_vp: construct a verb phrase surface string.
|
|
//
|
|
// verb: main verb surface form.
|
|
// aux: auxiliary surface form (empty if none).
|
|
// profile: language profile.
|
|
//
|
|
// In SVO/VSO/VOS languages the auxiliary precedes the main verb.
|
|
// In SOV languages the verb cluster appears at the end; we keep aux before V
|
|
// as a reasonable default for the auxiliary-final constructions in those languages.
|
|
|
|
fn gram_build_vp(verb: String, aux: String, profile: [String]) -> String {
|
|
if str_eq(aux, "") {
|
|
return verb
|
|
}
|
|
return aux + " " + verb
|
|
}
|
|
|
|
// gram_question_strategy: returns the question formation strategy for a language.
|
|
//
|
|
// "do-support" - English: "Do you see?" — do-auxiliary inserted, verb stays base
|
|
// "particle" - Japanese: sentence-final か appended
|
|
// "intonation" - Mandarin, Spanish: rising intonation only, word order unchanged
|
|
// "inversion" - French, German: subject-verb inversion
|
|
|
|
fn gram_question_strategy(profile: [String]) -> String {
|
|
let code: String = lang_get(profile, "code")
|
|
if str_eq(code, "en") { return "do-support" }
|
|
if str_eq(code, "ja") { return "particle" }
|
|
if str_eq(code, "zh") { return "intonation" }
|
|
if str_eq(code, "es") { return "intonation" }
|
|
if str_eq(code, "fr") { return "inversion" }
|
|
if str_eq(code, "de") { return "inversion" }
|
|
if str_eq(code, "ar") { return "intonation" }
|
|
if str_eq(code, "hi") { return "particle" }
|
|
if str_eq(code, "ru") { return "intonation" }
|
|
if str_eq(code, "fi") { return "particle" }
|
|
if str_eq(code, "sw") { return "intonation" }
|
|
if str_eq(code, "la") { return "intonation" } // Latin: word order marks Q (VSO or -ne suffix)
|
|
if str_eq(code, "he") { return "intonation" } // Modern Hebrew: rising intonation
|
|
if str_eq(code, "grc") { return "intonation" } // Ancient Greek: ἆρα particle or intonation
|
|
if str_eq(code, "ang") { return "intonation" } // Old English: hwæþer particle or intonation
|
|
if str_eq(code, "sa") { return "intonation" } // Sanskrit: kim particle or intonation
|
|
if str_eq(code, "got") { return "intonation" } // Gothic: ibai particle or intonation
|
|
if str_eq(code, "non") { return "intonation" } // Old Norse: hvárr particle or intonation
|
|
if str_eq(code, "enm") { return "do-support" } // Middle English: do-support emerging
|
|
if str_eq(code, "pi") { return "intonation" } // Pali: kim particle or intonation
|
|
// Unknown: default to intonation (safest — never wrong, just flat)
|
|
return "intonation"
|
|
}
|
|
|
|
// ── NP and PP assembly ────────────────────────────────────────────────────────
|
|
//
|
|
// These functions are profile-aware but the logic is the same across languages
|
|
// because we work with pre-assembled strings (Engram vocabulary supplies
|
|
// language-specific forms before these functions see them).
|
|
|
|
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
|
|
}
|
|
|
|
// build_np: assemble a noun phrase tree from a referent string.
|
|
// profile parameter reserved for future case-marking / article agreement.
|
|
fn build_np(referent: String, slots: [String]) -> String {
|
|
if is_pronoun(referent) {
|
|
return make_node1("NP", make_leaf("Pron", referent))
|
|
}
|
|
let parts: [String] = str_split(referent, " ")
|
|
let np: Int = native_list_len(parts)
|
|
if np == 1 {
|
|
return make_node1("NP", make_leaf("N", referent))
|
|
}
|
|
if np == 2 {
|
|
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 {
|
|
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))
|
|
}
|
|
return make_node1("NP", make_leaf("N", referent))
|
|
}
|
|
|
|
// build_pp: assemble a prepositional phrase tree from a "PREP NP" string.
|
|
// For postpositional languages (ja, hi, ko) the slot value is expected to be
|
|
// already pre-assembled with the postposition in the correct position by the
|
|
// caller (vocabulary lookup from Engram supplies the right surface form).
|
|
fn build_pp(loc: String) -> String {
|
|
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)
|
|
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)
|
|
}
|
|
|
|
// ── VP tree construction ──────────────────────────────────────────────────────
|
|
|
|
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)
|
|
}
|
|
|
|
// ── Tree generator ────────────────────────────────────────────────────────────
|
|
|
|
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)
|
|
|
|
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, "?")
|
|
}
|