work

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))))))