From ca1f56e11af65e9b01fccaea2fed43d18cfbaf62 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sun, 15 Feb 2026 18:18:29 +0100 Subject: [PATCH] forge: compile / reg lisp expressions, setup-builtins --- forge/forge.lisp | 28 +++++++++++++++++++++++----- test/test-forge.lisp | 8 ++++++++ 2 files changed, 31 insertions(+), 5 deletions(-) diff --git a/forge/forge.lisp b/forge/forge.lisp index 9ba186e..4ec2c77 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -8,12 +8,13 @@ (:util :scopes/util)) (:export #:forge-env #:vocabulary #:stack #:current-package #:*forge-env* #:*input* #:*code* + #:comp-item #:word #:comp-word #:repl #:exec-list #:exec-string #:exec-stream #:run - #:exec-input #:comp-input #:comp-list #:call - #:comp-item + #:exec-input #:comp-input #:comp-list #:compile-lisp #:call #:next #:reg #:reg1 #:reg2 #:reg-code - #:pushd #:popd #:peekd)) + #:pushd #:popd #:peekd + #:setup-builtins)) (in-package :scopes/forge) @@ -85,9 +86,10 @@ (defun input-line (&key prompt) (if (null prompt) (setf prompt (format nil "~a> " (length (stack *forge-env*))))) - (rl:readline :prompt prompt)) + (rl:readline :prompt prompt :add-history t)) (defun repl () + ; TODO: load history, don't abort on errors, save history (do ((input (input-line) (input-line))) ((string= input "q") (stack *forge-env*)) (handler-bind @@ -124,6 +126,9 @@ (let ((*buffer* nil)) (iter:process (iter:list-iterator lst) #'comp-item) (pushd (reverse *buffer*)))) + +(defun compile-lisp (lst) + (compile nil (list 'lambda nil lst))) (defun call (code) ;(util:lgi code) @@ -132,6 +137,10 @@ ((null fn)) (funcall fn)))) +(defun x-call (code) + (let ((*code* (iter:list-iterator code))) + (iter:process *code* #'funcall))) + (defun reg (sym fn &optional (cls 'word)) (let ((sym (intern (symbol-name sym) (current-package *forge-env*)))) (setf (gethash sym (vocabulary *forge-env*)) (make-instance cls :func fn)) @@ -172,7 +181,9 @@ #:ptr #:get #:put #:in #:next #:call #:call-if #:call-while #:comp #:lit #:val - #:)) + #: + #:setup-builtins + )) (in-package :sf-builtin) @@ -219,7 +230,14 @@ (f:reg 'reg #'f:reg-code) (f:reg 'regc #'(lambda () (f:reg-code 'f:comp-word))) +(f:reg 'reg-lisp (lambda () (f:reg (f:popd) (f:compile-lisp (f:popd))))) (f:reg '/> #'(lambda () (iter:stop f:*input*)) 'f:comp-word) ;;;; forge-code word definitions + +(defun setup-builtins () + (f:run + (in in comp swp reg) comp in def reg + (in in swp reg-lisp) comp in def-lisp reg +)) diff --git a/test/test-forge.lisp b/test/test-forge.lisp index 2d9f97e..d69bec9 100644 --- a/test/test-forge.lisp +++ b/test/test-forge.lisp @@ -18,8 +18,10 @@ (progn ;(forge:setup-builtins) (test-exec) + (test-setup-builtins) (test-def) (test-val) + (test-comp) (test-if))) (util:lgi (forge:stack forge:*forge-env*)) (t:show-result))) @@ -35,6 +37,9 @@ (forge:exec-stream (make-string-input-stream "12 square")) (== (forge:popd) 144)) +(deftest test-setup-builtins () + (sf-builtin:setup-builtins)) + (deftest test-def () (forge:run in ") @@ -58,6 +63,9 @@ (deftest test-comp () (forge:run (2 3 mul) comp call) (== (forge:popd) 6) + (forge:run def cubic (dup dup mul mul) + 4 cubic) + (== (forge:popd) 64) ) (deftest test-if ()