1 files changed, 37 insertions, 0 deletions
diff --git a/module/c/unlex.scm b/module/c/unlex.scm
new file mode 100644
index 00000000..9f4b25b9
--- /dev/null
+++ b/module/c/unlex.scm
@@ -0,0 +1,37 @@
+(define-module (c unlex)
+  :use-module (hnh util type)
+  :use-module (ice-9 match)
+  :use-module (c lex2)
+  :use-module (c cpp-types)
+  :use-module (c cpp-util)
+  :export (unlex
+           stringify-token
+           stringify-tokens))
+
+;; takes a list of preprocessing-token's, and return a "source" string
+(define (unlex tokens)
+  (typecheck tokens (list-of lexeme?))
+  (string-concatenate
+   (map (lambda (x)
+          (cond ((preprocessing-token? x) (stringify-token x))
+                ((whitespace-token? x) " ")))
+        (squeeze-whitespace tokens))))
+
+;; Returns the "source" of the token, as a preprocessing string literal token
+(define (stringify-token preprocessing-token)
+  (match (lexeme-body preprocessing-token)
+    (`(string-literal ,s)
+     (format #f "~s" s))
+    (`(header-name (q-string ,s))
+     (format #f "~s" s))
+    (`(header-name (h-string ,s))
+     (format #f "<~a>" s))
+    (`(identifier ,id) id)
+    (`(pp-number ,n) n)
+    (`(character-constant ,c)
+     (format #f "'~a'" c))
+    (`(punctuator ,p) p)))
+
+;; takes a token list, and return a single string literal token
+(define (stringify-tokens tokens)
+  (lexeme type: 'preprocessing-token body: `(string-literal ,(unlex tokens))))