61 lines
2.1 KiB
Common Lisp
61 lines
2.1 KiB
Common Lisp
|
(in-package #:cl-forth)
|
||
|
|
||
|
(defun interpret (input)
|
||
|
(let ((tokens (split-sequence #\Space input))) ;; Assuming you have a tokenizing function
|
||
|
(dolist (token tokens)
|
||
|
(cond
|
||
|
((equal token ":")
|
||
|
(setf *compile-mode* t))
|
||
|
|
||
|
((equal token ";")
|
||
|
(setf *compile-mode* nil)
|
||
|
;; Store the definition in the dictionary
|
||
|
(setf (gethash (car *current-definition*) *dictionary*)
|
||
|
(cdr *current-definition*))
|
||
|
(setf *current-definition* nil))
|
||
|
|
||
|
(*compile-mode*
|
||
|
(if (null *current-definition*)
|
||
|
;; First token is the name of the new word
|
||
|
(setf *current-definition* (list token))
|
||
|
;; Subsequent tokens are the body of the word
|
||
|
(push token (cdr *current-definition*))))
|
||
|
(t
|
||
|
(execute-word token))))))
|
||
|
|
||
|
(defun execute-word (token)
|
||
|
(cond
|
||
|
((digit-char-p (elt token 0))
|
||
|
;; Push numbers onto the stack
|
||
|
(push (parse-integer token) *stack*))
|
||
|
((gethash token *dictionary*)
|
||
|
;; If token is in dictionary, execute it
|
||
|
(let ((definition (gethash token *dictionary*)))
|
||
|
(if (functionp definition)
|
||
|
;; If it's a primitive word, just execute it
|
||
|
(funcall definition)
|
||
|
;; If it's a user-defined word, interpret each token in it
|
||
|
(dolist (word definition)
|
||
|
(execute-word word)))))
|
||
|
(t
|
||
|
(error "Unknown word: ~A" token))))
|
||
|
|
||
|
;; Please incorporate the above interpret and execute-word with evaluate-token and evaluate-line below:
|
||
|
(defmethod evaluate-line ((obj interpreter))
|
||
|
(let ((tokens (split-string #\Space (line-of obj))))
|
||
|
(dolist (token tokens)
|
||
|
(setf (current-token-of obj) token)
|
||
|
(evaluate-token obj))))
|
||
|
|
||
|
(defmethod evaluate-token ((obj interpreter))
|
||
|
(let* ((token (current-token-of obj))
|
||
|
(words (words-of (state-of obj)))
|
||
|
(dict-entry (gethash token words)))
|
||
|
(if dict-entry
|
||
|
(funcall dict-entry obj)
|
||
|
(let ((parsed (ignore-errors (parse-integer token))))
|
||
|
(if parsed
|
||
|
(push-to-stack (stack-of obj) parsed)
|
||
|
(signal 'unknown-word-error :token token))))))
|
||
|
|