add object helper functions

1 files changed, 57 insertions, 0 deletions

diff --git a/object.scm b/object.scm
new file mode 100644
index 0000000..c03d599
--- /dev/null
+++ b/object.scm
@@ -0,0 +1,57 @@
+;;; Copyright (C) Peter McGoron 2024
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, version 3 of the License.
+;;; 
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;; 
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+;;; 
+;;; 
+;;; Handles messages passed to objects. The state of each object is
+;;; expected to be in the table or in the environment. Each message
+;;; invokes a procedure whose name is the first argument to the object,
+;;; and the arguments to that procedure are the rest of the arguments to
+;;; the object.
+
+;;; Lookup NAME-AS-SYMBOL in TABLE and returns the handler, or the default
+;;; handler if not available.
+(define object:lookup
+  (lambda (table name-as-symbol)
+    (let ((node (smap:search table (symbol->string name-as-symbol))))
+      (if (null? node)
+          (set! node (smap:search table "default")))
+      (if (null? node)
+          (error "object:lookup" "no handler found for" name-as-symbol)
+          (map:val node)))))
+
+;;; Create an object with TABLE as its procedure table.
+(define object/table
+  (lambda (table)
+    (lambda (op . args)
+      (apply (object:lookup table op) args))))
+
+;;; Append procedures to a table.
+(define object:append-table
+  (lambda (table next-pairs)
+    (if (null? next-pairs)
+        table
+        (let ((key (symbol->string (car next-pairs)))
+              (proc (cadr next-pairs)))
+          (object:append-table
+           (car (smap:insert table key proc))
+           (cddr next-pairs))))))
+
+;;; Convert a list of 'SYMBOL PROCEDURE ... into a table.
+(define object:list->table
+  (lambda pairs
+    (object:append-table '() pairs)))
+
+
+(define object/procedures
+  (lambda procedures
+    (object/table (apply object:list->table procedures))))
\ No newline at end of file