diff options
| -rw-r--r-- | rva.asd | 4 | ||||
| -rw-r--r-- | src/lex.lisp | 52 | ||||
| -rw-r--r-- | src/main.lisp | 15 | ||||
| -rw-r--r-- | src/package.lisp | 6 | ||||
| -rw-r--r-- | t/lex.lisp | 45 |
5 files changed, 116 insertions, 6 deletions
@@ -14,6 +14,7 @@ :serial t :components ((:file "package") (:file "util") + (:file "lex") (:file "main")))) :long-description #.(uiop:read-file-string @@ -33,7 +34,8 @@ :serial t :components ((:file "package") (:file "main") - (:file "util")))) + (:file "util") + (:file "lex")))) :perform (test-op (o s) (uiop:symbol-call :rva-tests :test-rva))) (defmethod asdf:perform ((o asdf:image-op) (c asdf:system)) diff --git a/src/lex.lisp b/src/lex.lisp new file mode 100644 index 0000000..ad386ba --- /dev/null +++ b/src/lex.lisp @@ -0,0 +1,52 @@ +(in-package #:lex) + +(defun file->tokens (file) + "Opens FILE and parses returns a list of tokens, or +NIL if the file could not be opened." + + (defun read-tokens (tokens-so-far) + "Collects tokens in FILE into TOKENS-SO-FAR." + (let ((token (read-token))) + (if token + (read-tokens (cons token tokens-so-far)) + (reverse tokens-so-far)))) + + (and (probe-file file) + (with-open-file (*standard-input* file :direction :input) + (read-tokens '())))) + +(defun read-token () + "Reads *STANDARD-INPUT* and returns a token, or nil if the end +of file has been reached. +Whitespace, commas, colons, and parentheses are token delimiters. +Comments start with a semi-colon ';' and all tokens after are ignored." + (let ((chr (read-char *standard-input* nil))) + (cond + ((null chr) chr) + ((whitespace-char-p chr) + (read-token)) + + ((char= chr #\;) + (progn (read-line *standard-input* nil) + (read-token))) + + ((char= chr #\() 'left-paren) + ((char= chr #\)) 'right-paren) + + ((digit-char-p chr) + (read-immediate chr)) + + ((alpha-char-p chr) + (read-identifier chr)) + + (t (error (format nil "~a is not a valid lexical symbol.~%" chr)))))) + +(defun read-immediate (chr) + 'immediate) + +(defun read-identifier (chr) + 'id) + +(defun whitespace-char-p (x) + (or (char= #\space x) + (not (graphic-char-p x)))) diff --git a/src/main.lisp b/src/main.lisp index c85e392..1f0afdd 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -35,14 +35,19 @@ _/_/ _/_/ " (defun driver (cmd) "Reads in a file and directs lexing, parsing, and binary emission." (print-splash) - (let ((args (clingon:command-arguments cmd)) - (parse? (not (clingon:getopt cmd :lex))) - (emit? (not (clingon:getopt cmd :parse)))) + (let* ((args (clingon:command-arguments cmd)) + (file (car args)) + (parse? (not (clingon:getopt cmd :lex))) + (emit? (not (clingon:getopt cmd :parse)))) (cond ;; complain about num arguments ((/= (length args) 1) (error "Wrong number of arguments.")) - ((not (util:asm-extension? (car args))) (error "The file is not an asm source code file.")))) - (error-cli "Nitimur in Vetitum")) + ((not (util:asm-extension? file)) + (error "The file is not an asm source code file, or it could not be opened.")) + (t (let ((tokens (lex:file->tokens file))) + (format t "~a" tokens) + (format t "Nitimur in Vetitum~%")))))) + (defun cli/command () "Returns a clingon command." diff --git a/src/package.lisp b/src/package.lisp index 9d21293..44399cb 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -5,3 +5,9 @@ (defpackage #:util (:use #:cl) (:export #:asm-extension?)) + +(defpackage #:lex + (:use #:cl) + (:export #:file->tokens + ;; exported for testing only + #:read-token)) diff --git a/t/lex.lisp b/t/lex.lisp new file mode 100644 index 0000000..e210ecb --- /dev/null +++ b/t/lex.lisp @@ -0,0 +1,45 @@ +(in-package #:rva-tests) + +(defmacro read-this (str &body body) + `(let ((*standard-input* (make-string-input-stream ,str))) + ,@body)) + +(def-suite lex-tests + :description "Test functions exported from the lexer." + :in all-tests) + +(in-suite lex-tests) + +(test read-token-reads-eof + (read-this "" + (is (not (lex:read-token))))) + +(test read-token-reads-left-paren + (read-this "(" + (is (eq (lex:read-token) 'lex::left-paren)))) + +(test read-token-reads-right-paren + (read-this ")" + (is (eq (lex:read-token) 'lex::right-paren)))) + +(test read-token-ignores-space + (read-this " (" + (is (eq (lex:read-token) 'lex::left-paren)))) + +(test read-token-ignores-tab + (read-this " (" + (is (eq (lex:read-token) 'lex::left-paren)))) + +(test read-token-ignores-newline + (read-this " +(" + (is (eq (lex:read-token) 'lex::left-paren)))) + +(test read-token-ignores-comment + (read-this "; this is a comment +(" + (is (eq (lex:read-token) 'lex::left-paren)))) + +(test read-token-ignores-comment-eof + (read-this ";" + (is (not (lex:read-token))))) |