fixed "|" :string and | :identifier confusion

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