Merge pull request #1 from bdunahu/bdunahu

Add logic to open file, full lexer and tests.

5 files changed, 220 insertions, 8 deletions

diff --git a/src/lex.lisp b/src/lex.lisp
new file mode 100644
index 0000000..5b1457d
--- /dev/null
+++ b/src/lex.lisp
@@ -0,0 +1,108 @@
+(in-package #:lex)
+
+(define-condition lexer-error (error)
+  ((message :initarg :message
+            :initform nil
+            :reader message))
+  (:report (lambda (condition stream)
+             (format stream "~A" (message condition))))
+  (:documentation "Dedicated error for an invalid 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-instr (lst tokens-so-far)
+    "Collects tokens in FILE into TOKENS-SO-FAR, splitting on a newline."
+    (let ((token (read-token)))
+      (cond ((null token) (reverse tokens-so-far))
+            ((eq token 'nl)
+             (cons (reverse tokens-so-far) (read-instr nil nil)))
+            (t (read-instr lst (cons token tokens-so-far))))))
+
+  (and (probe-file file)
+       (with-open-file (*standard-input* file :direction :input)
+         (remove nil (read-instr '() '())))))
+
+(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)
+
+      ((char= chr #\linefeed) 'nl)
+
+      ((whitespace-char-p chr)
+       (read-token))
+
+      ((char= chr #\;)
+       (progn (read-line *standard-input* nil)
+              'nl))
+
+      ((char= chr #\() 'left-paren)
+      ((char= chr #\)) 'right-paren)
+
+      ((char= chr #\:) 'colon)
+      ((char= chr #\$) 'dollar)
+
+      ((char= chr #\+) 'plus)
+      ((char= chr #\-) 'minus)
+
+      ((digit-char-p chr)
+       (read-immediate chr))
+
+      ((alpha-char-p chr)
+       (read-keyword chr))
+
+      (t (error 'lexer-error
+                :message
+                (format nil "LEX failled--~a is not a valid lexical symbol.~%" chr))))))
+
+(defun read-immediate (chr)
+  "Reads a sequence of digits, in base 2, 8, 10, or 16.. Throws
+`invalid-immediate-or-keyword' error if an alphabetic character is encountered."
+  ;; may be combined with read-keyword-helper
+  (defun read-immediate-helper (chrs-so-far)
+    (let ((chr (peek-char nil *standard-input* nil)))
+      (cond ((and (not (null chr)) (digit-char-p chr))
+             (read-immediate-helper (cons (read-char *standard-input* nil) chrs-so-far)))
+            ((and (not (null chr)) (alpha-char-p chr))
+             (error 'lexer-error
+                    :message
+                    (format nil "LEX failed--encountered ~a while reading immediate.~%" chr)))
+            (t (reverse chrs-so-far)))))
+
+  (let* ((next (peek-char nil *standard-input* nil))
+         (radix (cond ((null next) 10)
+                      ((char= next #\b) 2)
+                      ((char= next #\o) 8)
+                      ((char= next #\x) 16)
+                      ((alpha-char-p next) nil)
+                      (t 10)))
+         (arg (list chr)))
+    (when (and (char= chr #\0) radix (not (= radix 10)))
+      (read-char *standard-input* nil)
+      (setq arg '()))
+    (parse-integer (coerce (read-immediate-helper arg) 'string) :radix radix)))
+
+(defun read-keyword (chr)
+  "Reads a sequence of alphabetic characters. Throws `invalid-immediate-or-keyword'
+error if a digit is encountered."
+  ;; may be combined with read-immediate-helper
+  (defun read-keyword-helper (chrs-so-far)
+    (let ((chr (peek-char nil *standard-input* nil)))
+      (cond ((and (not (null chr)) (alpha-char-p chr))
+             (read-keyword-helper (cons (read-char *standard-input* nil) chrs-so-far)))
+            ((and (not (null chr)) (digit-char-p chr))
+             (error 'lexer-error
+                    :message
+                    (format nil "LEX failed--encountered ~a while reading keyword.~%" chr)))
+            (t (reverse chrs-so-far)))))
+  (coerce (read-keyword-helper (list chr)) 'string))
+
+(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..f6e5754 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -35,14 +35,22 @@ _/_/                                  _/_/  "
 (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"))
+      ((/= (length args) 1) (error "Wrong number of arguments.~%"))
+      ((not (util:asm-extension? file))
+       (error "The file is not an asm source code file.~%"))
+      (t (let ((tokens (lex:file->tokens file)))
+           (if tokens
+               (progn (pprint tokens)
+                      (terpri))
+               (error "The file does not exist, or it could not be opened.~%"))
+           (format t "Nitimur in Vetitum~%"))))))
+
 
 (defun cli/command ()
   "Returns a clingon command."
diff --git a/src/package.lisp b/src/package.lisp
index 9d21293..3364856 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1,7 +1,26 @@
-(defpackage #:rva
+helper(defpackage #:rva
   (:use #:cl)
   (:export #:main))
 
 (defpackage #:util
   (:use #:cl)
-  (:export #:asm-extension?))
+  (:export #:asm-extension?
+           #:format-as-binary
+           #:type-r
+           #:type-i
+           #:type-j
+           #:label-loc))
+
+(defpackage #:lex
+  (:use #:cl)
+  (:export #:lexer-error
+           #:file->tokens
+           ;; exported for testing only
+           #:read-token))
+
+(defpackage #:parse
+  (:use #:cl)
+  (:export #:parser-error
+           #:tokens->ast
+           ;; exported for testing only
+           #:extract-label))
diff --git a/src/parse.lisp b/src/parse.lisp
new file mode 100644
index 0000000..3052583
--- /dev/null
+++ b/src/parse.lisp
@@ -0,0 +1,55 @@
+helper(in-package #:parse)
+
+(define-condition parser-error (error)
+  ((message :initarg :message
+            :initform nil
+            :reader message))
+  (:report (lambda (condition stream)
+             (format stream "~A" (message condition))))
+  (:documentation "Dedicated error for an invalid parse."))
+
+(defun tokens->ast (program)
+  "Given PROGRAM, which is a list of lists of symbols,
+filters out the labels and parses."
+  ;; TODO add directives
+  (let ((program (remove nil (mapcar #'extract-label program)))
+        (i 0))
+    (mapcar (lambda (l) (extract-instruction l i)) program)))
+
+(let ((i 0))
+  (defun extract-label (line)
+    "Given a series of tokens LINE, determines if LINE is
+in the form STRING {colon}. If it is, then it is treated as a
+label, and pushed onto the stack with the line index.
+
+Note that this function is intended to be called using mapcar,
+so that labels can be added to a map and otherwise removed from
+processing."
+    (trivia:match line
+      ((list (and id (type string))
+             (satisfies (lambda (x) (equal x 'lex::colon))))
+       (progn (push (cons (read-from-string id) i) util:label-loc) nil))
+      (_ (progn (incf i) line)))))
+
+(defun extract-instruction (line i)
+  "Given instruction LINE, determines the expected type format and passes
+LINE and the index I to the the respective function."
+  ;; TODO add pseudo-ops (i.e., nop, mov, ...)
+  (let* ((type-map '((r-type . extract-r-type)
+                     (i-type . extract-i-type)
+                     (j-type . extract-j-type)))
+         (keyword (car line))
+         (type-fn (cdr (assoc keyword type-map))))
+    (if type-fn
+        (funcall type-fn line i)
+        (error 'parser-error
+               (format nil "PARSE failed--~a is not a known keyword.~%" (keyword))))))
+
+(defun extract-r-type (line i)
+  'r)
+
+(defun extract-i-type (line i)
+  'i)
+
+(defun extract-j-type (line i)
+  'j)
diff --git a/src/util.lisp b/src/util.lisp
index 87e4df9..5edee4a 100644
--- a/src/util.lisp
+++ b/src/util.lisp
@@ -3,3 +3,25 @@
 (defun asm-extension? (file)
   "Returns t if FILE is extended with .asm, nil otherwise."
   (string= (pathname-type file) "asm"))
+
+;; TODO this won't work for negative numbers of odd sizes quite yet.
+(defun format-as-binary (num len)
+  "Formats NUM as a binary number, and pads to LEN with zeros."
+  (declare (type number        num))
+  (declare (type (integer 0 *) len))
+  (format nil "~V,'0b" len num))
+
+(defparameter type-r
+  '(ADD SUB MUL QUOT REM SFTR SFTL AND OR NOT XOR ADDV SUBV MULV DIVV CMP CEV)
+  "R-type instructions.")
+
+(defparameter type-i
+  '(LOAD LOADV ADDI SUBI SFTRI SFTLI ANDI ORI XORI STORE STOREV)
+  "I-type instructions.")
+
+(defparameter type-j
+  '(JMP JRL JAL BEQ BGT BUF BOF PUSH POP)
+  "J-type instructions.")
+
+(defparameter label-loc '()
+  "A symbol table mapping label names to line indices.")