From 43a0b0f9d896c31ef76f9c5fafba13e52984f4ad Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Fri, 24 May 2024 19:52:58 +0200
Subject: [PATCH] forge improvements: use macro for registration, initialize
 builtins via explicit init-forge-env

---
 forge/forge.lisp     | 30 +++++++++++++++++++-----------
 test/test-forge.lisp |  1 +
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/forge/forge.lisp b/forge/forge.lisp
index 70a454a..31f0e01 100644
--- a/forge/forge.lisp
+++ b/forge/forge.lisp
@@ -4,7 +4,7 @@
 
 (defpackage :scopes/forge
   (:use :common-lisp)
-  (:export #:*forge-env*
+  (:export #:*forge-env* #:init-forge-env
            #:forge-env #:dstack #:exec #:exec-str #:repl
            #:make-iseq #:isq-all #:isq-cur #:isq-next #:isq-end #:isq-add))
 
@@ -80,25 +80,29 @@
   (let ((p (or p (current-package))))
     (set-word (intern (string sym) p) fn)))
 
+(defmacro reg (sym &body body)
+  `(register ',sym #'(lambda () ,@body) :sf-builtin))
+
 ;;; builtins
 
-(defun reg-b (sym fn)
-  (register sym fn :sf-builtin))
-
-(reg-b 'add #'(lambda () (pushd (+ (popd) (popd)))))
-(reg-b 'mul #'(lambda () (pushd (* (popd) (popd)))))
-
-(reg-b 'dup #'(lambda () (pushd (car (dstack)))))
-
 (defvar lit #'(lambda () (pushd (isq-next (fip)))))
-(reg-b 'lit lit)
 
-(register-comp-word 'def
+(defun init-forge-env ()
+
+  (reg add (pushd (+ (popd) (popd))))
+  (reg mul (pushd (* (popd) (popd))))
+
+  (reg dup (pushd (car (dstack))))
+
+  (register 'lit lit :sf-builtin)
+
+  (register-comp-word 'def
   #'(lambda () 
       (let* ((name (isq-next (frp)))
              (code (comp (isq-next (frp)))))
         (register name #'(lambda () (call code)))))
   :sf-builtin)
+)
 
 ;;; compiler, interpreter
 
@@ -168,3 +172,7 @@
 
 (defun current-package () (slot-value *forge-env* 'current-package))
 
+(defun activate-package(p)
+  (let ((old (current-package)))
+    (setf (slot-value *forge-env* 'current-package) p)
+    old))
diff --git a/test/test-forge.lisp b/test/test-forge.lisp
index 9a884e9..91239ee 100644
--- a/test/test-forge.lisp
+++ b/test/test-forge.lisp
@@ -13,6 +13,7 @@
 
 (defun run ()
   (let ((t:*test-suite* (t:test-suite "forge")))
+    (forge:init-forge-env)
     (test-iseq)
     (test-exec)
     ;(format t "~%data-stack ~a" (dstack))