diff options
| -rw-r--r-- | cl-forth.lisp | 24 | ||||
| -rw-r--r-- | test/tests.lisp | 6 |
2 files changed, 20 insertions, 10 deletions
diff --git a/cl-forth.lisp b/cl-forth.lisp index d935956..1026253 100644 --- a/cl-forth.lisp +++ b/cl-forth.lisp @@ -1,9 +1,16 @@ (in-package :cl-forth) -(defun make-token (sym? line col) - (if (or (numberp sym?) (stringp sym?) (is-identifier sym?)) - (values (list sym? :line line :col col) nil) - (values (list sym? :line line :col col :error t) t))) +(defun make-token (sym? line col &optional (type nil)) + (when (null type) + (setf type + (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) (car token)) @@ -32,7 +39,7 @@ ;; (read-char line-stream)) ((char= #\| next-char) (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= #\; next-char) ;; and not in string (finish)) @@ -109,10 +116,11 @@ (with stack = ()) (for i from 0) (for token in tokens) - (let ((op (token-op token))) - (cond ((numberp op) + (let ((op (token-op token)) + (op-type (getf (cdr token) :type))) + (cond ((eq :number op-type) (vector-push-extend `(push-int ,op) ops)) - ((stringp op) + ((eq :string op-type) (vector-push-extend `(push-str ,(length op) ,i ,op) ops)) ((string= 'ise op) diff --git a/test/tests.lisp b/test/tests.lisp index c36a5f2..2dfb4cb 100644 --- a/test/tests.lisp +++ b/test/tests.lisp @@ -68,9 +68,11 @@ (delete-file (probe-file (drop-file-type abs-path))))) successful)) -(defun run-tests () +(defun run-tests (&optional (ignore-err nil)) (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) (string= "lorth" (pathname-type file))) (cl-fad:list-directory |