Add (and test) sub, add, inc/decrement, and bit-complement to lexer

3 files changed, 60 insertions, 27 deletions

diff --git a/src/gscc b/src/gscc
index fc0b2de..fbef106 100755
--- a/src/gscc
+++ b/src/gscc
@@ -30,13 +30,10 @@ Options:
   (let ((extension (string-drop file (- (string-length file) 2))))
     (string=? extension ".c")))
 
-(define (preprocess file)
-  "Returns an input port containing FILE processed with gcc."
-  (open-input-pipe (string-append "gcc -E -P " file)))
-
-(define (process port parse? generate? write?)
+(define (process file parse? generate? write? dest)
   "Driver for lexing, parsing, and assembly generation."
-  (let* ((tokens (begin (set-current-input-port port)
+  (let* ((port (preprocess file))
+         (tokens (begin (set-current-input-port port)
                         (read-tokens))))
     (close-input-port port)
     (when parse?
@@ -44,7 +41,19 @@ Options:
         (when generate?
           (let ((assembly-ast (g-program c-ast)))
             (when write?
-              (e-program assembly-ast))))))))
+              (let ((program (e-program assembly-ast))
+                    (a-file (string-append dest ".s")))
+                (when (file-exists? a-file)
+                  (delete-file a-file))
+                (let ((port (open-output-file a-file)))
+                  (display program port)
+                  (close-port port))
+                (when (postprocess a-file dest)
+                  (display (string-concatenate `("Postprocess reported success (wrote " ,dest ").\n"))))))))))))
+
+(define (preprocess file)
+  "Returns an input port containing FILE processed with gcc."
+  (open-input-pipe (string-append "gcc -E -P " file)))
 
 (define (postprocess src dest)
   "Assembles and links SRC, producing executable DEST.
@@ -52,6 +61,7 @@ Returns #f on a failure, #t on a success."
   (zero? (system (string-concatenate `("gcc " ,src " -o " ,dest)))))
 
 (define (main args)
+  "Entry point for the gscc. Handles user args and performs initial validity check."
   (let* ((option-spec
           '((version (single-char #\v) (value #f))
             (debug   (single-char #\d) (value #f))
@@ -60,9 +70,7 @@ Returns #f on a failure, #t on a success."
             (codegen (single-char #\c) (value #f))))
          (options (getopt-long args option-spec))
          (rest (option-ref options '() #f))
-         (file (if (null? rest) #f (car rest)))
-         (executable (string-drop-right file 2))
-         (assembly (string-append executable ".s")))
+         (file (if (null? rest) #f (car rest))))
     (cond
      ((option-ref options 'version #f)
       (display (string-concatenate `("gscc (the 'Guile Scheme C Compiler', " ,version ")\n"))))
@@ -72,19 +80,15 @@ Returns #f on a failure, #t on a success."
           (not (equal? 'regular (stat:type (stat file))))
           (not (c-extension? file))) (error "The file could not be read, or it is not a C source code file."))
      (#t
-      (let* ((port (preprocess file))
-             (parse? (not (option-ref options 'lex #f)))
-             (generate? (not (option-ref options 'parse #f)))
-             (write? (not (option-ref options 'codegen #f)))
-             (program (process port parse? generate? write?)))
-        (when write?
-          (when (file-exists? assembly)
-            (delete-file assembly))
-          (let ((port (open-output-file assembly)))
-            (display program port)
-            (close-port port))
-          (when (postprocess assembly executable)
-            (display (string-concatenate `("Postprocess reported success (wrote " ,executable ").\n"))))))))))
+      (let ((parse? (not (option-ref options 'lex #f)))
+            (generate? (not (option-ref options 'parse #f)))
+            (write? (not (option-ref options 'codegen #f))))
+        (process file
+                 parse?
+                 generate?
+                 write?
+                 (string-drop-right file 2)))))))
+
 
 ;; Local Variables:
 ;; mode: scheme
diff --git a/src/modules/lexer/lexer.scm b/src/modules/lexer/lexer.scm
index a6be215..4078db4 100644
--- a/src/modules/lexer/lexer.scm
+++ b/src/modules/lexer/lexer.scm
@@ -28,13 +28,25 @@ current input port."
        'close-brace)
       ((eqv? chr #\;)
        'semi-colon)
+      ((eqv? chr #\~)
+       'complement)
 
-      ((char-alphabetic? chr)
-       (lookup-keyword (read-identifier chr)))
+      ((eqv? chr #\+)
+       (if (take-two? chr)
+           'increment
+           'add))
+
+      ((eqv? chr #\-)
+       (if (take-two? chr)
+           'decrement
+           'sub))
 
       ((char-numeric? chr)
        (read-constant chr))
 
+      ((char-alphabetic? chr)
+       (lookup-keyword (read-identifier chr)))
+
       (#t (error "illegal lexical syntax")))))
 
 (define (read-constant chr)
@@ -58,6 +70,11 @@ current input port."
             (#t (reverse chrs-so-far)))))
   (list->string (read-identifier-helper (list chr))))
 
+(define (take-two? chr)
+  (if (eqv? chr (peek-char))
+      (read-char)
+      #f))
+
 (define (lookup-keyword id)
   "Given identifier ID, converts it to a keyword
 if one is known."
diff --git a/src/unit-tests/lexer/lexer-test.scm b/src/unit-tests/lexer/lexer-test.scm
index 48291b9..324ba66 100644
--- a/src/unit-tests/lexer/lexer-test.scm
+++ b/src/unit-tests/lexer/lexer-test.scm
@@ -35,6 +35,18 @@
   '(1)
   (read-tokens))
 
+(test-equal (read-this "~+-")
+  '(complement add sub)
+  (read-tokens))
+
+(test-equal (read-this "---")
+  '(decrement sub)
+  (read-tokens))
+
+(test-equal (read-this "+--")
+  '(add decrement)
+  (read-tokens))
+
 (test-equal (read-this "0")
   '(0)
   (read-tokens))
@@ -52,7 +64,7 @@
   (read-tokens))
 
 (test-error (read-this "3.4")
-	    (read-tokens))
+            (read-tokens))
 
 (test-equal (read-this "a")
   '("a")
@@ -63,7 +75,7 @@
   (read-tokens))
 
 (test-error (read-this "1foo")
-	    (read-tokens))
+            (read-tokens))
 
 (test-equal (read-this "void")
   '(void)