From e07c1aae40ce1f63922a02ed30504405800cecc4 Mon Sep 17 00:00:00 2001
From: bd <bdunahu@operationnull.com>
Date: Thu, 27 Jun 2024 01:25:16 -0600
Subject: Add ss-generator, a simple sentence generator

---
 ss-generator/ss-gen-test.scm | 24 ++++++++++++++++++++++
 ss-generator/ss-gen.scm      | 49 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 73 insertions(+)
 create mode 100644 ss-generator/ss-gen-test.scm
 create mode 100644 ss-generator/ss-gen.scm

diff --git a/ss-generator/ss-gen-test.scm b/ss-generator/ss-gen-test.scm
new file mode 100644
index 0000000..b550421
--- /dev/null
+++ b/ss-generator/ss-gen-test.scm
@@ -0,0 +1,24 @@
+;; -*- compile-command: "guile -L . ss-gen-test.scm"; -*-
+(use-modules (srfi srfi-64)
+             (ss-gen))
+
+(test-begin "harness")
+
+
+(test-equal "default Noun is a list of non-terminals"
+  '(Noun man ball woman table)
+  (assoc 'Noun *grammer*))
+
+(test-equal "default verb-phrase is a list of terminals"
+  '(verb-phrase (Verb noun-phrase))
+  (assoc 'verb-phrase *grammer*))
+
+(test-equal "default Verb resolve to expected words"
+  '(hit took saw liked)
+  (rewrites 'Verb))
+
+(test-assert "rewrites non-existent"
+  (not (rewrites 'Item)))
+
+
+(test-end "harness")
diff --git a/ss-generator/ss-gen.scm b/ss-generator/ss-gen.scm
new file mode 100644
index 0000000..fc668b6
--- /dev/null
+++ b/ss-generator/ss-gen.scm
@@ -0,0 +1,49 @@
+;;; Commentary:
+;;; This is a toy example program adapted from
+;;;
+;;; Paradigms of Artificial Intelligence Programming:
+;;; Case Studies in Common Lisp
+;;;
+;;; written down purely because the approach is similar
+;;; to something I need in a different project.
+;;; Code:
+
+
+(define-module (ss-gen)
+  #:export (*grammer*
+            rewrites))
+
+(define *simple-grammer*
+  '((sentence (noun-phrase verb-phrase))
+    (noun-phrase (Article Noun))
+    (verb-phrase (Verb noun-phrase))
+    (Article the a)
+    (Noun man ball woman table)
+    (Verb hit took saw liked)))
+
+(define *grammer* *simple-grammer*)
+
+(define (rule-rhs rule)
+  "Returns the right hand side of RULE.
+Returns false if there are no rewrites."
+  (if rule (cdr rule) #f))
+
+(define (rewrites category)
+  "Returns a list of the possible
+rewrites for CATEGORY."
+  (rule-rhs (assoc category *grammer*)))
+
+(define (random-elt lst)
+  "Selects a random element from LST."
+  (let* ((len (length lst))
+         (index (random len)))
+    (list-ref lst index)))
+
+(define (generate phrase)
+  "Generates a random sentence or phrase."
+  (cond
+   ((list? phrase)
+    (apply append (map generate phrase)))
+   ((rewrites phrase)
+    (generate (random-elt (rewrites phrase))))
+   (#t (list phrase))))
-- 
cgit v1.2.3