From 3a764bc9f8545c2cf706b164efd1b6d0c903dfe8 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 26 May 2024 13:56:40 +0200
Subject: [PATCH] forge: minor refactoring - use + and * for add and mul, ...

---
 forge/forge.lisp     | 34 ++++++++++++++++------------------
 test/test-forge.lisp |  6 +++---
 2 files changed, 19 insertions(+), 21 deletions(-)

diff --git a/forge/forge.lisp b/forge/forge.lisp
index 0586ea7..256c211 100644
--- a/forge/forge.lisp
+++ b/forge/forge.lisp
@@ -1,4 +1,4 @@
-;;; cl-scopes/forge - may the forge be with you!
+;;;; cl-scopes/forge - may the forge be with you!
 
 ;;;; A Forth-like interpreter implemented in Common Lisp.
 
@@ -72,11 +72,10 @@
 (defun comp-words () (slot-value *forge-env* 'comp-words))
 
 (defun register-comp-word (sym fn)
-    (register sym fn :slot 'comp-words))
+  (register sym fn 'comp-words))
 
-(defun register (sym fn &key package (slot 'words))
-  (let* ((p (or package (current-package)))
-         (w (intern (string sym) p))
+(defun register (sym fn &optional (slot 'words))
+  (let* ((w (intern (string sym) (current-package)))
          (words (slot-value *forge-env* slot)))
     (setf (gethash w words) fn)))
 
@@ -85,21 +84,21 @@
 (defmacro reg (sym &body body)
   `(register ',sym #'(lambda () ,@body)))
 
-(defvar lit #'(lambda () (pushd (isq-next (fip)))))
+(defun lit () (pushd (isq-next (fip))))
 
 (defun setup-builtins ()
 
-  (reg add (pushd (+ (popd) (popd))))
-  (reg mul (pushd (* (popd) (popd))))
+  (reg + (pushd (+ (popd) (popd))))
+  (reg * (pushd (* (popd) (popd))))
 
   (reg dup (pushd (car (dstack))))
 
-  (register 'lit lit)
+  (register 'lit #'lit)
 
   (register-comp-word 'def
     #'(lambda () 
-        (let* ((name (isq-next (frp)))
-               (code (comp (isq-next (frp)))))
+        (let* ((name (read-next))
+               (code (comp (read-next))))
           (register name #'(lambda () (call code))))))
 
   (activate-package :sf-user))
@@ -132,8 +131,8 @@
         ((null item))
       (typecase item
         (symbol (comp-symbol item))
-        (cons (comp-item lit) (comp-item (comp item)))
-        (t (comp-item lit) (comp-item item)))))
+        (cons (comp-item #'lit) (comp-item (comp item)))
+        (t (comp-item #'lit) (comp-item item)))))
   (isq-all (fcp)))
 
 (defun comp-symbol (sym)
@@ -143,9 +142,6 @@
       (funcall comp-fn)
       (comp-item (gethash w (words))))))
 
-(defun comp-item (item)
-  (isq-add (fcp) item))
-
 (defun get-word (sym)
   (let ((name (string sym)))
     (dolist (p (packages))
@@ -159,12 +155,14 @@
 
 (defun pushd (v) (push v (data-stack *forge-env*)))
 
-(defun frp () (slot-value *forge-env* 'rp))
-
 (defun fcp () (slot-value *forge-env* 'cp))
 
+(defun comp-item (item) (isq-add (fcp) item))
+
 (defun fip () (slot-value *forge-env* 'ip))
 
+(defun read-next () (isq-next (slot-value *forge-env* 'rp)))
+
 (defun packages () (slot-value *forge-env* 'packages))
 
 (defun current-package () (slot-value *forge-env* 'current-package))
diff --git a/test/test-forge.lisp b/test/test-forge.lisp
index 2296f78..3be31ff 100644
--- a/test/test-forge.lisp
+++ b/test/test-forge.lisp
@@ -1,4 +1,4 @@
-;;; cl-scopes/test/test-forge
+;;;; cl-scopes/test/test-forge
 
 ;;;; testing facility for scopes/forge
 
@@ -29,10 +29,10 @@
     (== (forge:isq-end seq) 2)))
 
 (deftest test-exec ()
-  (forge:exec-str "4 2 add")
+  (forge:exec-str "4 2 +")
   (== (car (forge:dstack)) 6))
 
 (deftest test-def ()
-  (forge:exec-str "def square (dup mul)")
+  (forge:exec-str "def square (dup *)")
   (forge:exec-str "7 square")
   (== (car (forge:dstack)) 49))