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

Added support for cl identifier pipe

Browse Source
This commit is contained in:
mRnea
2024-08-16 19:09:26 +03:00
parent e90d124892
commit dbfa435e63
1 changed files with 30 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
cl-forth.lisp
View File

@@ -25,17 +25,17 @@
(write-char #\Newline str)) (write-char #\Newline str))
(t (write-char ch str)))))) (t (write-char ch str))))))
(defun read-character (stream) (defun read-character (stream line-num line col)
(let ((ch? (read-char stream))) (let ((ch? (read-char stream)))
(if (not (char-equal ch? #\\)) (if (not (char-equal ch? #\\))
(if (char-equal #\' (peek-char nil stream)) (if (char-equal #\' (peek-char nil stream))
(progn (read-char stream) ch?) (progn (read-char stream) ch?)
(error "Unterminated char.")) (error (handle-char-not-closed line-num line col)))
(progn (case (read-char stream) (progn (case (read-char stream)
(#\n (setf ch? #\Newline))) (#\n (setf ch? #\Newline)))
(if (char-equal #\' (peek-char nil stream)) (if (char-equal #\' (peek-char nil stream))
(progn (read-char stream) ch?) (progn (read-char stream) ch?)
(error "Unterminated char.")))))) (error (handle-char-not-closed line-num line col)))))))
(defun lex-line (line &optional (line-num 0)) (defun lex-line (line &optional (line-num 0))
(let ((*package* (find-package "KEYWORD"))) (let ((*package* (find-package "KEYWORD")))
@@ -46,8 +46,12 @@
(let ((flag t)) (let ((flag t))
(cond ((char= #\| next-char) (cond ((char= #\| next-char)
(read-char line-stream) (read-char line-stream)
(if (char-equal #\Space
(peek-char nil line-stream nil nil))
(collect (make-token :pipe line-num col :identifier) (collect (make-token :pipe line-num col :identifier)
into tokens)) into tokens)
(progn (unread-char #\| line-stream)
(setf flag nil))))
((char= #\Space next-char) (read-char line-stream)) ((char= #\Space next-char) (read-char line-stream))
((char= #\; next-char) ;; and not in string ((char= #\; next-char) ;; and not in string
(finish)) (finish))
@@ -58,7 +62,8 @@
into tokens)) into tokens))
((char= #\' next-char) ((char= #\' next-char)
(read-char line-stream) (read-char line-stream)
(collect (make-token (read-character line-stream) (collect (make-token (read-character
line-stream line-num line col)
line-num col :char) line-num col :char)
into tokens)) into tokens))
(t (setf flag nil))) (t (setf flag nil)))
@@ -114,6 +119,18 @@
(defmethod read-token ((parser parser)) (defmethod read-token ((parser parser))
(pop (tokens parser))) (pop (tokens parser)))
(defgeneric parse-token (parser type)
(:documentation "Parses the next token from TOKENS of parser depending on the TYPE."))
(defgeneric parse-op (parser token identifier)
(:documentation "When the TYPE of token is :IDENTIFIER, PARSE-TOKEN parses depending on the identifier of the token.")
(:method ((parser parser) token id) ;; default parsing
(cond ((search "syscall" (string-downcase (string (car token))))
(let ((syscall-num (parse-integer (subseq (string (car token)) 8))))
(add-op (list :syscall syscall-num) parser)))
(t (add-op (list id) parser)))))
(defmethod parse-token ((parser parser) (type (eql :number))) (defmethod parse-token ((parser parser) (type (eql :number)))
(add-op `(:push-int ,(car (read-token parser))) parser)) (add-op `(:push-int ,(car (read-token parser))) parser))
@@ -145,11 +162,11 @@
;; (add-op makro-op ops)) ;; (add-op makro-op ops))
;; ()) ;; ())
(defmethod parse-op ((parser parser) token (type (eql :ise))) (defmethod parse-op ((parser parser) token (id (eql :ise)))
(push (list :ise (index parser)) (if-stack parser)) (push (list :ise (index parser)) (if-stack parser))
(add-op (list :ise nil) parser)) (add-op (list :ise nil) parser))
(defmethod parse-op ((parser parser) token (type (eql :yoksa))) (defmethod parse-op ((parser parser) token (id (eql :yoksa)))
(let ((top (pop (if-stack parser)))) (let ((top (pop (if-stack parser))))
(assert (and (string= :ise (car top)) (assert (and (string= :ise (car top))
(string= :ise (car (aref (ops parser) (cadr top)))))) (string= :ise (car (aref (ops parser) (cadr top))))))
@@ -157,7 +174,7 @@
(push (list :yoksa (index parser)) (if-stack parser)) (push (list :yoksa (index parser)) (if-stack parser))
(add-op (list :yoksa nil (index parser)) parser))) (add-op (list :yoksa nil (index parser)) parser)))
(defmethod parse-op ((parser parser) token (type (eql :yap))) (defmethod parse-op ((parser parser) token (id (eql :yap)))
(let ((top (pop (if-stack parser)))) (let ((top (pop (if-stack parser))))
(unless (and (find (car top) (list :yoksa :ise :iken)) (unless (and (find (car top) (list :yoksa :ise :iken))
(find (car (aref (ops parser) (cadr top))) (find (car (aref (ops parser) (cadr top)))
@@ -171,17 +188,17 @@
(add-op (list :yap (index parser) (third top)) parser)) (add-op (list :yap (index parser) (third top)) parser))
(t (error "yap cannot reference: ~a" (car top)))))) (t (error "yap cannot reference: ~a" (car top))))))
(defmethod parse-op ((parser parser) token (type (eql :döngü))) (defmethod parse-op ((parser parser) token (id (eql :döngü)))
(push (list :döngü (index parser)) (if-stack parser)) (push (list :döngü (index parser)) (if-stack parser))
(add-op (list :döngü (index parser)) parser)) (add-op (list :döngü (index parser)) parser))
(defmethod parse-op ((parser parser) token (type (eql :iken))) (defmethod parse-op ((parser parser) token (id (eql :iken)))
(let ((top (pop (if-stack parser)))) (let ((top (pop (if-stack parser))))
(assert (string= :döngü (car top))) (assert (string= :döngü (car top)))
(push (list :iken (index parser) (cadr top)) (if-stack parser)) (push (list :iken (index parser) (cadr top)) (if-stack parser))
(add-op (list :iken nil) parser))) (add-op (list :iken nil) parser)))
(defmethod parse-op ((parser parser) token (type (eql :makro))) (defmethod parse-op ((parser parser) token (id (eql :makro)))
;; makro name must be undefined before ;; makro name must be undefined before
(let ((makro-name-tok (read-token parser))) (let ((makro-name-tok (read-token parser)))
(assert (eq :unknown (getf (cdr makro-name-tok) :type))) (assert (eq :unknown (getf (cdr makro-name-tok) :type)))
@@ -197,13 +214,7 @@
((eq :son (car tok)) (reverse makrodef)) ((eq :son (car tok)) (reverse makrodef))
(push tok makrodef))))) (push tok makrodef)))))
(defmethod parse-op ((parser parser) token type) (defmethod parse-op ((parser parser) token (id (eql :kütüphane)))
(cond ((search "syscall" (string-downcase (string (car token))))
(let ((syscall-num (parse-integer (subseq (string (car token)) 8))))
(add-op (list :syscall syscall-num) parser)))
(t (add-op (list type) parser))))
(defmethod parse-op ((parser parser) token (type (eql :kütüphane)))
(let ((file (car (read-token parser)))) (let ((file (car (read-token parser))))
(setf (tokens parser) (append (lex-file file) (tokens parser))))) (setf (tokens parser) (append (lex-file file) (tokens parser)))))