simyager/kurt
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed "|" :string and | :identifier confusion

Browse Source
This commit is contained in:
mRnea
2024-08-03 20:18:21 +03:00
parent 2cbb10fc6b
commit d989745845
2 changed files with 20 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
cl-forth.lisp
View File

@@ -1,9 +1,16 @@
(in-package :cl-forth) (in-package :cl-forth)
(defun make-token (sym? line col) (defun make-token (sym? line col &optional (type nil))
(if (or (numberp sym?) (stringp sym?) (is-identifier sym?)) (when (null type)
(values (list sym? :line line :col col) nil) (setf type
(values (list sym? :line line :col col :error t) t))) (cond ((numberp sym?) :number)
((stringp sym?) :string)
((is-identifier sym?) :identifier)
(t
;; temporary hack...
(return-from make-token
(values (list sym? :line line :col col :error t) t))))))
(values (list sym? :line line :col col :type type) nil))
(defun token-op (token) (defun token-op (token)
(car token)) (car token))
@@ -32,7 +39,7 @@
;; (read-char line-stream)) ;; (read-char line-stream))
((char= #\| next-char) ((char= #\| next-char)
(read-char line-stream) (read-char line-stream)
(collect (make-token "|" line-num col) into tokens)) (collect (make-token "|" line-num col :identifier) into tokens))
((char= #\Space next-char) (read-char line-stream)) ((char= #\Space next-char) (read-char line-stream))
((char= #\; next-char) ;; and not in string ((char= #\; next-char) ;; and not in string
(finish)) (finish))
@@ -109,10 +116,11 @@
(with stack = ()) (with stack = ())
(for i from 0) (for i from 0)
(for token in tokens) (for token in tokens)
(let ((op (token-op token))) (let ((op (token-op token))
(cond ((numberp op) (op-type (getf (cdr token) :type)))
(cond ((eq :number op-type)
(vector-push-extend `(push-int ,op) ops)) (vector-push-extend `(push-int ,op) ops))
((stringp op) ((eq :string op-type)
(vector-push-extend `(push-str ,(length op) ,i ,op) (vector-push-extend `(push-str ,(length op) ,i ,op)
ops)) ops))
((string= 'ise op) ((string= 'ise op)

6
test/tests.lisp
View File

@@ -68,9 +68,11 @@
(delete-file (probe-file (drop-file-type abs-path))))) (delete-file (probe-file (drop-file-type abs-path)))))
successful)) successful))
(defun run-tests () (defun run-tests (&optional (ignore-err nil))
(loop for success? (loop for success?
in (mapcar #'run-test in (mapcar (lambda (file) (if (not ignore-err)
(run-test file)
(ignore-errors (run-test file))))
(remove-if-not (lambda (file) (remove-if-not (lambda (file)
(string= "lorth" (pathname-type file))) (string= "lorth" (pathname-type file)))
(cl-fad:list-directory (cl-fad:list-directory