From 467357ef13ea5d935d2e3aa5baaeef6317cd9590 Mon Sep 17 00:00:00 2001 From: bd Date: Tue, 28 Jan 2025 17:05:30 -0500 Subject: Minor cleanup to main ull driver --- ull | 82 +++++++++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 44 insertions(+), 38 deletions(-) diff --git a/ull b/ull index a6e6c28..6217544 100755 --- a/ull +++ b/ull @@ -12,9 +12,14 @@ (define version "v0.1.1") -(define (error message) - (display (string-concatenate `(,message " -Usage: +(define (error-with-message message) + (display message) + (exit #f)) + +(define (error-cli message) + (error-with-message + (format #f + "~a\nUsage: ull [OPTIONS] file Options: --version, -v: print version information @@ -22,8 +27,12 @@ Options: --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)) + --codegen, -c: perform lexing, parsing, tacky, and assembly generation, but stop before code emission\n" + message))) + +(define (pp-step ast caption) + (pretty-print ast) + (display (format #f "^-==~a==-^\n" caption))) (define (c-extension? file) (let ((extension (string-drop file (- (string-length file) 2)))) @@ -36,36 +45,34 @@ Options: (define (preprocess src dst) "Preprocesses SRC with gcc and write it to DST." (system (string-concatenate `("gcc -E -P " ,src " -o " ,dst))) - (display (string-concatenate `("Preprocess reported success (wrote " ,dst ").\n")))) + (display (format #f "Preprocess reported success (wrote ~a).\n" dst))) (define (frontend file parse?) "Wrapper for lexing and parsing. Returns an AST representing FILE." (let ((c-ast (file->ast file parse?))) + (cleanup-file file) (or c-ast - (begin - (display (format #f "~a reported failure!\n" (or (and parse? "Parser") "Lexer"))) - (cleanup-file file) - (exit #f))))) - -(define (backend c-ast tack? generate? write?) - "Driver for tacky and assembly generation, code emission. Returns an assembly program representing C-AST." - (pretty-print c-ast) - (display "===^file->ast^===\n") + (error-with-message + (format #f "~aer reported FAILURE\n" (or (and parse? "Pars") "Lex")))))) + +(define (backend ast tack? generate? write?) + "Driver for tacky and assembly generation, code emission. +Returns an string representing the generated assembly." + (pp-step ast "file->ast") (when tack? - (let ((tacky-ast (ast->tacky c-ast))) - (pretty-print tacky-ast) - (display "===^ast->tacky^===\n") + (let ((ast (ast->tacky ast))) + (pp-step ast "ast->tacky") (when generate? - (let ((assembly-ast (tacky->assembly tacky-ast))) - (pretty-print assembly-ast) - (display "===^tacky->assembly^===\n") + (let ((ast (tacky->assembly ast))) + (pp-step ast "tacky->assembly") (when write? - (assembly->string assembly-ast))))))) + (assembly->string ast))))))) (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))))) + (when (zero? (system (string-concatenate `("gcc " ,src " -o " ,dest)))) + (display (format #f "Postprocess reported success (wrote ~a).\n" dst)))) (define (write str dst) "Writes STR to the file at DST." @@ -73,7 +80,7 @@ Returns #f on a failure, #t on a success." (let ((port (open-output-file dst))) (display str port) (close-port port)) - (display (string-concatenate `("Assembly generation reported success (wrote " ,dst ").\n")))) + (display (format #f "Assembly generation reported success (wrote ~a).\n" dst))) (define (main args) "Entry point for ull. Handles user args and performs initial validity check." @@ -90,32 +97,31 @@ Returns #f on a failure, #t on a success." (cond ;; display version number ((option-ref options 'version #f) - (display (string-concatenate `("ull (" ,version ")\n")))) + (display (format #f "ull (~a)\n" version))) ;; complain about usage - ((not (equal? 1 (length rest))) (error "Wrong number of arguments.")) + ((not (equal? 1 (length rest))) (error-cli "Wrong number of arguments.")) ((or (not file-name) (not (access? file-name R_OK)) (not (equal? 'regular (stat:type (stat file-name)))) - (not (c-extension? file-name))) (error "The file could not be read, or it is not a C source code file.")) + (not (c-extension? file-name))) (error-cli "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))) - (preprocessed-file-name - (string-concatenate `(,(string-drop-right file-name 1) "i"))) - (assembly-file-name - (string-concatenate `(,(string-drop-right file-name 1) "s"))) - (executable-file-name - (string-drop-right file-name 2))) + (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))) + (executable-file-name + (string-drop-right file-name 2)) + (preprocessed-file-name + (string-concatenate `(,executable-file-name ".i"))) + (assembly-file-name + (string-concatenate `(,executable-file-name ".s")))) ;; preprocess the file (preprocess file-name preprocessed-file-name) ;; call the frontend (let ((c-ast (frontend preprocessed-file-name parse?))) - (cleanup-file preprocessed-file-name) (if (and parse? c-ast) ;; call the backend (begin (display "Parser reported success\n") -- cgit v1.2.3