branching (if else) added, as interpretation and compilation

1 files changed, 15 insertions, 11 deletions

diff --git a/cl-forth.lisp b/cl-forth.lisp
index 14b6573..f7ea66e 100644
--- a/cl-forth.lisp
+++ b/cl-forth.lisp
@@ -74,16 +74,24 @@
 (defun parse-tokens (tokens)
   (iter (with ops = (make-array (length tokens) :fill-pointer 0
                                                 :adjustable t))
+        (with if-stack = ())
         (for i from 0)
         (for token in tokens)
         (let ((op (token-op token)))
           (cond ((numberp op)
                  (vector-push-extend `(push ,op) ops))
                 ((eq 'ise op)
-                 (vector-push-extend
-                  `(ise ,(position 'yap tokens :start i :key #'token-op))
-                  ops))
-                ;; currently does not handle nesting
+                 (push i if-stack)
+                 (vector-push-extend (list 'ise nil) ops))
+                ((eq 'yoksa op)
+                 (let ((current (pop if-stack)))
+                   (setf (second (aref ops current)) i)
+                   (push i if-stack)
+                   (vector-push-extend (list 'yoksa nil i) ops)))
+                ((eq 'yap op)
+                 (let ((current (pop if-stack)))
+                   (setf (second (aref ops current)) i)
+                   (vector-push-extend (list 'yap i) ops)))
                 (t (vector-push-extend (list op) ops))))
         (finally (return ops))))
 
@@ -141,6 +149,7 @@
                                        1 0)
                                    stack))
             (yap (next-iteration))
+            (yoksa (setf i (second op)))
             (ise (if (= (vector-pop stack) 1)
                      nil
                      (setf i (second op))))
@@ -184,13 +193,8 @@
                              "_start:"))
     (iter (for op in-sequence program)
           (gen-header op out)
-          (let ((op-fn (gethash (car op) *operations*)))
-            (if (null op-fn)
-                (format t "~s is not an op" (car op))
-                (apply op-fn out (cdr op)))))
-    (format out "~{~a~%~}" '("    mov rax, 60"
-                             "    mov rdi, 0"
-                             "    syscall")))
+          (gen-code op out))
+    (gen-code '(exit 0) out))
   (when compile
     (run `("nasm" "-felf64" ,path))
     (let ((name (first (uiop:split-string path :separator '(#\.)))))