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

defop uses generic functions now. extended stack syntax

Browse Source
This commit is contained in:
mRnea
2024-08-06 23:02:14 +03:00
parent d989745845
commit b215590395
3 changed files with 170 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files

115
cl-forth.lisp
View File

@@ -28,40 +28,41 @@
(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)
(with has-err = nil)
(for next-char = (peek-char nil line-stream nil nil))
(until (null next-char))
(let ((flag t))
(cond ;; ((char= #\. next-char)
;; (collect (make-token '|.| line-num col) into tokens)
;; (read-char line-stream))
((char= #\| next-char)
(read-char line-stream)
(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))
((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)
(next-iteration)))
(for next-sym in-stream line-stream
using #'read-preserving-whitespace)
(multiple-value-bind (token err)
(make-token next-sym line-num col)
(collect token into tokens)
(when err ;; skip line on error and continue lexing
(setf has-err t)
(finish))
(incf col (length (princ-to-string next-sym))))
(finally (return (values tokens has-err)))))
(let ((*package* (find-package "KEYWORD")))
(iter (with line-stream = (make-string-input-stream line))
(with col = 0)
(with has-err = nil)
(for next-char = (peek-char nil line-stream nil nil))
(until (null next-char))
(let ((flag t))
(cond ;; ((char= #\. next-char)
;; (collect (make-token '|.| line-num col) into tokens)
;; (read-char line-stream))
((char= #\| next-char)
(read-char line-stream)
(collect (make-token :pipe line-num col :identifier) into tokens))
((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)
(next-iteration)))
(for next-sym in-stream line-stream
using #'read-preserving-whitespace)
(multiple-value-bind (token err)
(make-token next-sym line-num col)
(collect token into tokens)
(when err ;; skip line on error and continue lexing
(setf has-err t)
(finish))
(incf col (length (princ-to-string next-sym))))
(finally (return (values tokens has-err))))))
(defun lex-file (file-name &optional report-errors)
(let ((has-error nil))
@@ -119,39 +120,39 @@
(let ((op (token-op token))
(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))
((eq :string op-type)
(vector-push-extend `(push-str ,(length op) ,i ,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))
((string= 'yoksa op)
((string= :ise op)
(push (list :ise i) stack)
(vector-push-extend (list :ise nil) ops))
((string= :yoksa op)
(let ((top (pop stack)))
(assert (string= 'ise (car top)))
(assert (string= :ise (car top)))
(setf (second (aref ops (cadr top))) i)
(push (list 'yoksa i) stack)
(vector-push-extend (list 'yoksa nil i) ops)))
((string= 'yap op)
(push (list :yoksa i) stack)
(vector-push-extend (list :yoksa nil i) ops)))
((string= :yap op)
(let ((top (pop stack)))
(cond ((find (car top) (list 'yoksa 'ise))
(cond ((find (car top) (list :yoksa :ise))
(setf (second (aref ops (cadr top))) i)
(vector-push-extend (list 'yap i) ops))
((string= 'iken (car top))
(vector-push-extend (list :yap i) ops))
((string= :iken (car top))
(setf (second (aref ops (cadr top))) i)
(vector-push-extend (list 'yap i (third top)) ops))
(vector-push-extend (list :yap i (third top)) ops))
(t (error "yap cannot reference: ~a" (car top))))))
((string= 'döngü op)
(push (list 'döngü i) stack)
(vector-push-extend (list 'döngü i) ops))
((string= 'iken op)
((string= :döngü op)
(push (list :döngü i) stack)
(vector-push-extend (list :döngü i) ops))
((string= :iken op)
(let ((top (pop stack)))
(assert (string= 'döngü (car top)))
(push (list 'iken i (cadr top)) stack)
(vector-push-extend (list 'iken nil) ops)))
(assert (string= :döngü (car top)))
(push (list :iken i (cadr top)) stack)
(vector-push-extend (list :iken nil) ops)))
((search "syscall" (string-downcase (string op)))
(let ((syscall-num (parse-integer (subseq (string op) 8))))
(vector-push-extend (list 'syscall syscall-num) ops)))
(vector-push-extend (list :syscall syscall-num) ops)))
(t (vector-push-extend (list op) ops))))
(finally (return ops))))
@@ -173,7 +174,7 @@
(let ((gen-val (gen-code op out)))
(when (and (consp gen-val) (eq :string (car gen-val)))
(push (cdr gen-val) strs))))
(gen-code '(exit 0) out)
(gen-code '(:exit 0) out)
(unless (null strs)
(format out "segment .data~%")
(dolist (str strs)