diff options
Diffstat (limited to '')
| -rwxr-xr-x | cpp | 45 |
1 files changed, 34 insertions, 11 deletions
@@ -6,20 +6,43 @@ here=$(dirname $(realpath $0)) exec $GUILE -e main -s "$0" "$@" !# -(use-modules ((c preprocessor2) :select (preprocess-string make-default-environment)) - ((hnh util io) :select (read-file)) +(use-modules ((c preprocessor2) :select (cpp make-default-environment)) ((c cpp-environment) :select (pprint-environment)) + ((c lex2) :select (tokenize)) ((c unlex) :select (unlex)) + ((hnh util values) :select (on-snd abort*)) (srfi srfi-71) (srfi srfi-88)) + +(define-syntax fold/mv + (syntax-rules () + ((_ procedure producer lst) + (fold/mv-procedure procedure (lambda () producer) lst)))) + +(define (fold/mv-procedure procedure producer lst) + (if (null? lst) + (producer) + (call-with-values producer + (lambda returned + (fold/mv procedure + (apply procedure (car lst) returned) + (cdr lst)))))) + +(define (run-instructions instructions) + (fold/mv (lambda (expr env tokens) + (on-snd (append tokens (abort* (cpp expr env))))) + (values (make-default-environment) '()) + instructions)) + (define (main args) - (let* ((content (read-file (cadr args))) - (env tokens (preprocess-string content (make-default-environment)))) - (pprint-environment env (current-output-port)) - (newline) - (display "/*** tokens ***/") - (newline) - (display (unlex tokens)) - (newline) - )) + (system "cpp -dM /dev/null > /tmp/cpp-default.h") + + (let* ((env tokens + (run-instructions + (list "#include </tmp/cpp-default.h>" + "#define __restrict restrict" + (format #f "#include \"~a\"" (cadr args)))))) + (pprint-environment env) (newline) + (display "/*** tokens ***/") (newline) + (display (unlex tokens)) (newline))) |