cl-scopes/forge/sf.lisp

73 lines
1.4 KiB
Common Lisp

;;;; cl-scopes/forge - may the forge be with you!
;;;; A Forth-like interpreter implemented in Common Lisp.
(defpackage :scopes/forge/sf
(:use :common-lisp)
(:local-nicknames (:iter :scopes/util/iter))
(:export #:*input* #:*stack*
#:exec-list #:exec-input
#:reg #:reg2
#:pushd #:popd #:peekd))
(in-package :scopes/forge/sf)
(defvar *stack* nil)
(defvar *input* nil)
;;;; core definitions
(defgeneric exec-item (it)
(:method ((it t))
(pushd it))
(:method ((it symbol))
(funcall (func (symbol-value it)))))
(defgeneric comp-item (it))
(defgeneric call-item (it))
(defclass word ()
((func :reader func :initarg :func)))
(defmethod call-item ((it word))
(funcall (func it)))
(defclass comp-word (word) ())
(defun exec-list (lst)
(setf *input* (make-instance 'iter:list-iterator :data lst))
(exec-input))
(defun exec-input ()
(iter:process *input* #'exec-item))
(defun reg (sym fn)
(setf (symbol-value sym) (make-instance 'word :func fn)))
;(setf (symbol-value sym) fn))
(defun reg2 (sym fn)
(reg sym #'(lambda () (pushd (funcall fn (popd) (popd))))))
(defun pushd (v)
(push v *stack*))
(defun popd ()
(pop *stack*))
(defun peekd ()
(car *stack*))
;;;; builtins
(defpackage :sf-builtin
(:use :common-lisp)
(:local-nicknames (:f :scopes/forge/sf))
(:export #:add #:mul #:dup))
(in-package :sf-builtin)
(f:reg2 'add #'+)
(f:reg2 'mul #'*)
(f:reg 'dup #'(lambda () (pushd (peekd))))