diff options
Diffstat (limited to 'src/ull')
| -rwxr-xr-x | src/ull | 107 |
1 files changed, 107 insertions, 0 deletions
@@ -0,0 +1,107 @@ +#!/run/current-system/profile/bin/guile \ +-L ./src/modules -e main -s +!# + + +(use-modules (ice-9 getopt-long) + (ice-9 popen) + (ice-9 pretty-print) + (lexer driver) + (parser driver) + (tacky driver) + (generator driver) + (emitter driver)) + + +(define version "v0.1.1") + + +(define (error message) + (display (string-concatenate `(,message " +Usage: + ull [OPTIONS] file +Options: + --version, -v: print version information + --debug, -d: turn on verbose output + --lex, -l: run the lexer, but stop before assembly generation + --parse, -p: run the lexer and parser, but stop before assembly generation + --tacky, -t: run the tacky generation stage, but stop before assembly generation + --codegen, -c: perform lexing, parsing, tacky, and assembly generation, but stop before code emission\n"))) + (exit #f)) + +(define (c-extension? file) + (let ((extension (string-drop file (- (string-length file) 2)))) + (string=? extension ".c"))) + +(define (process file parse? tack? generate? write? dest) + "Driver for lexing, parsing, and assembly generation." + (let* ((port (preprocess file)) + (tokens (begin (set-current-input-port port) + (read-tokens)))) + (close-input-port port) + (when parse? + (let ((c-ast (tokens->ast tokens))) + (pretty-print c-ast) + (when tack? + (let ((tacky-ast (ast->tacky c-ast))) + (pretty-print tacky-ast) + (when generate? + (let ((assembly-ast (tacky->assembly tacky-ast))) + (pretty-print assembly-ast) + (when write? + (let ((program (assembly->string 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. +Returns #f on a failure, #t on a success." + (zero? (system (string-concatenate `("gcc " ,src " -o " ,dest))))) + +(define (main args) + "Entry point for ull. Handles user args and performs initial validity check." + (let* ((option-spec + '((version (single-char #\v) (value #f)) + (debug (single-char #\d) (value #f)) + (lex (single-char #\l) (value #f)) + (parse (single-char #\p) (value #f)) + (tacky (single-char #\t) (value #f)) + (codegen (single-char #\c) (value #f)))) + (options (getopt-long args option-spec)) + (rest (option-ref options '() #f)) + (file (if (null? rest) #f (car rest)))) + (cond + ((option-ref options 'version #f) + (display (string-concatenate `("ull (" ,version ")\n")))) + ((not (equal? 1 (length rest))) (error "Wrong number of arguments.")) + ((or (not file) + (not (access? file R_OK)) + (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 ((parse? (not (option-ref options 'lex #f))) + (tack? (not (option-ref options 'parse #f))) + (generate? (not (option-ref options 'tacky #f))) + (write? (not (option-ref options 'codegen #f)))) + (process file + parse? + tack? + generate? + write? + (string-drop-right file 2))))))) + + +;; Local Variables: +;; mode: scheme +;; End: |