From 78cce53f290d20dd33ce4ae517debd8db1b6baa5 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Fri, 13 Sep 2024 10:12:52 +0200 Subject: [PATCH] forge/sf: stack and vocabulary in class forge-env --- forge/sf.lisp | 22 ++++++++++++---------- test/test-sf.lisp | 2 +- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/forge/sf.lisp b/forge/sf.lisp index 137024f..54c3cb9 100644 --- a/forge/sf.lisp +++ b/forge/sf.lisp @@ -7,7 +7,7 @@ (:local-nicknames (:iter :scopes/util/iter) (:util :scopes/util)) (:export #:forge-env #:vocabulary #:stack - #:*forge-env* #:*stack* #:*input* #:*code* + #:*forge-env* #:*input* #:*code* #:word #:comp-word #:exec-list #:exec-input #:comp-input #:call #:comp-item @@ -19,11 +19,10 @@ (defclass forge-env () ((vocabulary :reader vocabulary :initform (make-hash-table)) (func-index :reader func-index :initform (make-hash-table)) - (stack :reader stack :initform nil))) + (stack :accessor stack :initform nil))) (defvar *forge-env* (make-instance 'forge-env)) -(defvar *stack* nil) (defvar *input* nil) (defvar *buffer* nil) (defvar *code* nil) @@ -40,7 +39,7 @@ (:method ((it t)) (pushd it)) (:method ((it symbol)) - (let ((v (symbol-value it))) + (let ((v (find-word it))) (when v (exec-item v))))) @@ -49,11 +48,14 @@ (push #'lit *buffer*) (push it *buffer*)) (:method ((it symbol)) - (let ((v (symbol-value it))) + (let ((v (find-word it))) (when v ;(util:lgi it v) (comp-item v))))) +(defun find-word (sym) + (gethash sym (vocabulary *forge-env*))) + ;;;; class word* (defclass word () @@ -88,11 +90,11 @@ (defun call (code) (let ((*code* (make-instance 'iter:list-iterator :data code))) - ;(util:lgi code) + (util:lgi code) (iter:process *code* #'funcall))) (defun reg (sym fn &optional (cls 'word)) - (setf (symbol-value sym) (make-instance cls :func fn)) + (setf (gethash sym (vocabulary *forge-env*)) (make-instance cls :func fn)) (setf (gethash fn (func-index *forge-env*)) sym)) (defun reg2 (sym fn) @@ -104,13 +106,13 @@ (reg name #'(lambda () (call code)) cls))) (defun pushd (v) - (push v *stack*)) + (push v (stack *forge-env*))) (defun popd () - (pop *stack*)) + (pop (stack *forge-env*))) (defun peekd () - (car *stack*)) + (car (stack *forge-env*))) (defun lit () (pushd (iter:next-value *code*))) diff --git a/test/test-sf.lisp b/test/test-sf.lisp index e717444..5ee3ff6 100644 --- a/test/test-sf.lisp +++ b/test/test-sf.lisp @@ -20,7 +20,7 @@ ;(forge:setup-builtins) (test-exec) (test-def))) - (util:lgi forge:*stack*) + (util:lgi (forge:stack forge:*forge-env*)) (t:show-result))) (deftest test-exec ()