From 83a987c92eef93772d682774f9877c0b507dc2e6 Mon Sep 17 00:00:00 2001
From: Andy Maloney <asmaloney@gmail.com>
Date: Sat, 26 Aug 2023 11:08:36 -0400
Subject: [PATCH] {vanilla} Add a custom print function to clean up chunk
 output a little (#392)

Still not 100% what I want, but it's better...
---
 framework/vanilla_actr/vanilla_actr.go    | 23 ++++++++++++++-
 framework/vanilla_actr/vanilla_print.lisp | 34 +++++++++++++++++++++++
 2 files changed, 56 insertions(+), 1 deletion(-)
 create mode 100644 framework/vanilla_actr/vanilla_print.lisp

diff --git a/framework/vanilla_actr/vanilla_actr.go b/framework/vanilla_actr/vanilla_actr.go
index ebfbcce..689966e 100644
--- a/framework/vanilla_actr/vanilla_actr.go
+++ b/framework/vanilla_actr/vanilla_actr.go
@@ -3,6 +3,7 @@
 package vanilla_actr
 
 import (
+	_ "embed"
 	"fmt"
 	"os"
 	"path/filepath"
@@ -23,6 +24,11 @@ import (
 	"github.com/asmaloney/gactar/util/numbers"
 )
 
+//go:embed vanilla_print.lisp
+var vanillaPrint string
+
+const vanillaPrintFileName = "vanilla_print.lisp"
+
 func init() {
 	// We only support 64-bit. Nobody still uses 32-bit, right?
 	osArch := fmt.Sprintf("%s/%s", runtime.GOOS, runtime.GOARCH)
@@ -137,6 +143,14 @@ func (v *VanillaACTR) Run(initialBuffers framework.InitialBuffers) (result *fram
 
 // WriteModel converts the internal actr.Model to Lisp and writes it to a file.
 func (v *VanillaACTR) WriteModel(path string, initialBuffers framework.InitialBuffers) (outputFileName string, err error) {
+	// If our model has a print statement, then write out our support file
+	if v.model.HasPrintStatement() {
+		err = framework.WriteSupportFile(path, vanillaPrintFileName, vanillaPrint)
+		if err != nil {
+			return
+		}
+	}
+
 	outputFileName = fmt.Sprintf("%s.lisp", v.modelName)
 	if path != "" {
 		outputFileName = fmt.Sprintf("%s/%s", path, outputFileName)
@@ -665,7 +679,7 @@ func (v *VanillaACTR) outputStatement(s *actr.Statement) {
 			ids := strings.Split(id, ".")
 
 			if len(ids) == 1 {
-				v.Write("\t!bind!\t=value%d (printed-buffer-chunk '%s)\n", v.printStatementCount, id)
+				v.Write("\t!bind!\t=value%d (vanilla-print-buffer '%s)\n", v.printStatementCount, id)
 				v.Write("\t!output!\t(%q =value%d)\n", fmt.Sprintf("%s: ~a", id), v.printStatementCount)
 			} else {
 				v.Write("\t!bind!\t=value%d (buffer-slot-value '%s '%s)\n", v.printStatementCount, ids[0], ids[1])
@@ -736,6 +750,13 @@ func (v VanillaACTR) createRunFile(modelFile string) (outputFile string, err err
 
 	path := filepath.Join(v.envPath, "actr", "load-single-threaded-act-r.lisp")
 	v.Writeln(`(load "%s")`, filepath.ToSlash(path))
+
+	if v.model.HasPrintStatement() {
+		path = filepath.Join(v.tmpPath, vanillaPrintFileName)
+
+		v.Writeln(`(load "%s")`, path)
+	}
+
 	v.Writeln(`(load "%s")`, filepath.ToSlash(modelFile))
 
 	// TODO: We should be able to set this somewhere.
diff --git a/framework/vanilla_actr/vanilla_print.lisp b/framework/vanilla_actr/vanilla_print.lisp
new file mode 100644
index 0000000..9a3ea0b
--- /dev/null
+++ b/framework/vanilla_actr/vanilla_print.lisp
@@ -0,0 +1,34 @@
+;; I used "printed-buffer-chunk" as an example to get this working,
+;; but I have not been able to do exactly what I want.
+
+;; Right now this produces something like:
+
+;;   goal: GOAL-CHUNK0
+;;     NUM1  3
+;;     NUM2  1
+;;     COUNT  EMPTY
+;;     SUM  EMPTY
+
+;; What I want is more like this:
+
+;;   goal: add(count=empty, num1=3, num2=1, sum=empty)
+
+;; 1. I don't know how to get the "isa" from the chunk ("GOAL-CHUNK0" -> "add" in this case).
+
+;; 2. Displaying each of the slots is actually happening in "printed-chunk", but I don't
+;; understand Lisp enough to pick it apart & format the way I want it.
+
+(defun vanilla-print-buffer (&rest buffer-names-list)
+   (verify-current-model
+    "vanilla-print-buffer called with no current model."
+    (let ((s (make-string-output-stream)))
+      (dolist (buffer-name (if buffer-names-list
+                               buffer-names-list
+                             (model-buffers)))
+        (let ((buffer (buffer-instance buffer-name)))
+          (when buffer
+            (bt:with-recursive-lock-held ((act-r-buffer-lock buffer))
+              (let ((chunk (act-r-buffer-chunk buffer)))
+                (when buffer-names-list
+                  (format s "~a" (printed-chunk chunk))))))))
+      (get-output-stream-string s))))
\ No newline at end of file