From 27fb32feb2f87024457b0a20a6758b3b62055814 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Mon, 29 Apr 2024 14:48:05 +0200 Subject: [PATCH] compile code in def --- forge/forge.lisp | 23 ++++++++++++++++++----- scratch.lisp | 6 +++--- 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/forge/forge.lisp b/forge/forge.lisp index 7bd5303..3a41f00 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -28,9 +28,10 @@ (defun exec (fe code) (dolist (x code) - (if (symbolp x) - (funcall (find-word (vocabulary fe) x) fe) - (pushd fe x)))) + (typecase x + (symbol (funcall (find-word (vocabulary fe) x) fe)) + (compiled-function (funcall x fe)) + (t (pushd fe x))))) (defun register (voc key fn) (let ((k (if (symbolp key) (symbol-name key) key))) @@ -46,6 +47,18 @@ (do ((input (read-line) (read-line))) ((string= input "q") nil) (exec-str fe input))) +(defun comp (fe inp) + (let ((code nil)) + (dolist (item inp) + (setf code (cons (comp1 fe item) code))) + (reverse code))) + +(defun comp1 (fe item) + (format t "~%item: ~a" item) + (typecase item + (symbol (find-word (vocabulary fe) item)) + (t item))) + ; built-in primitives (defun reg-b (key fn) (register *builtins* key fn)) @@ -59,8 +72,8 @@ (reg-b "??" #'(lambda (fe) (format t "~a~%" (data-stack fe)))) (reg-b "def" #'(lambda (fe) - (let ((name (popd fe)) - (code (popd fe))) + (let* ((name (popd fe)) + (code (comp fe (popd fe)))) (register (voc fe) name #'(lambda (fe) (exec fe code)))))) (reg-b "const" #'(lambda (fe) diff --git a/scratch.lisp b/scratch.lisp index 6af74fe..4cb0781 100644 --- a/scratch.lisp +++ b/scratch.lisp @@ -20,13 +20,13 @@ (package-name (symbol-package y))))))) (defun x-make-var (value) - #'(lambda (&optional (nv nil)) - (if (eq nv nil) + #'(lambda (nv) + (if (null nv) value (setf value nv)))) (defun x-get-var (vf) - (funcall vf)) + (funcall vf nil)) (defun x-put-var (vf value) (funcall vf value))