diff options
| -rwxr-xr-x | src/gscc | 50 | ||||
| -rw-r--r-- | src/modules/lexer/lexer.scm | 21 | ||||
| -rw-r--r-- | src/unit-tests/lexer/lexer-test.scm | 16 |
3 files changed, 60 insertions, 27 deletions
@@ -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) |