diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-11 20:31:58 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-11 20:31:58 +0200 |
commit | ad0440b16d7e2694ae01df08710f24936b57ec99 (patch) | |
tree | e21b066e4b7d6dca9efe57ac01d6e083a87b7737 /module/c/cpp-environment.scm | |
parent | Cleanup + fix __LINE__. (diff) | |
download | calp-ad0440b16d7e2694ae01df08710f24936b57ec99.tar.gz calp-ad0440b16d7e2694ae01df08710f24936b57ec99.tar.xz |
work
Diffstat (limited to 'module/c/cpp-environment.scm')
-rw-r--r-- | module/c/cpp-environment.scm | 34 |
1 files changed, 33 insertions, 1 deletions
diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm index 2a943496..913e905e 100644 --- a/module/c/cpp-environment.scm +++ b/module/c/cpp-environment.scm @@ -35,13 +35,18 @@ cpp-environment cpp-environment? - cpp-if-status cpp-variables + cpp-if-status + ;; cpp-variables + cpp-file-stack make-environment in-environment? remove-identifier! add-identifier! get-identifier extend-environment disjoin-macro + + pprint-environment + pprint-macro )) (define (macro-identifier x) @@ -85,6 +90,7 @@ (define-type (cpp-environment) (cpp-if-status type: (list-of (memv '(outside active-if inactive-if))) default: '(outside)) + ;; not exported since type signatures don't hold inside the hash table (cpp-variables type: hash-table? default: (make-hash-table)) (cpp-file-stack type: (and (not null?) (list-of (pair-of string? exact-integer?))) @@ -172,3 +178,29 @@ (let ((env (clone-environment environment))) (remove-identifier! env name) env)) + + + +(define* (pprint-environment environment optional: (port (current-error-port))) + (display "== Environment ==\n") + (hash-for-each (lambda (key macro) + (pprint-macro macro port) + (newline port)) + (cpp-variables environment))) + +(define* (pprint-macro x optional: (p (current-output-port))) + (cond ((internal-macro? x) + (format p "/* ~a INTERNAL MACRO */" + (macro-identifier x))) + ((object-macro? x) + (format p "#define ~a ~a" + (macro-identifier x) + (unlex (macro-body x)))) + ((function-macro? x) + (format p "#define ~a(~a) ~a" + (macro-identifier x) + (string-join (append (macro-identifier-list x) + (if (variadic? x) + '("...") '())) + "," 'infix) + (unlex (macro-body x)))))) |