Added string literals

README.org

@@ -5,11 +5,18 @@ Tsoding'in Porth (Forth in Python) serisinden esinlenme.
 [[https://www.youtube.com/playlist?list=PLpM-Dvs8t0VbMZA7wW9aR3EtBqe2kinu4][Porth playlist]]
 [[https://gitlab.com/tsoding/porth][gitlab]]
 
-* Yol Haritası
-koşullu dallanma (if)
-döngüler
-fonksiyon tanımı
-string literal
+* Kurulum
+
+* Örnekler
+
+* Yol Haritası
++ koşullu dallanma (if)
++ döngüler
+fonksiyon tanımı
++ string literal
+static typing (belki)
+windows ve macos desteği
+
+* Kaynak
+[[https://concatenative.org/wiki/][Concatenative languages]]
 
-* readme TODO
-örnek ekle vb.

assembly.lisp

@@ -127,9 +127,14 @@
 ;;; Hopefully these two are done, need testing...
 
 ;; ( -- a)
-(defop (push a) (:lex nil)
+(defop (push-int a) (:lex nil)
   ("push ~d" a))
 
+(defop (push-str len addr str) (:lex nil)
+  (progn (:write ("push ~d" len)
+                 ("push str_~d" addr))
+         (list :string addr str)))
+
 (defop + ()
   (rbx rax -- (:add rax rbx)))
 
@@ -236,14 +241,28 @@
         (:write ("pop ~a" (aref call-regs i)))
         (finally (:write "syscall"))))
 
+(defun comment-safe-str (str)
+  "Handle newlines for asm comment"
+  (with-output-to-string (new-str)
+    (iter (for ch in-string str with-index i)
+          (cond ((> i 10)
+                 (princ "..." new-str)
+                 (finish))
+                ((char= #\Newline ch)
+                 (princ "\\n" new-str))
+                (t (write-char ch new-str))))))
+
 (defun gen-header (op str)
-  (format str "    ;; -- ~s --~%" op))
+  (format str "    ;; -- ~s --~%"
+          (mapcar (lambda (x) (if (stringp x) (comment-safe-str x) x)) 
+                  op)))
 
 (defun gen-code (op str)
   (let ((op-fn (gethash (string (car op)) *operations*)))
-    (if (null op-fn)
-        (error "~s is not a valid op" op)
-        (apply op-fn str (cdr op)))))
+    (when (null op-fn)
+      (error "~s is not a valid op" op))
+    (gen-header op str)
+    (apply op-fn str (cdr op))))
 
 (defun gen-dump (str)
   (format str "~{~a~%~}"

cl-forth.lisp

@@ -1,7 +1,7 @@
 (in-package :cl-forth)
 
 (defun make-token (sym? line col)
-  (if (or (numberp sym?) (is-identifier sym?))
+  (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)))
 
@@ -9,6 +9,17 @@
   (car token))
 
 ;;; LEXER
+(defun read-string (stream)
+  ;; TODO: Handle unmatched " and give proper error message
+  (with-output-to-string (str)
+    (iter (for ch = (read-char stream))
+          (cond ((char= ch #\")
+                 (finish))
+                ((and (char= ch #\\) (char= (peek-char nil stream) #\n))
+                 (read-char stream)
+                 (write-char #\Newline str))
+                (t (write-char ch str))))))
+
 (defun lex-line (line &optional (line-num 0))
   (iter (with line-stream = (make-string-input-stream line))
         (with col = 0)
@@ -25,6 +36,11 @@
             ((char= #\Space next-char) (read-char line-stream))
             ((char= #\; next-char) ;; and not in string
              (finish))
+            ((char= #\" next-char)
+             (read-char line-stream)
+             (collect (make-token (read-string line-stream)
+                                  line-num col)
+               into tokens))
             (t (setf flag nil)))
           (when flag
             (incf col)
@@ -95,7 +111,10 @@
         (for token in tokens)
         (let ((op (token-op token)))
           (cond ((numberp op)
-                 (vector-push-extend `(push ,op) ops))
+                 (vector-push-extend `(push-int ,op) ops))
+                ((stringp op)
+                 (vector-push-extend `(push-str ,(length op) ,i ,op)
+                                     ops))
                 ((string= 'ise op)
                  (push (list 'ise i) stack)
                  (vector-push-extend (list 'ise nil) ops))