From 309c6a49f75283e34ca027bf32d80821a226cf25 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sat, 23 Jul 2022 23:34:11 +0200
Subject: General cleanup around cpp.

---
 module/c/compiler.scm        |  6 +++---
 module/c/cpp-environment.scm |  6 ++++--
 module/c/preprocessor2.scm   | 11 ++++++++---
 3 files changed, 15 insertions(+), 8 deletions(-)

(limited to 'module')

diff --git a/module/c/compiler.scm b/module/c/compiler.scm
index c1563a0b..6e226d7d 100644
--- a/module/c/compiler.scm
+++ b/module/c/compiler.scm
@@ -7,7 +7,7 @@
   :use-module ((c preprocessor2)
                :select (preprocess-string
                         make-default-environment))
-  :use-module ((hnh util values) :select (abort* on-fst))
+  :use-module ((hnh util values) :select (abort* on-fst on-snd))
   :use-module ((c ast) :select (build-ast))
   :export (run-compiler
            compile-string
@@ -22,14 +22,14 @@
 
 
 (define* (compile-string str optional: (environment (make-default-environment)))
-  (on-fst (build-ast (abort* (preprocess-string str environment)))))
+  (on-snd (build-ast (abort* (preprocess-string str environment)))))
 
 
 
 (define the-environment (make-parameter (make-default-environment)))
 
 (define* (compile-string* str)
-  (let ((result cpp-env (compile-string str)))
+  (let ((cpp-env result (compile-string str)))
     (if (null? result)
         (compile-string (string-append str ";")
                         (the-environment))
diff --git a/module/c/cpp-environment.scm b/module/c/cpp-environment.scm
index 3bc94020..951540fa 100644
--- a/module/c/cpp-environment.scm
+++ b/module/c/cpp-environment.scm
@@ -52,7 +52,9 @@
 
 
 (define (%printer r p)
-  (format p "#<~a>" (pprint-macro r)))
+  (display "#<" p)
+  (pprint-macro r p)
+  (display ">" p))
 
 (define-type (function-macro printer: %printer)
   (fun:identifier type: string? key: identifier)
@@ -242,7 +244,7 @@
 
 
 
-(define* (pprint-environment environment optional: (port (current-error-port)))
+(define* (pprint-environment environment optional: (port (current-output-port)))
   (display "/*** Environment ***/\n" port)
   (for-each (lambda (pair)
               (pprint-macro (cdr pair) port)
diff --git a/module/c/preprocessor2.scm b/module/c/preprocessor2.scm
index e4590d41..e63103dc 100644
--- a/module/c/preprocessor2.scm
+++ b/module/c/preprocessor2.scm
@@ -29,6 +29,7 @@
            ;; defined-macro
            c-search-path
            handle-preprocessing-tokens
+           cpp
            preprocess-string
            make-default-environment
            ))
@@ -734,7 +735,7 @@
                              ((pragma) handle-pragma)
                              (else (throw 'propagate
                                           "Unknown preprocessing directive: ~s"
-                                          (list line-tokens))))))
+                                          (list (unlex line-tokens)))))))
                    (-> environment
                        (op body)
                        (loop remaining-tokens))))))))))
@@ -822,12 +823,16 @@
       (value-ref 0)))
 
 
-(define* (preprocess-string str optional: (environment (make-default-environment)))
+;; partial pre-process, useful for running just the preprocessor interactivly
+(define* (cpp str optional: (environment (make-default-environment)))
   (->> str
 ;;; Phase 1-3
        tokenize
 ;;; 4. Execution of preprocessing directives, all preprocessing directives are then deleted
-       (handle-preprocessing-tokens environment)
+       (handle-preprocessing-tokens environment)))
+
+(define* (preprocess-string str optional: (environment (make-default-environment)))
+  (->> (cpp str environment)
        abort*
 ;;; 5. (something with character sets)
 ;;; 7. Whitespace tokens are discarded, each preprocessing token is converted into a token
-- 
cgit v1.2.3